# Graph that shows how symbols are used in an expression

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.

• Cheating: Graph[Flatten[Inner[{##} -> Times[##] &, {{a, b, c}, {d, e, f}}, {{g, h}, {i, j}, {k, l}}, Thread /@ {##, Map[Last, {##}] -> Total[Map[Last, {##}]]} &]], GraphLayout -> "LayeredDrawing", VertexLabels -> "Name"] – J. M. is in limbo Dec 23 '16 at 21:46

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.

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

f @ expr


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


• But this (and kglr's) duplicates nodes. I think the OP wanted only one a node with two out-edges, instead of two nodes each with one out-edge. – Szabolcs Dec 11 '18 at 21:55
• Oh I see. I didn't read carefully enough. I just thought the OP wanted a Graph from TreeForm. I'll leave this thing up since it's a convenient function that I might want in the future, but clearly it doesn't answer the question. – b3m2a1 Dec 11 '18 at 21:57