Given a list of word characters, such as this one, I'd like to build a tree, similar to this makeTree function, but with the tree in a different format. So, for an input such as

test = {{"h", "e", "l", "l", "o"}, {"h", "o", "l", "o"}, {"h", 
    "e", "a"}, {"h", "e", "l", "l", "o", "s"}, {"b", "r", "o"}};

I'd like the output to be

output = StartOfString[
    "l"["l"["o"[EndOfString, "s"[EndOfString]]]]], 
   "o"["l"["o"[EndOfString]]]], "b"["r"["o"[EndOfString]]]]

So that



Mathematica graphics

So far I haven't got a perfect solution, that's why I'm not posting. I know I must be missing lots of good ways to do this. What I want is not so much one single good solution, or "a fix to what I tried", but to see several ways to tackle the problem, particularly but not at all limited to elegant rule-based solutions

  • $\begingroup$ You know I don't post homework or without trying so if you want to close it I'll stay here defending it. It better be 5 against 1 $\endgroup$
    – Rojo
    Jul 9, 2012 at 23:08
  • 1
    $\begingroup$ brb, while I close this question with the force of a thousand suns! :P $\endgroup$
    – rm -rf
    Jul 9, 2012 at 23:17
  • $\begingroup$ I think you're missing an "l" in "hollow" within the output and TreeForm. $\endgroup$
    – Mr.Wizard
    Jul 11, 2012 at 12:43
  • $\begingroup$ @Mr.Wizard let's say I had an extra "l" in the input so I don't have to reupload the image :) $\endgroup$
    – Rojo
    Jul 11, 2012 at 13:22
  • $\begingroup$ @Rojo, take a look at the timing study w/ recursive version - mathematica.stackexchange.com/questions/69942/… $\endgroup$ Jan 1, 2015 at 20:01

4 Answers 4


I favor tree transformations, so I would reuse the makeTree function you linked to (because it is reasonably efficient), as follows:

makeRojoTree[words_List] :=
 StartOfString @@ 
    makeTree[words], {
       ({} -> {}) :> EndOfString, 
        Rule[x_, l_List] :> x @@ l

The argument can be either a list of words, or a list of lists of words characters (as in your test), since makeTree is already polymorphic. Applying it to your test, we get:



  "h"["e"["l"["l"["o"[EndOfString, "s"[EndOfString]]]], 
  "a"[EndOfString]], "o"["l"["l"["o"[EndOfString]]]]], 


which is slightly different in terms of ordering of the branches from what you have as a desired answer, but this can be fixed if you impose some specific ordering.

Comparing the performance to makeTree itself, we see that it is only about 1.5 times slower:



(* {5.297,Null} *)

(rTree = makeRojoTree[allWords]);//AbsoluteTiming

(* {8.4375000,Null} *)


To make this self contained, this is a slightly tuned up version of the linked makeTree, with the slightly different behaviour that it keeps duplicates

makeTree[wrds : {__String}] := makeTree[Characters[wrds]];
makeTree[{b___, {}, a___}] := Prepend[makeTree[{b, a}], {} -> {}];
makeTree[wrds_] := 
 Reap[Scan[Sow[Rest[#], First@#] &, 
    wrds], _, #1 -> makeTree[#2] &][[2]]

and this is a tweaked version of that that returns what the OP wants without resorting to the original makeTree

 makeTreeRojo[wrds_] := DeleteCases[StartOfString @@ makeTreeRojoAux[wrds], List, Infinity, Heads->True];
 makeTreeRojoAux[{b___, {}, a___}] := 
  Prepend[makeTreeRojoAux[{b, a}], EndOfString];
 makeTreeRojoAux[wrds_] := 
  Reap[Scan[Sow[Rest[#], First@#] &, 
     wrds], _, #1 @ makeTreeRojoAux[#2] &][[2]];
  • $\begingroup$ Nice one, +1... 1.5 times slower but less than half the storage, which isn't so much in either case $\endgroup$
    – Rojo
    Jul 10, 2012 at 0:00
  • $\begingroup$ @Rojo Thanks. One could as well modify the original makeTree to squeeze some speed out, but I did not bother. $\endgroup$ Jul 10, 2012 at 0:11
  • $\begingroup$ I'll see if I understand it now, squeeze some speed out, and offer to edit your answer, adding the code to make it self contained $\endgroup$
    – Rojo
    Jul 10, 2012 at 0:18
  • $\begingroup$ @Rojo Be my guest. I am off to bed in 5 minutes, but feel free to edit the post. $\endgroup$ Jul 10, 2012 at 0:23
  • 1
    $\begingroup$ @Pragabhava I suggest you ask this as a separate question with all the information and a minimal reproducible code example. Then you will have a much better chance to get an answer from somebody. You can link to this question and the code, in your question. $\endgroup$ Oct 23, 2015 at 21:22

Here is a very concise way to convert the list of strings to your desired format:

StartOfString @@ (
    (Composition @@ #)[EndOfString] & /@ test //. h_[a___, x_[y__], b___, x_[z__], c___] :> h[x[y, z], a, b, c]

(* {"h"["e"["l"["l"["o"[EndOfString, "s"[EndOfString]]]], 
    "a"[EndOfString]], "o"["l"["l"["o"[EndOfString]]]]], "b"["r"["o"[EndOfString]]]} *)

This is a rather perverse use of Composition, but the fact that Composition[f, g][x] is f[g[x]] lends itself very nicely to the way in which you want your tree built.

  • $\begingroup$ Almost great! but check the TreeForm. The e in hello, hea, and hellos aren't groups $\endgroup$
    – Rojo
    Jul 9, 2012 at 23:34
  • $\begingroup$ Btw, loved the Composition to "unflatten" $\endgroup$
    – Rojo
    Jul 9, 2012 at 23:38
  • $\begingroup$ Thanks for helping fix my pattern! :) $\endgroup$
    – rm -rf
    Jul 10, 2012 at 0:18
  • 1
    $\begingroup$ Well deserved +1. Exactly the kind of answer I was (and still am) hoping to see appear $\endgroup$
    – Rojo
    Jul 10, 2012 at 0:19
  • $\begingroup$ This is very nice conceptually, but a performance disaster for large lists of words / word letters (which is a general feature of this sort of patterns, alas). Since I think that performance is generally important for this type of problems, I don't upvote this time. $\endgroup$ Jul 10, 2012 at 0:27

Using a recursive Query:

byPrefixTree = Query[{
     Query[Select[# != {} &] /* GroupBy[First], All, Rest], 
     Query[Select[# == {} &]]}] /* Merge[Join] /* 
   Query[All, First, byPrefixTree[#] &];

Can be used directly to reconstruct a directory tree from FileNames[...,Infinity].

  • Can it be optimized? ~1000 files nested up to 15 folders deep took ~15sec.

  • So far haven't been successful merging the 2 Select calls with a single GroupBy[#=={}&] as then the keys may be any subset of {True,False}. Wanted to /* with MapAt or similar

  • Operator form is broken- throws a recursion limit exception.

On Rojo's data:

  testData = 
     test // AssociationMap[{SoS, Sequence @@ # , EoS} &] // 
       KeyMap[StringJoin] // Dataset 

enter image description here

testData [byPrefixTree] // Normal

(* <|SoS-><|h-><|e-><|l-><|l-><|o-><|s-><|EoS-><|hellos-><||>|>|>,EoS-><|hello-><||>|>|>|>|>,a-><|EoS-><|hea-><||>|>|>|>,o-><|l-><|o-><|EoS-><|holo-><||>|>|>|>|>|>,b-><|r-><|o-><|EoS-><|bro-><||>|>|>|>|>|>|> *) 

Desired form (though unsorted)

(testData[byPrefixTree][Map[Normal, #, All] &][First] // 
    Normal) //. {Rule[EoS, val_] :> EoS, 
   Rule[x_, l_] :> x @@ l} // TreeForm

enter image description here


I may be off the mark by not making nested compositions. So, for what it's worth:

pref[list_] := (f[m_] := m[[1 ;; #]] & /@ Range[Length@m]; 
  g[t_] := Rule @@@ Partition[t, 2, 1]; 
  Module[{str = {StartOfString, ##, EndOfString} & @@@ (Characters /@ 
        list)}, TreePlot[Union[Flatten[g /@ (f /@ str)]], 
    Automatic, {StartOfString}, 
    VertexRenderingFunction -> ({LightYellow, EdgeForm[Black], 
        Rectangle[# - {0.4, 0.2}, # + {0.4, 0.2}], Black, 
        Text[Last@#2, #1]} &)]])


pref[{"hello", "holo", "hea", "hellos", "bro"}]

enter image description here

pref[{"bro", "hea", "holo", "hello", "help"}]

enter image description here


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.