23
$\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
30
$\begingroup$
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}

enter image description here

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

enter image description here

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.