27
$\begingroup$

The following code creates the Yin Yang symbol

Graphics[{Black, Circle[{0, 0}, 1], White, 
   DiskSegment[{0, 0}, 1, {1/2 \[Pi], 3/2 \[Pi]}],
   Black, DiskSegment[{0, 0}, 1, {3/2 \[Pi], 5/2 \[Pi]}], White, 
   Disk[{0, 0.5}, 0.5],
   Black, Disk[{0, -0.5}, 0.5], Black, Disk[{0, 0.5}, 0.125],
   White, Disk[{0, -0.5}, 0.125]
   }] // Show

Knowing that 'there is always someone who can do things with less code', I wondered what the optimal way is, in Mathematica, to create the Yin Yang symbol.

Not really an urgent question to a real problem, but a challenge, a puzzle, if you like. I hope these kind of questions can still be asked here.

$\endgroup$
3

7 Answers 7

35
$\begingroup$
d = {#, 0} ~ Disk ~ ##2 &; 

Graphics@{d[4, 8, {0, π}], 8~d~4, {White, 0~d~4, d@8}, d@0, Circle @@ 4~d~8}

enter image description here

StringLength @ "d={#,0}~Disk~##2&
Graphics@{d[4,8,{0,π}],8~d~4,White,0~d~4,d@8},d@0,Circle@@4~d~8}"
83

We can get the rotated version at a cost of three additional characters: Replace {#, 0} with {0,#} and {0, π} with {3, 5} π/2 to get

enter image description here

$\endgroup$
5
  • 2
    $\begingroup$ I think this was the kind of answer I hoped for. A 'functional programming' solution. $\endgroup$ Commented May 20, 2021 at 5:48
  • 2
    $\begingroup$ By moving the outer circle to the end, the outer edge looks cleaner (no more line-thinning at 9 o'clock): d[y_,a___]:={4y,0}~Disk~a;Graphics@{d[0,8,{0,π}],1~d~4,White,d[-1,4],d@1,Black,d@-1,{0,0}~Circle~8} $\endgroup$ Commented May 23, 2021 at 7:06
  • $\begingroup$ Thank you @Roman. Updated with your suggestion. $\endgroup$ Commented May 23, 2021 at 7:24
  • 2
    $\begingroup$ I see that your answer evolved...! Even for you the statement: 'there is always someone who can do things with less code' was true. ;-) $\endgroup$ Commented May 24, 2021 at 14:15
  • 1
    $\begingroup$ just asked in Code Golf SE: Diagram of the Utmost Extremes $\endgroup$ Commented Dec 26, 2021 at 22:33
35
$\begingroup$

Unicode:

\:262F
(*    ☯    *)

For post-processing at higher resolution, we can rasterize this character to arbitrary pixel counts:

Rasterize[\:262F, RasterSize -> 1000] // ImageCrop

enter image description here

$\endgroup$
8
  • $\begingroup$ Or... Show[Graphics[Text[Style["☯", 84]]], Method -> {"ShrinkWrap" -> True}, ImageSize -> 80] $\endgroup$ Commented May 19, 2021 at 22:21
  • 3
    $\begingroup$ @DavidG.Stork - Graphics doesn't need Show, e.g., Graphics[Text[Style["☯", 288]], Method -> "ShrinkWrap" -> True] $\endgroup$ Commented May 20, 2021 at 4:56
  • 2
    $\begingroup$ Style["\:262F", 288] is enough, no need for wrappers like Text, Graphics, Show, ShrinkWrap, ... $\endgroup$ Commented May 20, 2021 at 8:35
  • 2
    $\begingroup$ What about Rasterize[\:262F, ImageResolution -> 10000] // ImageCrop? It generates an Image of size $1063\times1062$ for further use. $\endgroup$ Commented May 20, 2021 at 11:30
  • 1
    $\begingroup$ +1 for the win IMO... $\endgroup$ Commented May 20, 2021 at 23:10
21
$\begingroup$

I think the code in the OP is nice and concise, and generates a good graphic. But if brevity is the goal, you can turn to the Knowledgebase via

Graphics[Interpreter["Character"]["yin yang symbol"]["Glyph"]]

enter image description here

Longer code, but gives a nice football shape:

Plot[{Sin @ x, Sin[2 * x] / 2, -Sin[x]},
    {x, 0, Pi},
    Filling -> {1 -> {{2}, Black}, 3 -> {2, White}},
    Axes -> False,
    PlotStyle -> {None, Black, Black},
    Epilog -> {{White,Disk[{(2 \[Pi])/3.,1/3},0.1]},{Black,Disk[{\[Pi]/3.,-(1/3)},0.1]}}
]

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ Very original indeed, the concept can be applied to various base-forms. - Imagine code to 'Yin Yang - inize' any base form, 2D or 3D. Just thinking out aloud. $\endgroup$ Commented May 20, 2021 at 10:33
16
$\begingroup$

Not shorter, just different

RegionPlot[{
  x^2 + y^2 < 7, 
  x > Sin[y] && x^2 + y^2 < 7, 
  (x - .2)^2 + (y + 1.5)^2 < .2, 
  (x + .2)^2 + (y - 1.5)^2 < .2},
 {x, -3, 3}, {y, -3, 3},
 PlotStyle -> {White, Black, White, Black}, 
 BoundaryStyle -> Black, Frame -> False]

enter image description here

$\endgroup$
4
  • $\begingroup$ Definitely clearer than my code. $\endgroup$ Commented May 20, 2021 at 5:44
  • 1
    $\begingroup$ But the true ying-yang uses circles... not a sine wave. $\endgroup$ Commented May 20, 2021 at 15:46
  • 2
    $\begingroup$ @DavidG.Stork - Yes, let's call it "yin-yang-inspired"... $\endgroup$ Commented May 20, 2021 at 17:58
  • 2
    $\begingroup$ sin-yang (interpretation of sin deliberately left ambiguous) $\endgroup$ Commented May 21, 2021 at 14:41
13
$\begingroup$

As a plot with Filling:

Plot[{-Sqrt[1 - (x - Sign@x)^2] Sign@x, Sqrt[4 - x^2], -Sqrt[4 - x^2]}
 , {x, -2, 2}, Filling -> {1 -> {3}}, AspectRatio -> 1, 
 PlotRange -> {{-3, 3}, {-3, 3}}, FillingStyle -> Black, 
 PlotStyle -> Black, Axes -> False, Exclusions -> None, 
 Epilog -> {Disk[{1, 0}, .3], White, Disk[{-1, 0}, .3]}]

yin yang as a Plot

With region operations, and golfed:

d = Disk; c = {1, 0}; Graphics@{Circle[0 c, 2], 
 DiscretizeRegion@RegionDifference[RegionUnion[d[0 c, 2, {0, π}], d[c, 1]], 
    d[-c, 1]], d[-c, .2], White, d[c, .2]}

yin yang

$\endgroup$
1
  • 3
    $\begingroup$ With all the air squeezed out it will just about fit into 138 characters. $\endgroup$ Commented May 20, 2021 at 12:52
9
$\begingroup$
l = Line /@ Transpose @ Map[{#, ({0, 1} + #)/2, ({0, -1} + {-1, 1} #)/2} &] @
     CirclePoints[{1, -π/2}, 50][[;; 26]];

Graphics@{Circle[], FilledCurve @ l, Disk[{0, 1/2}, 1/8], White, Disk[{0, -1/2}, 1/8]}

enter image description here

$\endgroup$
1
$\begingroup$

From this post in Chinese community:

With[{r = Sqrt[x^2 + y^2], θ = ArcTan[x, y]}, 
 RegionPlot[(Cos[θ - r] - Sin[θ]) 
            (r^4 - 2 r^2 Cos[2 θ + 24/10] + 9/10) + (62/100 r)^1000 < 0, 
        {x, -2, 2}, {y, -2, 2}, PlotPoints -> 67]]

enter image description here

$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.