How is this dynamic plot possible with math?

Question

Here is the dynamic dynamics. I think it would be possible to reproduce the graphics in Mathematica.

In the response process, we will see some charming graphical tricks available in MMA. This is the only reason to ask a question here.

Update:

, BBC JavaScript . - . , , , . . PowerPoint, Visio Photoshop. , JavaScript .

, MMA. , . , .

Answer 1

:

a = Point[{0, 0}];
b = .75 Tuples[{1, -1}, 2][[{3, 1, 2, 4}]];
PieChart[
 {
  Button[1, (a = {Thickness[.05], Arrowheads[.1], 
      Arrow[BSplineCurve@{b[[1]], {0, 0}, #}] & /@ b})],
  Button[1, (a = {Thickness[.05], Arrowheads[.1], 
      Arrow[BSplineCurve@{b[[2]], {0, 0}, #}] & /@ b})],
  Button[1, (a = {Thickness[.05], Arrowheads[.1], 
      Arrow[BSplineCurve@{b[[3]], {0, 0}, #}] & /@ b})],
  Button[1, (a = {Thickness[.05], Arrowheads[.1], 
      Arrow[BSplineCurve@{b[[4]], {0, 0}, #}] & /@ b})],
  }
 ,
 SectorOrigin -> {Automatic, 1},
 Epilog -> Dynamic@a]

. :

a = Point[{0, 0}];
b = .75 Tuples[{1, -1}, 2][[{3, 1, 2, 4}]];
PieChart[
 ReleaseHold[Replace[Table[
    List[1, 
     ReplaceAll[
      Hold[a = {Thickness[.05], Arrowheads[.1], 
         Arrow[BSplineCurve@{k, {0, 0}, #}] & /@ b}], k -> i]],
    {i, b}], List -> Button, {2}, Heads -> True]]
 ,
 SectorOrigin -> {Automatic, 1},
 Epilog -> Dynamic@a]

Answer 2

:

g[\[Alpha]_, \[Beta]_, color_] := Module[{t},
 t = Graphics[{{Thickness[.03], Arrowheads[{.15}], color,
  Arrow[
   BezierCurve[{{Cos[\[Alpha]], Sin[\[Alpha]]}, {0, 
      0}, {Cos[\[Beta]], Sin[\[Beta]]}}]]}},
PlotRange -> 1.5, ImageSize -> 512, Background -> None];
ImageCompose[Blur[t, 15], t]
]

one = Fold[ImageCompose, 
 g[0, \[Pi]/3, Blue], {g[0, \[Pi]/2, Blue], g[0, \[Pi], Blue], 
 g[0, 4 \[Pi]/3, Blue]}]

two = Fold[ImageCompose, 
 g[\[Pi]/3, 0, Yellow], {g[\[Pi]/3, \[Pi]/2, Yellow], 
 g[\[Pi]/3, \[Pi], Yellow], g[\[Pi]/3, 4 \[Pi]/3, Yellow]}]

DynamicModule[{pick = 1},
 ClickPane[
  Dynamic@If[pick == 1, one, two],
  Function[{point}, If[First[point] < 256, pick = 1, pick = 2]]]
 ]

Answer 3

This is not a complete answer, but it is too long for comment. I urge everyone to "steal" from him and complete it :-)

g = RandomGraph[{5, 12}, DirectedEdges -> True];

SetterBar[Dynamic[v], VertexList[g]]

Dynamic@HighlightGraph[
  g, {Style[Cases[EdgeList[g], v \[DirectedEdge] _], 
    Directive[Thick, Black]], Style[v, Red]}, 
  GraphLayout -> "CircularEmbedding", EdgeStyle -> Lighter@Gray, 
  VertexLabels -> "Name"]

The next step is using VertexShapeFunctionwith objects wrapped in EventHandlerto replace SetterBar.