mathematica如何实现这种动态图？

Question

这是BBC动态graphics。我想有可能在Mathematica中重现图形。

在回答过程中，我们会在MMA中看到一些迷人的图形技巧。这是在这里提出问题的唯一理由。

更新

我刚检查过BBC正在使用简单的JavaScript来完成它。他们手动制作了静态图片，甚至没有使用基于Flash的事件处理。因此，所有图片都是静态实体，一旦我们点击一​​个国家，它就会生成一个独特的图像。对于其他国家，它显示其他图像。每个案例的单独图像可以通过PowerPoint，Visio甚至Photoshop生成。人们可以通过在浏览器中禁用JavaScript并重新加载页面来检查这一点。

据我所知，这些单张照片可以通过MMA制作。一些答案显示了如何做到这一点的正确方向。所以我接受到目前为止最好的答案。

Answer 1

为此更基本的步法：

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 2

这不是一个完整的答案，但是评论太长了。我鼓励每个人“偷”它并完成它： - ）

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

下一步是将VertexShapeFunction与EventHandler中包含的对象一起使用，以替换SetterBar。

Answer 3

只是另一个首发：

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]