How to create Locator[] hierarchies?

Question

I'd like to 'parent' Locators to one another, ideally organized in any arbitrary tree.

The simplest case: If I have two Locators, A and B, then moving A will move both together, but moving B will only move that one.

Any simple suggestions?

Answer 1

Not as fancy as belisarius' solution, but here's my approach. To store the tree, I'm using nested lists, so for example

tree = {1, {2}, {3}, {4, {5}, {6}}}

would define a tree with root 1 and children are 2, 3, and 4, where node 4 has children 5 and 6. From this we can construct a list of nodes and for each node a list of descendants:

nodelist[tree_] := Union[Flatten[tree]];
descendants[tree_] := nodelist[tree] /. 
   Flatten[MapIndexed[#1 -> Flatten@tree[[Sequence @@ Most[#2]]] &, tree, {-1}]];

To construct a list of edges from the tree you can do something like

toEdges[{root_}] := {}
toEdges[{root_, p : {__} ..}] := (Sow[{root, #[[1]]}]; toEdges[#]) & /@ {p};
edgelist[tree_] := Reap[toEdges[tree]][[2, 1]];

Finally, we construct a list of Dynamics which will be used for dynamically updating the coordinates of the nodes. Here pt is a dummy function.

dynamics[tree_, pt_] := MapThread[Function[{ind, dec},
    Dynamic[pt[ind], {(crds0 = Transpose[pt /@ dec] - #) &,
       (MapThread[(pt[#1] = #2) &, {dec, Transpose[crds0 + #]}]) &,
       None}]], 
    {nodelist[tree], descendants[tree]}];

Usage

Consider an arbitrary tree tree whose nodes have coordinates crds

tree = {1, {2}, {3, {4}, {5, {6}, {7}}}, {8, {9}, {10}}};
crds = AbsoluteOptions[#, VertexCoordinates][[2]] &@
   Graph[DirectedEdge @@@ edgelist[tree], GraphLayout -> "SpringElectricalEmbedding"];

Then you could do something like

DynamicModule[{pt, edges, nodes, dyn},
 dyn = dynamics[tree, pt];
 edges = edgelist[tree];
 nodes = nodelist[tree];
 Evaluate[pt /@ nodes] = crds;
 Graphics[{Arrow[Dynamic[pt /@ #]] & /@ edges, Locator /@ dyn},
  PlotRange -> ({Min[#] - 1, Max[#] + 1} & /@ Transpose[crds])]]

Answer 2

I would do it by introducing as a third variable the displacement between A and B, and then using Dynamic's second argument to update B when A is moved:

a = {0, 0}; b = {0.5, 0.5}; db = b - a;
Show[
 Graphics@Locator[Dynamic[a, (a = #; b = # + db;) &], Background -> Red],
 Graphics@Locator[Dynamic[b, (b = #; db = # - a;) &], Background -> Blue],
 PlotRange -> 2
 ]
Dynamic@a
Dynamic@b

Answer 3

With an arbitrary locator dependency tree

Updated Now the sub-blocks move as one piece (per @RM request).

Lets first generate a dependency tree and calculate a few values for future use:

(*A dependency graph template*)
g[ns_, treeOrder_, data_] := KaryTree[ns, treeOrder, VertexLabels -> 
    Table[i -> Placed[data[[i]] // TableForm, Before], {i, ns}], ImagePadding -> 40, 
    VertexStyle -> Table[i -> ColorData[3, "ColorList"][[i]], {i, ns}],
    VertexSize -> Medium, DirectedEdges -> True, VertexCoordinates -> vc, ImageSize -> 500];

ns = 10;(*Number of nodes*)
(*Generate a Random dependencies Tree*)
treeOrder = RandomInteger[{2, 5}];
ktt = g[ns, treeOrder, RandomReal[1, {ns, 2}]];
(*Store some values for using them later in the dynamic constructs*)
vc = PropertyValue[{ktt, #}, VertexCoordinates] & /@ VertexList[ktt];
(*Plot Range*)
pr = {Min@# - 1, Max@# + 1} & /@ Transpose@vc;
(*dependency list for each node*)
voc = Reverse /@ (VertexOutComponent[ktt, #, Infinity] & /@ VertexList[ktt]);
inD = False;(*To control the firing of events, due to a bug in Locator/Dynamic*)

Now the main dynamic code:

DynamicModule[{n = ns, data = vc, dataPrsrv = vc},
 Framed@Column[{
    (*Draw locators and drag the dependency tree*)
    Dynamic[Framed@Show[
       Table[With[{i = i},
         Graphics[Locator[
           (*Each locator drags its dependency tree*)
           Dynamic[data[[i]],(* 3 funcs for the drag follow {start, active, end}*)
            {If[! InD, (dataPrsrv = data); InD = True] &,
             (data[[i]] = #; 
             ((data[[#]] = dataPrsrv[[#]] + (data[[i]] - dataPrsrv[[i]])) & /@ voc[[i]])) &, 
             (InD = False) &}],
           Graphics[{ColorData[3, "ColorList"][[i]], Disk[]}], ImageSize -> 20],
          PlotRange -> pr]], {i, ns}], ImageSize -> 300]],
    (*Draw the tree and update coordinates*)
    Dynamic@g[ns, treeOrder, data]}, Center]]

Chinese instruction manual:

Answer 4

Here is a rather short example of a potential way of getting this functionality. Initially we need to decide on a structure for the tree. I'm going with simply a list of lists type tree, where the first element of each list is assumed to be it's head. Except at the very first level, where each node is considered a child.

 tree = {{0,1}, {{0, 2}, {1, 2}}, {{3, 4}}, {{0, 3}, {1,3}, {{1, 4}, {3, 3}}}};

Having this structure we can apply a function to each leaf by calling; Map[f, tree, {-2}]. Now the trick is just to define a function that will update the tree such that if we change tree[[2,1]], both tree[[2,1]] and tree[[2,2]] are updated. First I define a function that will map the change out over all elements under a given level:

SetAttributes[updateTree, HoldFirst]
updateTree[tree_, newposition_, indices__] := 
 tree[[indices]] = Map[# + (newposition - tree[[indices, 1]]) &, tree[[indices]], {-2}];

Then I define a new dynamic wrapper that will insert this updating function for any element having indexes ending in 1.

SetAttributes[treeDynamic, HoldAll]
 treeDynamic[tree_[[indices__]]] := Dynamic[tree[[indices]]]
 treeDynamic[tree_[[indices__, 1]]] := 
           Dynamic[tree[[indices, 1]], updateTree[tree, #, indices] &] 

Then it's just a matter of mapping this wrapper over the tree and putting it into locators, note that I pass the index through an anonymous function in order for the pattern to match even though treeDynamic has HoldAll

 MapIndexed[Locator[treeDynamic[tree[[##]]]] & @@ #2 &, tree, {-2}] // Graphics