type trie = { words : string list ; branches : (int * trie) list }

let empty = { words = []; branches = [] }

(* recherche *)

let rec find trie = function
  | [] ->
      trie.words
  | i :: l ->
      begin
        try find (List.assoc i trie.branches) l
        with Not_found -> []
      end

(* ajout *)

let rec change_assoc i trie = function
  | [] -> [i,trie]
  | (x,_) :: l when x = i -> (i,trie) :: l
  | z :: l -> z :: change_assoc i trie l

let branch i t =
  try List.assoc i t.branches with Not_found -> empty

let add trie l s =
  let rec add trie = function
    | [] when List.mem s trie.words ->
        trie
    | [] ->
        { trie with words = s :: trie.words }
    | i :: l ->
        let t = branch i trie in
        { trie with branches = change_assoc i (add t l) trie.branches }
  in
  add trie l

(* ajout d'un mot *)

let key = function
  | 'a' | 'b' | 'c' -> 2
  | 'd' | 'e' | 'f' -> 3
  | 'g' | 'h' | 'i' -> 4
  | 'j' | 'k' | 'l' -> 5
  | 'm' | 'n' | 'o' -> 6
  | 'p' | 'q' | 'r' | 's' -> 7
  | 't' | 'u' | 'v' -> 8
  | 'w' | 'x' | 'y' | 'z' -> 9
  | _ -> assert false

let intlist_of_string s =
  let n = String.length s in
  let rec list i =
    if i = n then [] else key s.[i] :: list (i+1)
  in
  list 0

let add_word trie w = add trie (intlist_of_string w) w

(* un petit dictionnaire *)

let dict = [
  "lex"; "key"; "void" ; "caml" ; "unix" ; "for" ; "while" ; "done" ;
  "let" ; "fold";
  "val"; "exn" ; "rec" ; "else" ; "then" ; "type" ; "try" ; "with" ;
  "to"; "find" ; "do" ; "in" ; "if" ; "hd" ; "tl" ; "iter" ; "map" ; "get";
  "copy" ; "and"; "as" ; "begin" ; "class" ; "downto" ; "end" ;
  "exception" ; "false" ; "fun" ; "function" ; "match" ; "mod" ; "mutable" ;
  "open" ; "or" ; "true" ;  "when" ;  "load" ; "mem" ; "length" ; "bash" ;
  "unit" ; "site";
  "php"; "sql"; "ssh"; "spam"; "su"; "qt"; "root";
  "bsd"; "boot"; "caml"; "bash"; "ocaml"; "kde"; "gtk" ; "gcc"
]

let t = List.fold_left add_word empty dict

(* tests *)

let () = assert (find t [2;2;6;5] = ["caml"])
let () = assert (let l = find t [4;3] in l = ["hd"; "if"] || l = ["if"; "hd"])
let () = assert (find t [4;3;8]   = ["get"])
let () = assert (find t [8;6;4;3] = ["void"])
let () = assert (find t [8;6;4;8] = ["unit"])

(* suppression *)

let remove trie l s =
  let rec remove trie = function
    | [] ->
        { trie with words = List.filter ((<>) s) trie.words }
    | i :: l ->
        let t = branch i trie in
        let f = match remove t l with
          | { words=[]; branches=[] } -> List.remove_assoc i
          | t' -> change_assoc i t'
        in
        { trie with branches = f trie.branches }
  in
  remove trie l

let remove_word trie w = remove trie (intlist_of_string w) w

(* tests *)

let t = remove_word t "caml"
let () = assert (find t [2;2;6;5] = [])
let () = assert (let l = find t [4;3] in l = ["hd"; "if"] || l = ["if"; "hd"])
let () = assert (find t [4;3;8]   = ["get"])

This document was generated using caml2html