Converting expressions to "edges" for use in TreePlot, Graph

Although kguler posted an answer using a nice internal function that does this (almost) directly I find this kind of expression manipulation interesting in itself so I wanted to see what could be done without it.

expr = a[b[c, d[e][f], g], h];

edges =
  Reap[
    Cases[expr, h_[___, c_[___] | c_?AtomQ, ___] /; Sow[h -> c], {0, -1}] 
  ][[2, 1]];

TreePlot[edges, VertexLabeling -> True]

enter image description here

Or for the different layout:

TreePlot[edges, Automatic, Head @ expr, VertexLabeling -> True]

enter image description here


A user asked about non-unique node names. Here is a first attempt at addressing that case.

tree[expr_] :=
  Module[{e2, edges, head},
    e2 = MapIndexed[head, expr, {0, -1}, Heads -> True];
    edges = Reap[
       Cases[e2, (head[h_, x_])[___, 
          head[head[c_, {z__}][___] | c_?AtomQ, {a__}], ___] /; 
         Sow[Annotation[h, x] -> 
           Annotation[c, If[{z} === {}, {a}, {z}]]], {0, -1}]][[2, 1]];
    edges = edges /. head -> Annotation;
    TreePlot[edges, Automatic, edges[[-1, 1]], VertexLabeling -> True]
  ]

a[b[c, d[e][f], g, b, d[e][b]], h] // tree

enter image description here

This very likely has bugs that will need to be addressed as I did it in a hurry and tired, but I think it at least gives us a place to start.


An alternative method to WReach's method is to use SparseArray`ExpressionToTree which produces the same output without string wrappers:

expr = a[b[c, d[e][f], g], h];
ett = SparseArray`ExpressionToTree[expr]
(* {{a,0,a[b[c,d[e][f],g],h]}->{b,1,b[c,d[e][f],g]},
    {b,1,b[c,d[e][f],g]}->{c,2,c},
    {b,1,b[c,d[e][f],g]}->{d[e],3,d[e][f]},
    {d[e],3,d[e][f]}->{f,4,f},
    {b,1,b[c,d[e][f],g]}->{g,5,g},
    {a,0,a[b[c,d[e][f],g],h]}->{h,6,h}} *)

edges = ett[[All,All,1]] (* thanks: @Mr.Wizard *)
(* or edges = ett /. Rule[a_, b_] :> Rule[First[a], First[b]];*)
(* {a->b,b->c,b->d[e],d[e]->f,b->g,a->h} *)

Graph[edges, VertexLabels -> Placed["Name", {Center, Center}],
             VertexSize -> .3, VertexLabelStyle -> Directive[Red, Italic, 20],
             ImagePadding -> 20, ImageSize -> 400, 
             GraphLayout -> {"LayeredEmbedding", "RootVertex" -> edges[[1,1]]}]

enter image description here

Update: You can also use GraphComputation`ExpressionGraph:

eg = GraphComputation`ExpressionGraph[expr, VertexSize -> Large, 
   VertexLabelStyle -> Directive[Red, Italic, 20]];
SetProperty[eg,  VertexLabels -> {v_ :> 
    Placed[PropertyValue[{eg, v}, VertexLabels], Center]}]

enter image description here


IGraph/M now includes IGExpressionTree:

<<IGraphM`
IGExpressionTree[expr]

enter image description here

GraphQ[%]
(* True *)