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, Black, 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,Black,d@0,Circle@@4~d~8}"
87

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. May 20 '21 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} May 23 '21 at 7:06
• Thank you @Roman. Updated with your suggestion.
– kglr
May 23 '21 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. ;-) May 24 '21 at 14:15
• just asked in Code Golf SE: Diagram of the Utmost Extremes
– uhoh
Dec 26 '21 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] May 19 '21 at 22:21
• @DavidG.Stork - Graphics doesn't need Show, e.g., Graphics[Text[Style["☯", 288]], Method -> "ShrinkWrap" -> True] May 20 '21 at 4:56
• Style["\:262F", 288] is enough, no need for wrappers like Text, Graphics, Show, ShrinkWrap, ... May 20 '21 at 8:35
• What about Rasterize[\:262F, ImageResolution -> 10000] // ImageCrop? It generates an Image of size $1063\times1062$ for further use. May 20 '21 at 11:30
• +1 for the win IMO...
– ciao
May 20 '21 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. May 20 '21 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. May 20 '21 at 5:44
• But the true ying-yang uses circles... not a sine wave. May 20 '21 at 15:46
• @DavidG.Stork - Yes, let's call it "yin-yang-inspired"... May 20 '21 at 17:58
• sin-yang (interpretation of sin deliberately left ambiguous) May 21 '21 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. May 20 '21 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]} 