TreeGraph construction

Question

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.

Answer 1

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

Original answer:

ClearAll[g]
g = GraphComputation`ExpressionGraph[
    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 GraphComputation`ExpressionGraph:

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

tf @ l1

Answer 2

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.

Answer 3

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]] = 1 \[DirectedEdge] 2;
Index[[2]] = 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.