Visualize a tree structure using TreeGraph

Question

I have a code that generates a tree of graphics objects. The structure can be visualized like this, with each Rule constituting a parent child relationship:

children[list_] := ReplaceList[list, {a___, x_, b___} :> Rule[x, children[{a, b}]]]
children[{a, b, c}] // TreeForm

A better way of visualizing the result I want, courtesy of Halirutan is this:

children[list_] :=  ReplaceList[list, {a___, x_, b___} :> (x @@ children[{a, b}])]
children[{a, b, c}] // TreeForm

However my real code like I said has graphics in it. So each symbol in the above image is a graphics object. An example of this:

r[col_] := Graphics[{col, Rectangle[]}]
treeData = children[{r[Red], r[Green], r[Blue]}];

I would like to visualize this tree using TreeGraph where each VertexShape is the corresponding graphics object. So for the leftmost branch I expect graphics object a and from it two arrows one two graphics object b and one to graphics object c and so on. Example of expected output from children[{r[Red],r[Blue]}] // renderTree:

TreeGraph[{
  DirectedEdge[1, 2],
  DirectedEdge[1, 3],
  DirectedEdge[2, 4],
  DirectedEdge[3, 5]
  }, VertexShape -> {
   2 -> r[Red],
   3 -> r[Blue],
   4 -> r[Blue],
   5 -> r[Red]
   }, VertexSize -> 0.5]

Speed is not important since I will only be doing this on relatively small trees for visualization purposes. I can change the code that generates the tree data so you are free to do that as well, you don't have to work with the data as it is. You might want to insert custom heads for example. That is one approach I've tried. However I don't have any code to share, I hope that will not cause a riot. But if it does I shall accept it stoically I hope, I know how important showing an effort is to some of you. I don't know what a good start is.

Answer 1

Let me give you an outline. First and as discussed in chat I change your tree data-structure a bit to make it smaller. A tree with a root r and two children a and b is now represented as r[a,b] which is a natural representation in Mathematica. To create a tree like you showed I use a function Node which does the job.

Node[root_, {args__}] := root[Sequence @@ 
    ReplaceList[{args}, {start___, elm_, end___} :> Node[elm, {start, end}]]];
Node[root_, {}] := root

Node[root, {r, g, b}] // TreeForm

The tree in pure input form can be given by

root[r[g[b], b[g]], g[r[b], b[r]], b[r[g], g[r]]]

To transform this into a representation suitable for TreeGraph it is probably best if you familiarise yourself with how to traverse a tree. One easy method is the following which will later be used and is now given as toy-function which traverses the tree and just prints the nodes it sees:

test[h_[childs__]] := (Print[h]; test /@ {childs});
test[leaf_] := Print[leaf]

test[Node[root, {r, g, b}]];

As output you see how the nodes are visited in pre-order (or depth-first). The rest is quite easy. On every visit you have knowledge about the node and its children so you just have to label the nodes with a unique id (I called it counter) and then you create the DirectedEdge and the rendered shape rule you need. This all happens in the traverse function. Then only the result list needs to be restructured to fit into TreeGraph

makeTree[nodes_, renderFunc_] := Module[{counter = 0},
  traverse[h_[childs___]] := With[{id = counter},
    {DirectedEdge[id, ++counter], counter -> renderFunc[#], 
       traverse[#]} & /@ {childs}];
  traverse[_] := Sequence[];

  TreeGraph[#1, VertexShape -> #2] & @@ 
   Transpose[Partition[Flatten[traverse[nodes]], 2]]
]

Finally, we need the renderFunc. Since all our nodes and leafs look like r[...] or r respectively, a simple implementation is straight forward

render[r[___] | r] := Graphics[{Red, Rectangle[]}];
render[b[___] | b] := Graphics[{Blue, Rectangle[]}];
render[g[___] | g] := Graphics[{Green, Rectangle[]}];

Et voila

makeTree[Node[root, {r, g, b}], render]