7
$\begingroup$

Is it possible to draw the following figure in MMA, where I can change the text?

enter image description here

We can plot the figure eight as a lemniscate using

  PolarPlot[Sec[\[Theta]]^2 Sqrt[Cos[2 \[Theta]]],{\[Theta],0,2\[Pi]}]

Can we combine that with something like KnotData, for example

   KnotData["FigureEight"]

There is also Plotting a 2D shape along a 3D parametric function curve that has a 2D Figure eight.

Is it possible to combine these or something else to generate the desired image?

$\endgroup$

2 Answers 2

10
$\begingroup$

enter image description here

We can construct the main plot using ParametricPlot with the options MeshFunctions, Mesh, MeshShading and MeshStyle (where we specify the option setting for MeshStyle as a pure function):

colors = {RGBColor[{1, 7/10, 1/10}], RGBColor[{1/5, 2/5, 3/5}],  
  RGBColor[{2/5, 1/5, 1/2}], RGBColor[{0, 3/5, 3/5}], RGBColor[{2/5, 7/10, 9/10}], 
  RGBColor[{0, 3/5, 3/10}], RGBColor[{7/10, 2/5, 3/5}], RGBColor[{9/10, 2/5, 2/5}]};

labels = {6, 4, 1, 5, 8, 2, 7, 3};

meshStyle = # /. Point[x_] :> (With[{i = Last[labels = RotateLeft[labels]]}, 
  {Opacity[.5], Gray, Disk[#, Offset[18]], 
   Opacity[1], White, Disk[#, Offset[12]],
   Text[Style[i, RotateLeft[colors, 3][[i]], 18], #]}] & /@ x) &;

plot = ParametricPlot[{Cos[2 Pi - θ], Sin[2 (2 Pi - θ)]}, {θ, 0, 2 Pi}, 
  MeshFunctions -> {#3 &}, 
  ImageSize -> 700, 
  PlotRangeClipping -> False, 
  PlotRangePadding -> Scaled[.2], 
  Mesh -> {Range[1, 16, 2] Pi/8}, 
  AspectRatio -> 1/2, 
  PlotStyle -> AbsoluteThickness[15], 
  MeshShading -> colors, 
  MeshStyle -> meshStyle, 
  Axes -> False, 
  Epilog -> MapThread[Text[Style[#, 20, Bold, Gray], #2, {#3, Center}] &, 
    {{"Mod/Dev", "Ops"}, {{-.5, 0}, {.5, 0}}, {Center, Left}}]]

enter image description here

Interactively place additional annotations using LocatorPane:

coords = First @ Cases[plot, GraphicsComplex[c_, ___] :> 
     c[[DeleteDuplicates @ Cases[plot, Disk[a_, _] :> a, All]]], All];

annotations = MapThread[Text @ Framed[Style[##, 12], FrameStyle -> None] &, 
   {{"Plan requirements\nand properties", 
    "Modeling architecture\nand parts", "Virtual integration", 
    "Code generation", "System assembly", 
    "Run ∥ Simulate", "Monitor", "Data analysis"}, 
    RotateLeft[colors, 3]}][[labels]];

DynamicModule[{pts = coords}, 
 LocatorPane[Dynamic[pts], plot, Appearance -> annotations]]

enter image description here

Update: An alternative approach to get more circular segments using a BSplineFunction as the first argument in ParametricPlot:

bSF = BSplineFunction @ Join[TranslationTransform[{2, 0}] @
       ReflectionTransform[{-1, 0}] @ #, #] & @ CirclePoints[{1, 0}, 100];

colors = {RGBColor[{7/10, 2/5, 3/5}], RGBColor[{0, 3/5, 3/10}], 
    RGBColor[{2/5, 7/10, 9/10}], RGBColor[{0, 3/5, 3/5}], RGBColor[{2/5, 1/5, 1/2}], 
    RGBColor[{1/5, 2/5, 3/5}], RGBColor[{1, 7/10, 1/10}], RGBColor[{9/10, 2/5, 2/5}]};

labels = Join[#, 4 + #] & @ Reverse[Range @ 4];

mesh = -Range[1, 16, 2] /16;

epilog = MapThread[Text[Style[#, 20, Bold, Gray], #2, Center] &, 
  {{"Mod/Dev", "Ops"}, {{0, 0}, {2, 0}}}];

meshStyle2 = (#1 /. Point[x_] :> 
 (With[{i = Last[labels = RotateLeft[labels]]},
  {Opacity[0.5], Gray, Disk[#1, Offset[24]], 
   Opacity[1], White, Disk[#1, Offset[16]], 
   Text[Style[i, RotateLeft[Reverse@colors, 4][[i]], 24, Bold], #1]}] &) /@ 
   Union[x] &);

plot1 = ParametricPlot[bSF[-t], {t, -1, 0}, 
  PlotStyle -> Directive[CapForm["Round"], AbsoluteThickness[24]], 
  MeshFunctions -> {#3 &}, 
  Mesh -> {mesh },
  MeshShading -> colors, 
  Axes -> False, 
  ImageSize -> 800, 
  PlotPoints -> 200,
  MaxRecursion -> 0,
  Epilog -> epilog, 
  MeshStyle -> meshStyle2]

enter image description here

To get the magenta segments on top we need further processing:

postProcess = ReplaceAll[{d_, lines : ({_, _Line} ..)} :> 
   {d, Map[If[Length@# == 1, #, 
     {#[[1, 1]], Line[Join[Reverse@#[[1, 2, 1]], Reverse@#[[2, 2, 1]]]]}]&]@
      SortBy[Length @ # &] @ GatherBy[{lines}, First]}];


plot2 = postProcess @ plot1

enter image description here

Finally, add annotations and manually adjust the label locations:

annotations2 = MapThread[Text @ Framed[Style[##, 14], 
       FrameStyle -> None] &, {{"Plan requirements\nand properties", 
      "Modeling architecture\nand parts", "Virtual integration", 
      "Code generation", "System assembly", 
      "Run ∥ Simulate", "Monitor", 
      "Data analysis"}, RotateRight[Reverse@colors, 4]}][[labels]];

DynamicModule[{pts = First @ Cases[plot2, GraphicsComplex[c_, ___] :> 
   c[[DeleteDuplicates@Cases[plot2, Disk[a_, _] :> a, All]]],  All]}, 
 LocatorPane[Dynamic[pts], Show[plot2, PlotRangePadding -> Scaled[.15]], 
 Appearance -> annotations2]]

enter image description here

$\endgroup$
2
  • $\begingroup$ This works beautifully and I can easily snip the output for pasting and placement in documents. Thank you! $\endgroup$
    – Moo
    Feb 27, 2022 at 11:25
  • $\begingroup$ I like that even better, thank you for adding it. $\endgroup$
    – Moo
    Feb 28, 2022 at 3:00
10
$\begingroup$

One way is to generate spline function and use it as reference points:

func = BSplineFunction[{{1, 0}, {1, 1}, {0, 1}, {0, 0}, {1, 0}, {1, 
 1}, {2, 1}, {2, 0}}, SplineClosed -> True, SplineKnots -> "Unclamped"];

seg = (.125 Range[0, 8]);
parts = Partition[seg, 2, 1];

Choose desired colors:

color = ColorData[29, "ColorList"][[;; Length[parts]]];

Graphics[{Thickness[.04], CapForm["Round"], 
 MapThread[{#1, Line[func /@ Range[Sequence @@ #2, .01]]} &, {color,  parts}], 
{RGBColor[0.14, 0.39, 0.86, 0.36], PointSize[.08], Point[func /@ Most[seg]]}, 
{White, PointSize[.05], Point[func /@ Most[seg]]}, 
[Text[Style[i, color[[i]], Bold, 15], func[seg[[i]]]], {i, 1, 
8}], Text["System assembly", func[seg[[5]]] + {0, .2}]}]

enter image description here You could add rest of text by the way System assembly added.

$\endgroup$
1
  • $\begingroup$ I am amazed by how short the ode you wrote is! +1. Thank you! $\endgroup$
    – Moo
    Feb 28, 2022 at 3:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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