Jak ten dynamiczny wykres jest możliwy z matematyką?

Question

Tutaj jest dynamiczny BBC graphics. Myślę, że możliwe jest odtworzenie grafiki w Mathematica.

W procesie odpowiadając ujrzymy kilka uroczych sztuczek graficznych dostępnych w MMA. To jedyny powód, by zadać to pytanie tutaj.

Aktualizacja:

Właśnie sprawdziłem, że BBC jest za pomocą prostego JavaScript, aby to zrobić. Ręcznie wykonali statyczne obrazy, a nawet nie korzystali z obsługi zdarzeń opartych na technologii Flash. Wszystkie zdjęcia są więc statycznymi obiektami i po kliknięciu jednego kraju generowany jest unikalny obraz. W przypadku innych krajów pokazuje inne obrazy. Oddzielne obrazy dla każdego przypadku można wygenerować za pomocą PowerPoint, Visio, a nawet Photoshop. Można to sprawdzić, wyłączając JavaScript w przeglądarce i ponownie ładując stronę.

Rozumiem, że te pojedyncze zdjęcia można wykonać z MMA. Niektóre odpowiedzi pokazują właściwy kierunek, w jaki można to zrobić. Akceptuję więc najlepszą odpowiedź, jaka doszła do tej pory.

Answer 1

Kolejna rozrusznik:

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] 

Edit Bardziej kompaktowy:

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

To nie jest pełna odpowiedź, ale jest zbyt długi na komentarz. Zachęcam wszystkich do „kradzieży” od niego, a zakończyć go :-)

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

Następnym krokiem jest użycie VertexShapeFunction z obiektów zawinięte w EventHandler zastąpić SetterBar.

Answer 3

Niektóre bardziej podstawowe nóg na to:

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