Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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[
  "h"["e"["a"[EndOfString], 
    "l"["l"["o"[EndOfString, "s"[EndOfString]]]]], 
   "o"["l"["o"[EndOfString]]]], "b"["r"["o"[EndOfString]]]]

So that

TreeForm@output

gives

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

share|improve this question
    
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 –  Rojo Jul 9 '12 at 23:08
1  
brb, while I close this question with the force of a thousand suns! :P –  rm -rf Jul 9 '12 at 23:17
    
I think you're missing an "l" in "hollow" within the output and TreeForm. –  Mr.Wizard Jul 11 '12 at 12:43
    
@Mr.Wizard let's say I had an extra "l" in the input so I don't have to reupload the image :) –  Rojo Jul 11 '12 at 13:22

2 Answers 2

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

ClearAll[makeRojoTree];
makeRojoTree[words_List] :=
 StartOfString @@ 
  ReplaceRepeated[
    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:

makeRojoTree[test]

(*

StartOfString[
  "h"["e"["l"["l"["o"[EndOfString, "s"[EndOfString]]]], 
  "a"[EndOfString]], "o"["l"["l"["o"[EndOfString]]]]], 
  "b"["r"["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:

allWords=DictionaryLookup["*"];

(allTree=makeTree[allWords]);//Timing

(* {5.297,Null} *)

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

(* {8.4375000,Null} *)

EDIT

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

ClearAll[makeTree];
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

ClearAll[makeTreeRojo];
Module[{makeTreeRojoAux},
 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]];
 ]
share|improve this answer
    
Nice one, +1... 1.5 times slower but less than half the storage, which isn't so much in either case –  Rojo Jul 10 '12 at 0:00
    
@Rojo Thanks. One could as well modify the original makeTree to squeeze some speed out, but I did not bother. –  Leonid Shifrin Jul 10 '12 at 0:11
    
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 –  Rojo Jul 10 '12 at 0:18
    
@Rojo Be my guest. I am off to bed in 5 minutes, but feel free to edit the post. –  Leonid Shifrin Jul 10 '12 at 0:23

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.

share|improve this answer
    
Almost great! but check the TreeForm. The e in hello, hea, and hellos aren't groups –  Rojo Jul 9 '12 at 23:34
    
Btw, loved the Composition to "unflatten" –  Rojo Jul 9 '12 at 23:38
    
Thanks for helping fix my pattern! :) –  rm -rf Jul 10 '12 at 0:18
1  
Well deserved +1. Exactly the kind of answer I was (and still am) hoping to see appear –  Rojo Jul 10 '12 at 0:19
    
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. –  Leonid Shifrin Jul 10 '12 at 0:27

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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