7
$\begingroup$

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:

enter image description here

Any hints are much appreciated.

$\endgroup$
10
$\begingroup$

Update 2: Relabeling vertices using VertexReplace:

With[{gr1 = SetProperty[g @ l1, VertexLabels -> "Name"]}, 
 VertexReplace[gr1, 
  Thread[SortBy[VertexList[gr1], Length@VertexComponent[gr1, #] &] -> VertexList[gr1]]]]

enter image description here

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

enter image description here

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

enter image description here

l2 = {{1, 1, 1}, {2, 3, 2}, {2, 3, 1, 2, 3, 3, 4}};
g @ l2

enter image description here

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

enter image description here

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

enter image description here

l5 = NestList[PadRight[#, 2 Length @ #, "Periodic"]&, {1, 3, 2}, 5];
SetProperty[UndirectedGraph[g @ l5], {ImageSize -> Large, GraphLayout -> "RadialEmbedding"}]

enter image description here

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

enter image description here

$\endgroup$
  • $\begingroup$ That is amazing! thank you so much! $\endgroup$ – amator2357 May 8 at 15:10
  • 1
    $\begingroup$ 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},...} ? $\endgroup$ – amator2357 May 8 at 15:50
  • 3
    $\begingroup$ @amator2357 Instead of the undocumented GraphComputation`ExpressionGraph, 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. $\endgroup$ – Szabolcs May 8 at 17:06
  • $\begingroup$ @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. $\endgroup$ – amator2357 May 8 at 20:09
  • $\begingroup$ @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). ... $\endgroup$ – Szabolcs May 8 at 21:03
4
$\begingroup$

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

enter image description here

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]

enter image description here

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.

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – amator2357 May 9 at 8:38
1
$\begingroup$

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

enter image description here

Below is what I needed it for:enter image description here

Update: Both @kglr's and @Szabolc's answers do exactly what I needed now, in a much neater way.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.