list manipulation - Building a tree

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

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