Graph that shows how symbols are used in an expression

Question

I would like to make a graph to show how symbols build up an expression. For example, the matrix multiplication

$$ \left( \begin{array}{ccc} a & b & c \\ d & e & f \\ \end{array} \right).\left( \begin{array}{cc} g & h \\ i & j \\ k & l \\ \end{array} \right) $$

looks like:

The code is:

A={{a,b,c},{d,e,f}};
B={{g,h},{i,j},{k,l}};
expr=A.B//Flatten;
expr2edges[ee_]:=Table[arg->ee,{arg,List@@ee}]
edges={};
For[ii=2,ii<Depth[expr],ii++,
    newEdges=(expr2edges/@Level[expr,{-ii}]);
    AppendTo[edges,newEdges]
]
Graph[Flatten[edges],VertexLabels->Automatic]

My intent is so close to an inverted TreeForm that I feel there must be a better way to write this. Possibly with a clever use of patterns & replacement.

How can I improve my code? Is this answer the right way to go about it -- with Sow / Reap?

Thanks folks.

Answer 1

Let us use IGExpressionTree from IGraph/M. This function returns a Graph of the expression tree where the vertex names are the positions of subexpressions.

expr = Flatten[( {
     {a, b, c},
     {d, e, f}
    } ).( {
     {g, h},
     {i, j},
     {k, l}
    } )]

Graph[
 Join @@ Function[expr,
    Map[
     First@Extract[expr, {#}] &,
     EdgeList@ReverseGraph@IGExpressionTree[expr],
     {2}
     ]
    ] /@ expr,
 VertexLabels -> "Name"
]

Or a bit simpler:

Graph[
 EdgeList@ReverseGraph@VertexDelete[IGExpressionTree[expr], {}] /. 
    pos : {___Integer} :> First@Extract[expr, {pos}],
 VertexLabels -> "Name"
]

---

Update: Here's a very compact way that does not use IGraph/M:

Graph[
 Reap[expr /. t : _[___, s_, ___] /; (Sow[s -> t]; False) -> Null][[-1, 1]],
 VertexLabels -> "Name"
]

I used ReplaceAll to traverse the expression tree, recording the edges as we go. We put a Condition on the pattern that always returns False, forcing the traversal to go through the entire expression. As part of evaluating the condition, the relevant information is recorded.

Answer 2

ClearAll[f]
f[e_] := TransitiveReductionGraph[RelationGraph[And[UnsameQ[##], Not[FreeQ[#2, #]]] &, 
   DeleteDuplicates@Level[e, All]], VertexShapeFunction -> "Name"]

f @ expr

Answer 3

Here's another post-processing answer to get a Graph directly from the TreeForm. It won't perform as well as Szabolcs' answer but it certainly works fine:

ClearAll[treeGraph]
treeGraph[exp_] :=
 Module[{gc, coordinates, nodes, labels, edges, g1},
  gc = ToExpression[ToBoxes@TreeForm[exp]][[1, 1]];
  labels = 
   Association@
    Cases[gc, Inset[expr_, pos_, ___] :> pos -> expr, \[Infinity]];
  edges = 
   DirectedEdge @@@ 
    Flatten@Cases[gc, Line[pairs : {__}, ___] :> Rule @@@ pairs, 
      Infinity];
  coordinates = gc[[1]];
  g1 =
   Graph[
    edges,
    VertexLabels -> Normal@Map[Placed[#, Center] &, labels],
    VertexSize -> Tiny
    ];
  Graph[g1, VertexCoordinates -> coordinates[[VertexList[g1]]]]
  ]

We can do all the basic Graph stuff with this too:

gg = expr // treeGraph

gg // AdjacencyMatrix // MatrixPlot