Allow multiple GUI elements to react dynamically to interaction with a single element

Question

I was looking at how to reproduce the interactivity in this visualization (the layout can be done like this). Hovering a node with the mouse highlights all edges that are connected to it. How can we reproduce this type of interactivity in Mathematica and still preserve good performance?

If there is a single notebook element which needs to react to interaction, there are usually direct ways to do that, without the need for intermediate variables. For example:

Graphics[{Dynamic@Style[Disk[], If[CurrentValue["MouseOver"], Red, Black]]}]

But in the example linked above, edges must highlight in response to hovering vertices and there's a many-to-many relationship between these two types of objects. Each edge must respond to hovering two different vertices. Hovering a vertex must highlight multiple different edges. How can we access the state of one type of object (vertex) while computing the dynamic style of an edge?

I tried two approaches:

1. The first one uses a boolean vector in a DynamicModule to store the hover state of vertices. This is then read by the styling of edges. This approach is not fast enough.

2. The second one uses MouseAnnotation. This is considerably slower than the first one.

Can we make it faster?

---

Let's make a graph:

n = 80; (* number of vertices *)
names = Range[n]; (* vertex names, in this case they are simply the vertex indices *)
pts = AssociationThread[names -> N@CirclePoints[n]]; (* vertex coordinates *)
edges = RandomSample[Subsets[names, {2}], 250]; (* graph edges *)

---

With boolean vector in DynamicModule:

DynamicModule[{state = ConstantArray[False, n]}, 
   Deploy@Graphics[
    {
      With[{pt1 = pts[#1], pt2 = pts[#2]},
        {Dynamic@If[state[[#1]] || state[[#2]], Red, Black], Line[{pt1, pt2}]} 
      ]& @@@ edges,

      PointSize[0.025], 
      With[{pt = pts[#]},
        {Dynamic@If[state[[#]], Red, Black], 
         EventHandler[Point[pt], 
           {"MouseEntered" :> (state[[#]] = True), 
            "MouseExited"  :> (state[[#]] = False)}
         ]
        } 
      ]& /@ names
    }, 
   ImageSize -> Large]]

---

With MouseAnnotation. Warning: this may temporarily freeze the front end!

Deploy@Graphics[
  {
   With[{pt1 = pts[#1], pt2 = pts[#2]},
    {Dynamic@If[MouseAnnotation[] === #1 || MouseAnnotation[] === #2, Red, Black], 
     Line[{pt1, pt2}]} 
   ]& @@@ edges,

   PointSize[0.025],
   With[{pt = pts[#]},
     Annotation[
       Dynamic@Style[Point[pt], If[CurrentValue["MouseOver"], Red, Black]], 
       #, 
       "Mouse"
     ] 
   ]& /@ names
  },
  ImageSize -> Large
]

---

The graph size in this example is not excessive. It is about the same as the vertex and edge counts of ExampleData[{"NetworkGraph", "LesMiserables"}] (77, 254), which I used while working on the layout part.

Answer 1

n = 120;
names = Range[n];
pts = AssociationThread[names -> N@CirclePoints[n]];
edges = RandomSample[Subsets[names, {2}], 250];

There are two reasons why Dynamic scales badly:

• there is no (documented) way to tell a "DynamicObject" to update, one can only count on dependency tree which is created.

• one can track only Symbols

The second one implies that big lists/associations will always update each Dynamic they are mentioned in. Even when each one only cares about a specific value.

Additionaly symbols renaming/management tools in Mathematica are surprisingly limited/not suited for a type of job I am about to show. The following solution may be unreadable at first sight.

The idea is to create symbols: state1, state2,... instead of using state[[1]]. This way only specific Dynamic will be triggered when needed, not all of state[[..]].

DynamicModule[{},
 Graphics[{
   (
    ToExpression[
      "{sA:=state" <> ToString[#] <> ", sB:=state" <> ToString[#2] <> "}",
      StandardForm, 
      Hold
    ] /. Hold[spec_] :> With[spec, 
       {  Dynamic @ If[TrueQ[sA || sB], Red, Black], 
          Line[{pts[#1], pts[#2]}]
       }
    ]
   ) & @@@ edges
   ,
   PointSize[0.025],
   (
    ToExpression[
      "{sA:=state" <> ToString[#] <> "}", 
      StandardForm, 
      Hold
    ] /. Hold[spec_] :> With[spec, 
       { Dynamic @ If[TrueQ[sA], Red, Black], 
         EventHandler[ Point @ pts[#], 
           {"MouseEntered" :> (sA = True), "MouseExited" :> (sA = False)}
         ]
       }
    ]
   ) & /@ names
  }, 
  ImageSize -> Large]
 ]

Ok, we can go even further. This code still communicates with the Kernel while it doesn't have to:

ClearAll["state*"]
ToExpression[
 "{" <> StringJoin[
   Riffle[Table["state" <> ToString[i] <> "=False", {i, n}], ","]] <> 
  "}",
 StandardForm,
 Function[vars,
  DynamicModule[vars, 
   Graphics[{(ToExpression[
          "{sA:=state" <> ToString[#] <> ", sB:=state" <> 
           ToString[#2] <> "}", StandardForm, Hold] /. 
         Hold[spec_] :> With[spec, {RawBoxes@DynamicBox[

              FEPrivate`If[
               FEPrivate`SameQ[FEPrivate`Or[sA, sB], True], 
               RGBColor[1, 0, 1], RGBColor[0, 1, 0]]], 
            Line[{pts[#1], pts[#2]}]}]) & @@@ edges, 
     PointSize[
      0.025], (ToExpression["{sA:=state" <> ToString[#] <> "}", 
          StandardForm, Hold] /. 
         Hold[spec_] :> 
          With[spec, {RawBoxes@
             DynamicBox[
              FEPrivate`If[SameQ[sA, True], RGBColor[1, 0, 1], 
               RGBColor[0, 1, 0]]], 
            EventHandler[
             Point@pts[#], {"MouseEntered" :> FEPrivate`Set[sA, True],
               "MouseExited" :> FEPrivate`Set[sA, False]}]}]) & /@ 
      names}, ImageSize -> Large]]
  ,
  HoldAll
  ]
 ]

Finally something neat completely FrontEnd side :)

Answer 2

Here is a refactor of Kuba's wonderful answer. I hope it may help somebody understand the order in which things are evaluated better. This version should also be resistant against conflicting symbol names, though perhaps it would have been easier to achieve that using contexts. A few things that I thought might be unnecessary have been removed.

n = 100;
names = Permute[Range[10*n], RandomPermutation[10*n]][[;; n]];
pts = AssociationThread[names -> N@CirclePoints[n]];
edgesIndices = 
  RandomSample[Subsets[Range[n], {2}], Quotient[n Log[n], 2]];
edges = Map[names[[#]] &, edgesIndices, {2}];

heldStates = 
  Join @@ (ToExpression["state" <> ToString[#] , InputForm, Hold] & /@
      names);
dynModVars = List @@@ Hold@Evaluate[Set @@@ Thread[{
        heldStates,
        Hold @@ ConstantArray[False, n]
        }, Hold]];
preMapThread = Apply[List,
   Hold@Evaluate[
     Join[heldStates[[#]] & /@ Transpose@edgesIndices, Transpose@edges]],
   {1, 2}];
preAppMap = Thread[{heldStates, Hold @@ names}, Hold];
edgeDisplayerMaker = Function[
   {sA, sB, name1, name2},
   {DynamicBox[
     If[FEPrivate`Or[sA, sB], RGBColor[1, 0, 1], RGBColor[0, 1, 0]]], 
    Line[{pts[name1], pts[name2]}]}
   , HoldAll];
interactivePointMaker = Function[
   {sA, name},
   {DynamicBox[If[sA, RGBColor[1, 0, 1], RGBColor[0, 1, 0]]], 
    EventHandler[
     Point@pts[name], {"MouseEntered" :> FEPrivate`Set[sA, True], 
      "MouseExited" :> FEPrivate`Set[sA, False]}]}, HoldAll];

Perhaps the structure of the DynamicModule is now a little clearer.

DynamicModule @@ {
  Unevaluated @@ dynModVars
  ,
  Unevaluated@
   Graphics[{
     MapThread @@ {
       edgeDisplayerMaker,
       Unevaluated @@ preMapThread},
     PointSize[0.025],
     List @@ interactivePointMaker @@@ preAppMap
     }, ImageSize -> Large]}