在Mathematica中绘制分解树的最简单方法是什么？

Question

我想在Mathematica中绘制一个“分解树”。

我有一个函数f，它接受​​一个对象并以列表的形式返回该对象的所有组件。出于这个问题的目的，让我们将Mathematica表达式分解如下（我的实际f依赖于外部数据库来分解不同类型的对象，所以我不能轻易发布它：）

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

我想创建一个树形图，显示在递归继续应用f时如何分解对象。对于上面的特定示例f，我们应该得到与TreeForm的输出非常相似的内容，除了应该在每个节点上显示完整表达式（而不仅仅是头部）。节点的子节点将成为f返回的组件。

请注意，元素可以在这样的分解树中重复，但不会在TreePlot的输出中重复元素，因为它与图形一起使用。一个想法是为每个节点生成一个唯一的“内部名称”，构建一个图形，并使用TreePlot，将其设置为显示节点的实际形式而不是它们的“内部名称”

Answer 1

这个怎么样？

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

如果任何条款不是惰性的，这种“简单”（？）方法将无效。

Answer 2

我不确定它是否回答了你的问题，但这是我将如何实现基本的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

然后：

修改 是的你是对的，这不是一棵树。为了使它成为一棵树，每个表达式都应随身携带它的位置。有点像这样：

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

然后

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