Building a tree

Question

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

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

Answer 1

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

Answer 2

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.

Answer 3

For the lastest version on cloud:

Clear[ds];
test = {{"h", "e", "l", "l", "o"}, {"h", "o", "l", "o"}, {"h", "e", 
    "a"}, {"h", "e", "l", "l", "o", "s"}, {"b", "r", "o"}};
ds = CreateDataStructure["ByteTrie", "a", "z"];
str=StringJoin/@test;
ds["Insert", #] & /@ str;
ds["Visualization"]

(* same output as shown below *)

---

Original (ironically it works on v12.2)

Using ByteTrie data structure: Trie Wiki

Clear[ds]
test = {{"h", "e", "l", "l", "o"}, {"h", "o", "l", "o"}, {"h", "e", 
    "a"}, {"h", "e", "l", "l", "o", "s"}, {"b", "r", "o"}};
ds = CreateDataStructure["ByteTrie", "a", "z"]
ds["Insert", #] & /@ test; (* It can take in string inputs as well *)
ds["Visualization"]

---

---

Methods such as "Strings" (stored) and "MemberQ" are available with the data structure.

{ds["MemberQ", "hello"], ds["FreeQ", "hello"]}

{True, False}

Answer 4

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 

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

Answer 5

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

Testing:

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

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