16
$\begingroup$

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.

$\endgroup$
  • 1
    $\begingroup$ off topic note: Don't use Deploy when events handling matters: Passing mouse related events broken by Deploy $\endgroup$ – Kuba Oct 10 '16 at 9:52
  • $\begingroup$ Sorry about all the edits. I made mistakes at the beginning and it's no longer possible to delete an answer, finish editing and undelete. It's finished now. $\endgroup$ – Szabolcs Oct 10 '16 at 10:06
  • 1
    $\begingroup$ In case you are interested in doing this kind of stuff more often and in a more user friendly manner, I started this: github.com/kubaPod/DynamicObjects, I didn't add any release yet but will after weekend. $\endgroup$ – Kuba May 30 '18 at 12:22
  • 1
    $\begingroup$ Done mathematica.stackexchange.com/q/174792/5478 $\endgroup$ – Kuba Jun 6 '18 at 20:56
15
$\begingroup$
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]
 ]

enter image description here

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 :)

$\endgroup$
  • 1
    $\begingroup$ Heya Kuba, I have refactored your code in a community wiki answer, mainly in an attempt to understand what is going on. I have removed RawBoxes heads and SameQ. Maybe take a look? $\endgroup$ – Jacob Akkerboom Oct 10 '16 at 19:42
  • $\begingroup$ @JacobAkkerboom Thanks! Didn't know that Graphics accepts pure boxes. SameQ was a substitute of TrueQ which was just in case. $\endgroup$ – Kuba Oct 10 '16 at 19:46
  • $\begingroup$ I didn't know it accepted RawBoxes so I just figured: "What if I remove this?" :P. Not much depth there ;) $\endgroup$ – Jacob Akkerboom Oct 10 '16 at 20:02
  • $\begingroup$ probably the fiver game can also have a Front End only solution. That might be a nice challenge $\endgroup$ – Jacob Akkerboom Oct 11 '16 at 13:16
  • $\begingroup$ @JacobAkkerboom FrontEnd side is tempting but I often get discouraged quickly due to the lack of documentation :) $\endgroup$ – Kuba Oct 11 '16 at 13:18
7
$\begingroup$

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]}
$\endgroup$
  • $\begingroup$ I will study it soon, I wish I had such ease in assembling held expressions ;) $\endgroup$ – Kuba Oct 10 '16 at 20:02
  • $\begingroup$ @Kuba Ha! I figured after this answer that maybe I would try to use Contexts next instead of wrapping everything in Hold from the get-go, but your comment is motivating :). I like held expressions, and code == data and all that :). $\endgroup$ – Jacob Akkerboom Oct 10 '16 at 20:05
  • $\begingroup$ that is the best way in this case, context are useful for other things, you never know what's on $ContextPath ;) $\endgroup$ – Kuba Oct 10 '16 at 20:07
  • $\begingroup$ @Kuba Hm, I think I made a mistake that I was not punished for (maybe the code is still ok), in that I intended that preMapThread and preAppMap would be evaluated earlier, so that they are in the lexical scope of DynamicModule. Strange that this somehow is not necessary, I'll look into that later. $\endgroup$ – Jacob Akkerboom Oct 11 '16 at 10:10
  • $\begingroup$ still haven't studied it and don't know what do you mean :) $\endgroup$ – Kuba Oct 11 '16 at 10:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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