# TreeGraph construction

I have a list l={{1,1},{2,3},{2,3,2,3,4}}. Based on that list, I want to draw a tree. Starting from a single point at the top of a tree, I proceed as follows, using the list: first we draw two single branches from the first point (that's what {1,1} tells us). Then {2,3} tells us that we go back to the point at the end of the first of the new branches and draw 2 new branches, similarly, from the second new branch, i.e. new point, we draw 3 new branches. So at this point, on the lowest level, we already have 5 points. Then, {2,3,2,3,4} tells us how many branches we draw from each of these points, from left to right. So we would end up with a tree: Any hints are much appreciated.

Update 2: Relabeling vertices using VertexReplace:

With[{gr1 = SetProperty[g @ l1, VertexLabels -> "Name"]},
VertexReplace[gr1,
Thread[SortBy[VertexList[gr1], Length@VertexComponent[gr1, #] &] -> VertexList[gr1]]]] You can also use BreadthFirstScan as suggested by @Szabolcs's in the comments to relabel the vertices:

relabel = Module[{vl = Thread[First@Last@ Reap @ BreadthFirstScan[#, 1,
{"PrevisitVertex" -> Sow}] -> VertexList[#]]},
SetProperty[#, VertexLabels -> vl]] &;

Row[SetProperty[relabel @ #, ImageSize -> 600] & /@ {g @ l1, g @ l4}] ClearAll[g]
g = GraphComputationExpressionGraph[
Map[ConstantArray[x, #] &,
Fold[TakeList, Last[#], Reverse[Rest@Most@#]], {-1}],
VertexLabels -> None] &;


Examples:

l1 =  {{1, 1}, {2, 3}, {2, 3, 2, 3, 4}};
g @ l1 l2 = {{1, 1, 1}, {2, 3, 2}, {2, 3, 1, 2, 3, 3, 4}};
g @ l2 l3 = {{1, 1, 1}, {2, 3, 2}, {2, 3, 1, 2, 3, 3, 4}, {1, 1, 1, 1, 1, 3,
2, 2, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1}};
g @ l3 l4 = {{1, 1, 1}, {1, 2, 1}, {2, 1, 1, 2}, {1, 1, 2, 2, 1, 1}, {2, 2,
1, 1, 1, 1, 2, 2}, {1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1}};
g @ l4 l5 = NestList[PadRight[#, 2 Length @ #, "Periodic"]&, {1, 3, 2}, 5];
SetProperty[UndirectedGraph[g @ l5], {ImageSize -> Large, GraphLayout -> "RadialEmbedding"}] Update: You can also use TreeForm instead of GraphComputationExpressionGraph:

tf = TreeForm[
Map[ConstantArray[x, #] &,
Fold[TakeList, Last[#], Reverse[Rest@Most@#]], {-1}],
VertexLabeling -> False] &;

tf @ l1 • That is amazing! thank you so much! – amator2357 May 8 at 15:10
• is there a way of changing the index of vertices without interfering with a tree , for your function g? So that they're numbered row by row, i.e. {{1},{2,3},{4,5,6,7,8},...} ? – amator2357 May 8 at 15:50
• @amator2357 Instead of the undocumented GraphComputationExpressionGraph, which may change unexpectedly in future versions, you can use IGExpressionTree from IGraph/M. I was going to post an answer with it, but I see that kglr used the same principle. – Szabolcs May 8 at 17:06
• @Szabolcs thank you for that suggestion. The indexing still has to be modified, I'm not even sure if it's possible. Perhaps, I'd have come up with a different way of writing the expression which I pass to IGExpressionTree. Anyway, what a nice package that is. – amator2357 May 8 at 20:09
• @amator2357 What you seem to want is breadth first order. You could obtain the list of vertices in this order using First@Last@BreadthFirstScan[graph, root, {"PrevisitVertex"->Sow] or similar. You need to give the root vertex manually. Then you rebuild the graph as Graph[vertices, edges] then finally apply IndexGraph to rename vertices to their integer index. The problem is that IGExpressionTree uses lists as vertex names, including {}. {} is not accepted as the root vertex by BreadthFirstSearch (this is a bug in Mathematica). ... – Szabolcs May 8 at 21:03

Here's a way using the IGraph/M package.

Before we start I wanted to note that it seems to me that to be consistent, the first element of your list should be {2} and not {1,1}. Each list element has the number of children for each node at each level. At the first level there is one node with two children, i.e. {2}, and not two nodes with one child each.

IGExpressionTree will convert an expression to the Graph in a way similar to TreeForm. The actual names of nodes will be the same as their Position in the input expression. These positions look ugly, but I will use them for labelling below, to make it clear what is happening.

l={{1,1},{2,3},{2,3,2,3,4}}

tree =
IGExpressionTree[
Fold[TakeList, ConstantArray[1, Total@Last[l]], Most@Reverse[l]],
VertexLabels -> "Name", GraphStyle -> "CoolColor"
] The expression this originated from is

Fold[TakeList, ConstantArray[1, Total@Last[l]], Most@Reverse[l]]
(* {{{1, 1}, {1, 1, 1}}, {{1, 1}, {1, 1, 1}, {1, 1, 1, 1}}} *)


Now we need to rename the vertices using integers that come in breadth-first order. Notice that with the existing vertex names, it is sufficient to sort the vertex list to put it in breadth-first order. When sorting, Mathematica considers shorter lists to come before longer ones. Lists of the same length come in lexicographic order.

Sort@VertexList[tree]
(* {{}, {1}, {2}, {1, 1}, {1, 2}, {2, 1}, {2, 2}, {2, 3}, {1,
1, 1}, {1, 1, 2}, {1, 2, 1}, {1, 2, 2}, {1, 2, 3}, {2, 1, 1}, {2, 1,
2}, {2, 2, 1}, {2, 2, 2}, {2, 2, 3}, {2, 3, 1}, {2, 3, 2}, {2, 3,
3}, {2, 3, 4}} *)


We re-order the vertices like so using IGReorderVertices and then rename them to their integer index using IndexGraph.

IndexGraph@IGReorderVertices[Sort@VertexList[tree], tree] The flashy CoolColor style is just for better readability of labels that overlap with edges.

As a bonus, here's a way to convert the output of IGExpressionTree back to the representation you started with.

VertexList[tree] // GroupBy[Length] // KeySort // Rest //
Map@GroupBy[Most] // Map@Map[Length] // Values // Values
(* {{2}, {2, 3}, {2, 3, 2, 3, 4}} *)


This is relatively easy because the vertices of the tree are named naturally and already encode the tree structure.

I always wished that some of the built-in graph generators would return natural vertex names. Maple makes extensive use of natural naming, and takes full advantage of the ability to use any expression for vertices.

Here's what a grid graph looks like in Maple and Mathematica:  There are many missed opportunities here such as DeBruijnGraph, which could be labelled like this.

• Thank you so much for posting your answer. This is such a nice and clear explanation, very useful. Perhaps MathematicaSE should have an option of accepting more than one answer. – amator2357 May 9 at 8:38

I will post my own answer as well, just for completeness. @kglr's and @Szabolcs's answers are much nicer, and work for more general cases, but in my situation, I needed something slightly different, as explained in the comments.

l={{1,1},{2,3},{2,3,2,3,4}}

labels1 = TakeList[Table[i,{i,4,Total@Flatten@l + 1}],Flatten@Drop[#,1]& @ l];

Index = Table[,{i,1,Total@Flatten@l }];
Index[] = 1 \[DirectedEdge] 2;
Index[] = 1 \[DirectedEdge] 3;

labels2 = Flatten@Table[DirectedEdge[i+1,#]& /@ labels1[[i]],{i,1,Length[labels1]}];

Table[Index[[i]]= labels2[[i-2]],{i,3,Length[labels2]+2}];
Index;

TreeGraph[#,VertexLabels->"Index"]& @ Index
` Below is what I needed it for: Update: Both @kglr's and @Szabolc's answers do exactly what I needed now, in a much neater way.