10
$\begingroup$

The list

t1 = {1, 2, 3, 3, 4, 4, 3, 3, 4, 3, 3, 2, 3, 4, 2, 3, 2};

might be derived from a pre-order traversal of

tree1 = Tree[1, {Tree[2, {3, Tree[3, {4, 4}], 3, Tree[3, {4}], 3, 3}], 
  Tree[2, {Tree[3, {4}]}], Tree[2, {3}], 2}]

But how to take the original list, t1 here, and build the tree tree1 ?

What have I tried so far ? Nothing to any avail! Well, that's not quite true, I have made some progress with a very procedural code to walk along the list and try to figure out the structure of the tree as each new element is read, but I have a dispiriting feeling that I have missed an obvious usage of some of the smarter functional programming functionality.

$\endgroup$
3
  • $\begingroup$ So the second argument (in your use-cases) would always be a nonempty list? For instance, Tree[4, {}] could not occur? $\endgroup$
    – Michael E2
    Jun 6, 2021 at 14:12
  • $\begingroup$ No, Tree[n,{}] shouldn't occur, that would just be a leaf at level n. Tree looks quite neat and I'm trying to figure out how to use it to replace a lot of old code I have which uses the existing Graph type for manipulating what are really Trees. $\endgroup$ Jun 6, 2021 at 14:15
  • $\begingroup$ Yep, TreeForm has been around so long, it's about time something like Tree has surfaced at the user level. $\endgroup$
    – Michael E2
    Jun 6, 2021 at 14:20

5 Answers 5

13
$\begingroup$

Another way:

toTree // ClearAll;
toTree[{n_}] := Tree[n, None];
toTree[t_List] :=
  Tree[First[t], toTree /@ Split[Rest@t, #2 != t[[2]] &]];

t1 = {1, 2, 3, 3, 4, 4, 3, 3, 4, 3, 3, 2, 3, 4, 2, 3, 2};
toTree[t1]

As @IanFord points out, NestTree[] can do the nesting of trees that toTree[] does explicitly:

children[t_List] := Split[Rest[t], #2 != t[[2]] &];
NestTree[children, t1, Infinity, First]
$\endgroup$
4
  • $\begingroup$ Sweet. Short and to the point. $\endgroup$ Jun 6, 2021 at 19:16
  • $\begingroup$ ... and the points go to ... this answer ! This one strikes me as the most Mathematica-y one, there's rather a whiff of procedurality about the others. $\endgroup$ Jun 7, 2021 at 16:39
  • 1
    $\begingroup$ This method can be used with NestTree: children[t_List] := Split[Rest[t], #2 != t[[2]] &]; NestTree[children, t1, Infinity, First] $\endgroup$
    – Ian Ford
    Jun 9, 2021 at 19:34
  • $\begingroup$ @IanFord Thanks! and welcome to Mma.SE! I have not yet had time to explore all the new tree functions. $\endgroup$
    – Michael E2
    Jun 10, 2021 at 13:58
5
$\begingroup$

You may use SequenceReplace.

traversalToTree[traversal_] :=
 First@Nest[
    Map[
      SequenceReplace[{n_, b : Longest[Except[n_] ..]} :> \[FormalT][n, {b}]]
      , #
      , {-2}
      ] &
    , traversal
    , Length@*DeleteDuplicates@traversal
    ] /. \[FormalT] -> Tree

traversalToTree repeatedly applies SequenceReplace to the second last level of the building tree. Unfortunately using Tree in the replace does not target the correct level so formal t is used and later replaced.

With

t1 = {1, 2, 3, 3, 4, 4, 3, 3, 4, 3, 3, 2, 3, 4, 2, 3, 2};

then

traversalToTree[t1]

Mathematica graphics

The nodes in the traversal can be any AtomQ expression.

traversalToTree[t1 /. {1 -> "z", 2 -> 2.5, 3 -> π, 4 -> "a"}]

Mathematica graphics

Hopes this helps.

$\endgroup$
1
  • $\begingroup$ Very useful, many thanks. SequenceReplace is new to me. I'll see if I can wrap my head around it. $\endgroup$ Jun 6, 2021 at 17:20
4
$\begingroup$

Looking at the tree rules, inspired me to construct that as a string, then by ToExpression bring it to life.

TreeRules

tr = Tree[1, {Tree[2, {3, Tree[3, {4, 4}], 3, Tree[3, {4}], 3, 3}], 
    Tree[2, {Tree[3, {4}]}], Tree[2, {3}], 2}];

TreeRules[tr]

(*Out: 1 -> {2 -> {3, 3 -> {4, 4}, 3, 3 -> {4}, 3, 3}, 2 -> {3 -> {4}}, 2 -> {3}, 2} *)

Code

ClearAll[listToTree];

listToTree::invalid = "Input list is invalid."

listToTree[data_List] := 
 With[{temp = 
    ToString@First@data <> 
     StringJoin@
      MapIndexed[
       Function[{x, y}, 
        With[{next = data[[First@y + 1]]}, 
         Which[next == x + 1, "\[Rule]{", next < x, 
           StringRepeat["}", x - next] <> ",", x == next, ","] <> 
          ToString@next]], Most@data]}, 

  With[{finalTemp = temp <> StringRepeat["}", 
       StringCount[temp, "{"] - StringCount[temp, "}"]]}, 
   If[SyntaxQ@finalTemp, RulesTree@ToExpression[finalTemp], 
    Message[listToTree::invalid]]]]

Example

listToTree[{1, 2, 3, 3, 4, 4, 3, 3, 4, 3, 3, 2, 3, 4, 2, 3, 2}]

enter image description here

listToTree[{1, 2, 3, 2, 3, 4, 5, 3, 2, 3}]

enter image description here

$\endgroup$
1
  • $\begingroup$ Thanks, that looks very useful. I'd had that thought too, of transforming the list to a string for manipulation, then back to a Tree, but my nascent solution is neither complete nor as neat as yours. I await a solution which does not require stringification ! $\endgroup$ Jun 6, 2021 at 15:40
2
$\begingroup$
toEdges = Module[{f}, Rest @* MapIndexed[(f[# + 1] = #2[[1]]; f @ # -> #2[[1]])&]]

t1 // toEdges // Graph // GraphTree // TreeMap[t1[[#]]&] 

enter image description here

$\endgroup$
1
  • $\begingroup$ Gosh, that's neat. And much appreciated. I'll poke this around a bit, maybe do some comparisons with the answer I already accepted. $\endgroup$ Jun 8, 2021 at 9:41
2
$\begingroup$
treeExp = First[#] @@ (#0 /@ Split[Rest@#, {a, b} |-> b != #[[2]]]) /. a_[] :> a &;

treeExp @ t1
1[2[3, 3[4, 4], 3, 3[4], 3, 3], 2[3[4]], 2[3], 2] 
ExpressionTree @ treeExp @ t1  

enter image description here

InputForm @ %
Tree[1, {Tree[2, {Tree[3, None], Tree[3, {Tree[4, None], Tree[4, None]}], 
 Tree[3, None], Tree[3, {Tree[4, None]}], Tree[3, None], Tree[3, None]}], 
 Tree[2, {Tree[3, {Tree[4, None]}]}], Tree[2, {Tree[3, None]}], Tree[2, None]}]
$\endgroup$
1

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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