create a register - dictionary

Question

I have to create a type tree which would be used to store words, like every node of the tree would hold a letter and the list of the next characters (so words with the same root would share the same "part/branch of the tree). the tree is basically a n-ary one, used as a dictionnary.
All using Caml language

Answer 1

Well, I don't know if it's a homework or not but I'll still answer :
First, we need to define a signature type for letters.
module type LS = sig
type t
val compare : t -> t -> int
end
Then, we need to define our structure :
module Make (L : LS) = struct
module M = Map.Make(L)
type elt = L.t list
type t = { word : bool; branches : t M.t }
let empty = { word = false; branches = M.empty }
let is_empty t = not t.word && M.is_empty t.branches
let rec mem x t =
match x with
| [] -> t.word
| c :: cl -> try mem cl (M.find c t.branches)
with Not_found -> false
let rec add x t =
match x with
| [] -> if t.word then t else { t with word = true }
| c :: cl ->
let b = try M.find c t.branches with Not_found -> empty in
{ t with branches = M.add c (add cl b) t.branches }
end
Now, step by step :
module Make (L : LS) = struct is a functor that will return a new module if we give it a module of type LS as an argument
module M = Map.Make(L)
type elt = L.t list
type t = { word : bool; branches : t M.t }
This is the complex point, once you have it, everything begins clear. We need to represent a node (as you can see in the Wikipedia page of tries). My representation is this : a node is
a truth value stating that this node represent a word (which means that all the letters from the root to this node form a word)
the branches that goes from it. To represent this branches, I need a dictionary and luckily there's a Map functor in OCaml. So, my field branches is a field associating to some letters a trie (which is why I wrote that branches : t M.t). An element is then a list of letters and you'll find out why I chose this type rather than a string.
let empty = { word = false; branches = M.empty } the empty trie is the record with no branches (so, just the root), and this root is not a word (so word = false) (same idea for is_empty)
let rec mem x t =
match x with
| [] -> t.word
| c :: cl -> try mem cl (M.find c t.branches)
with Not_found -> false
Here it becomes interesting. My word being a list of letters, if I want to know if a word is in my trie, I need to make a recursive functions going through this list.
If I reached the point where my list is empty it means that I reached a node where the path from the root to it is composed by all the letters of my word. I just need to know, then, if the value word at this node is true or false.
If I still have at least one letter I need to find the branch corresponding to this letter.
If I find this branch (which will be a trie), I just need to make a recursive call to find the rest of the word (cl) in it
If I don't find it I know that my word doesn't exist in my trie so I can return false.
let rec add x t =
match x with
| [] -> if t.word then t else { t with word = true }
| c :: cl ->
let b = try M.find c t.branches with Not_found -> empty in
{ t with branches = M.add c (add cl b) t.branches }
Same idea. If I want to add a word :
If my list is empty it means that I added all the letters and I've reached the node corresponding to my word. In that case, if word is already true it means that this word was already added, I don't do anything. If word is false I just return the same branch (trie) but with word equal to true.
If my list contains at least a letter c, I find in the current node the branch corresponding to it (try M.find c t.branches with Not_found -> empty) and I there's no such branch, I just return an empty one and then I recursively add the rest of my letters to this branch and add this new branch to the branches of my current node associated to the letter c (if this branch already existed, it will be replaced since I use a dictionary)
Here, we start with the empty trie and we add the word to, top and tea.
In case we don't want to use functors, we can do it this way :
type elt = char list
type t = { word : bool; branches : (char * t) list }
let empty = { word = false; branches = [] }
let is_empty t = not t.word && t.branches = []
let find c l =
let rec aux = function
| [] -> raise Not_found
| (c', t) :: tl when c' = c -> t
| _ :: tl -> aux tl
in aux l
let rec mem x t =
match x with
| [] -> t.word
| c :: cl -> try mem cl (find c t.branches)
with Not_found -> false
let rec add x t =
match x with
| [] -> if t.word then t else { t with word = true }
| c :: cl ->
let b = try find c t.branches with Not_found -> empty in
{ t with branches = (c, (add cl b)) :: t.branches }