Simple Char Trie - Return Original Strings


#1

I’m playing with a simple char trie and I’m populating it with strings and I would like to get the original strings from the char trie data structure in a string list. I can do it with the strings function below but I don’t like my solution and wonder if the experts have any pointers or tips to improve that function - strings.

let uncons str =
(** string -> (char * string) option *)
  let len = String.length str in
  match len with
  | 0 -> None 
  | 1 -> Some (String.get str 0, "")
  | x -> Some (String.get str 0, String.sub str 1 (x - 1))

let getRemainder lst find =
(** 'a list -> ('a -> bool) -> ('a * 'a list) option *)
  let rec getRemaindAux lst func =
    match lst with
    | [] -> None
    | hd::tl ->
      if (find hd)
      then
        Some (hd, ((fun () -> func(tl))()))
      else
        getRemaindAux tl (fun t -> func(hd::t)) in
  getRemaindAux lst (fun t -> t)

module Trie =
struct

  type trie = Trie of (char * trie) list

  let empty = Trie []

  let rec add tr str =
    let uStr = uncons str in
    match uStr with
    | None -> tr
    | Some (c, s) ->
      let Trie lst = tr in
      let ans = getRemainder lst (fun (chr, _) -> chr = c) in
      match ans with
      | None -> Trie ((c, (add empty s))::lst)
      | Some ((_, next), rlst) -> Trie ((c, (add next s))::rlst)

  let rec find tr str =
    let uStr = uncons str in
    match uStr with
    | None -> Some tr
    | Some (c, s) ->
      let Trie lst = tr in
      let ans = getRemainder lst (fun (chr, _) -> chr = c) in
      match ans with
      | None -> None
      | Some ((_, next), _) -> find next s

  let rec display tr =
    let Trie lst = tr in
    List.iter (fun (chr, nxt) -> print_char chr; display nxt) lst

  let strings tr =
    (** return original strings *)
    let lsts = ref [] in
    let rec stringsAux tr str =
      let Trie lst = tr in
      match lst with
      | [] -> ()
      | (chr, nxt)::tl ->
        stringsAux (Trie tl) str;
        let Trie nl = nxt in
        let s = (str ^ String.make 1 chr) in
        match nl with
        | [] -> lsts := s::(!lsts)
        | _ -> stringsAux nxt s 
    in
    stringsAux tr ""; List.sort compare (!lsts)

end

let trie =
  List.fold_left
    (fun a b -> Trie.add a b)
    Trie.empty
    [
      "G4143\n";
      "This is the first\n";
      "This is the second\n";
      "This is the third\n";
      "This is the fourth\n";
      "That will do\n";
      "Here it ends...\n";
    ]

let () = Trie.display trie

let () = List.iter (fun _ -> print_newline()) [1;2;]

let strs = Trie.strings trie

let () = List.iter (fun s -> print_string s) strs

#2

Still playing with that simple trie and I think this the best I can produce to return the original string values in a list.

  let strings tr =
    let rec strgsAux tr str =
      let Trie lst = tr in
      List.fold_left
        (
          fun l (chr, next) ->
            let s = str ^ (String.make 1 chr) in
            let Trie n = next in
            match n with
            | [] -> s::l
            | _ -> (strgsAux next s) @ l
        ) [] lst 
    in
    List.sort String.compare (strgsAux tr "")