¿Cuál es la forma más simple de trazar un árbol de descomposición en Mathematica?

Question

Me gustaría trazar un "árbol de descomposición" en Mathematica.

Tengo una función f que toma un objeto y devuelve todos los componentes de ese objeto como una lista. A los efectos de esta pregunta, vamos a descomponer expresiones de Mathematica de la siguiente manera (mi real f se basa en una base de datos externa para descomponer los diferentes tipos de objetos, por lo que no se puede colocar fácilmente):

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

me gustaría para crear un diagrama de árbol que muestre cómo se descompone un objeto mientras seguimos aplicando de forma recursiva f. Para el ejemplo particular f anterior, deberíamos obtener algo muy similar a la salida de TreeForm, excepto que debería mostrarse una expresión completa (en lugar de solo una cabeza) en cada nodo. Los hijos de un nodo van a ser sus componentes según lo devuelto por f.

Tenga en cuenta que los elementos pueden repetirse en un árbol de descomposición como este, pero no los elementos se repiten en la salida de TreePlot ya que funciona con gráficos. Una idea sería generar un "nombre interno" único para cada nodo, construir un gráfico y usar TreePlot, configurándolo para mostrar la forma real de los nodos en lugar de su "nombre interno"

Answer 1

¿Qué tal esto?

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

Si cualquiera de los términos no son inertes, este enfoque "simple" (?) No funcionará.

Answer 2

No estoy seguro responde a su pregunta, pero aquí es cómo iba a aplicar TreeForm rudimentaria:

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 

continuación:

EDITAR Y Si tienes razón, este no es un árbol. Para que sea un árbol, cada expresión debe llevar consigo su posición. Algo así como así:

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])] 
    ] 

Entonces

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] 
    ]