Construct a permutation tree plot
You can use ExpressionGraph
to draw the tree
expr = ConstantArray[x, Reverse @ Range[4]];
ExpressionGraph[expr, GraphLayout -> "LayeredEmbedding", ImageSize -> Large]
epxr2 = ConstantArray[x, Reverse @ Range[5]];
ExpressionGraph[expr2, GraphLayout -> "LayeredEmbedding", ImageSize -> 700,
VertexSize -> Medium, AspectRatio -> 1/2]
Define a function that constructs a permutation tree with edge labels:
ClearAll[rule, permutationTree]
rule = # /. x : {___Integer} /; Length[x] > 1 :>
(Reverse /@ Subsets[Reverse@x, {Length[x] - 1}]) &;
permutationTree[n_, opts : OptionsPattern[Graph]] :=
Module[{eg = ExpressionGraph[ConstantArray[x, Reverse@Range[n]],
opts, GraphLayout -> "LayeredEmbedding",
ImageSize -> 700, VertexSize -> Medium, AspectRatio -> 1/2],
edgelabels},
edgelabels = Thread[First @ Last @ Reap@
BreadthFirstScan[eg, 1, {"FrontierEdge" -> Sow}] ->
Flatten@NestList[rule, Range[n], n - 1]] ;
SetProperty[eg, EdgeLabels -> edgelabels]]
Examples:
permutationTree[3]
permutationTree[4]
permutationTree[4, GraphLayout -> "RadialEmbedding",
AspectRatio -> 1, EdgeLabelStyle -> Large]
permutationTree[5, ImageSize -> 900]
Alternatively, you can use TreeForm
:
TreeForm[expr, ImageSize -> Large, VertexLabeling -> False]
Note: For versions older than v12.0, replace ExpressionGraph
with GraphComputation`ExpressionGraph
. (See also this answer.)
Using my package IGraph/M,
Needs["IGraphM`"]
IGSymmetricTree[{4, 3, 2, 1}, GraphLayout -> "LayeredEmbedding"]
See its documentation, which shows precisely the tree you are asking for.
Using a slight modification of the code in Wolfram Demonstrations >> Permutation Tree (linked by George Varnavides in comments) and adding edge labels:
ClearAll[permTree]
permTree[n_, opts : OptionsPattern[Graph]] := Module[{el = Union @@
Map[Rule @@@ Partition[FoldList[Append, {}, #], 2, 1] &, Permutations @ Range @ n]},
Graph[el, opts, DirectedEdges -> False,
GraphLayout -> "LayeredEmbedding", EdgeLabels -> {e_ :> e[[2, -1]]}]]
Examples:
permTree[3, ImageSize -> Large,
VertexLabels -> {v_ /; Length[v] == 3 :> Placed[Column @ v, Below]}]
permTree[4, ImageSize -> 800,
VertexLabels -> {v_ /; Length[v] == 4 :> Placed[Column @ v, Below]}]
permTree[4, ImageSize -> Large, GraphLayout -> "RadialEmbedding"]