# Creating the Yin Yang symbol with minimal code

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.

d = {#, 0} ~ Disk ~ ##2 &;

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


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

• I think this was the kind of answer I hoped for. A 'functional programming' solution. Commented May 20, 2021 at 5:48
• 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} Commented May 23, 2021 at 7:06
• Thank you @Roman. Updated with your suggestion.
– kglr
Commented May 23, 2021 at 7:24
• I see that your answer evolved...! Even for you the statement: 'there is always someone who can do things with less code' was true. ;-) Commented May 24, 2021 at 14:15
• just asked in Code Golf SE: Diagram of the Utmost Extremes
– uhoh
Commented Dec 26, 2021 at 22:33
\:262F
(*    ☯    *)


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

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


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

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"]]


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]}}
]


• 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. Commented May 20, 2021 at 10:33

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]


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

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]}]


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]}


• With all the air squeezed out it will just about fit into 138 characters. Commented May 20, 2021 at 12:52
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]}


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]]