What is the easiest way to build a decomposition tree in Mathematica?

Question

I would like to build a "decomposition tree" in Mathematica.

I have a function f that takes an object and returns all the components of this object as a list. For the purposes of this question, let me simply decompose the Mathematica expressions as follows (my actual f relies on an external database to decompose various kinds of objects, so I cannot easily place it):

 f[e_?AtomQ] := {} f[e_] := List @@ e 

I would like to create a tree that shows how the object decomposes as we continue to apply f recursively. For the specific example f above, we should get something very similar to the output of TreeForm , except that for each node the full expression (and not just the head) should be displayed. Children from node will be its components returned by f .

Note that elements can be repeated in a decomposition tree like this, but elements in the TreePlot output are not repeated, since it works with graphs. One idea would be to create a unique "internal name" for each node, build a graph and use TreePlot, setting it to display the actual shape of the nodes, rather than their "internal name"

Answer 1

How about this?

 tf[x_] := f[x] /. {{} :> x, r_ :> x @@ tf /@ r} 

If any member is not inert, this “simple” (?) Approach will not work.

Answer 2

I'm not sure if it answers your question, but here is how I would use the rudimentary TreeForm:

 decompose[expr_?AtomQ] := expr decompose[expr_] := Block[{lev = Level[expr, {1}]}, Sow[Thread[expr -> lev]]; decompose /@ lev;] treeForm[expr_] := Reap[decompose[expr]][[-1, 1]] // Flatten 

Then:

EDIT Yes, you're right, this is not a tree. To make this a tree, each expression must carry its position with it. It looks like this:

 ClearAll[treePlot, node, decompose2]; SetAttributes[{treePlot, node, decompose2}, HoldAll]; decompose2[expr_] /; AtomQ[Unevaluated[expr]] := node[expr]; decompose2[expr_] := Module[{pos, list}, pos = SortBy[ Position[Unevaluated[expr], _, {0, Infinity}, Heads -> False], Length]; list = Extract[Unevaluated[expr], pos, node]; list = MapThread[Append, {list, pos}]; ReplaceList[ list, {___, node[e1_, p1_], ___, node[e2_, p2_], ___} /; Length[p2] == Length[p1] + 1 && Most[p2] == p1 :> (node[e1, p1] -> node[e2, p2])] ] 

Then

 treePlot2[expr_] := Module[{data = decompose2[a^2 + Subscript[b, 2] + 3 c], gr, vlbls}, gr = Graph[data]; vlbls = Table[vl -> (HoldForm @@ {vl[[1]]}), {vl, VertexList[gr]}]; Graph[data, VertexLabels -> vlbls, ImagePadding -> 50] ]