(** Listes associatives triées croissantes ================================= *)

let rec assoc l k = match l with
  | [] -> None
  | (x,v)::tl ->
      if x = k then Some v else
        if x > k then None else
          assoc tl k

let rec add_assoc l k v = match l with
  | [] -> [k,v]
  | (kk,vv)::tl ->
       if kk = k then (k,v)::tl else
         if kk > k then (k,v)::(kk,vv)::tl else
           (kk,vv)::(add_assoc tl k v)

(** Trie une liste d'associations par ordre croissant de clés,
  * remplace de multiples associations par la dernière.
  * La complexité est de l'ordre du carré de la longueur de l. *)
let trie l = List.fold_left (fun l (k,v) -> add_assoc l k v) [] l

(** Cette version remplace de multiples associations par la première.
  * Moins efficace mais même complexité, puisque le renversement de l
  * est aussi quadratique. *)
let trie_2 l = List.fold_left (fun l (k,v) -> add_assoc l k v) [] (List.rev l)

(** Dictionnaires et opérations de base ==================================== *)

type dico = Vide of (char*dico) list | Plein of (char*dico) list

let vide  = Vide []

let rec appartient d w = match w,d with
  | [],Vide  d -> false
  | [],Plein d -> true
  | c::tl, Vide  l
  | c::tl, Plein l ->
      begin match assoc l c with
        | None -> false
        | Some d -> appartient d tl
      end

let rec insertion d w = match w,d with
  | [], Plein l
  | [], Vide  l -> Plein l
  | c::tl, Plein l -> Plein (update_assoc l c tl)
  | c::tl, Vide  l -> Vide  (update_assoc l c tl)

and update_assoc l c tl =
  match assoc l c with
    | None   -> add_assoc l c (insertion vide tl)
    | Some d -> add_assoc l c (insertion d tl)

(* Encore une fois je redéfinis un opérateur pour alléger la syntaxe
 * des tests qui suivent. On n'a pas besoin du + et il a la bonne
 * associativité, ce qui n'est pas le cas de ^ -- la concaténation de
 * chaines de caractères. *)

let (+) = insertion
let chat = ['c';'h';'a';'t']
let dico =
  vide
  + chat
  + ['c';'h';'a';'t';'s']
  + ['c';'h';'i';'e';'n']

let test = appartient dico chat
let test_negatif = appartient dico ['c';'h']

(** Extraction des préfixes univoques minimaux ============================= *)

let cons c = List.map (fun w -> c::w)

let rec univoques d = match d with
  | Plein l ->
      if l = [] then [[]] else
        List.concat
          (List.map (fun (c,d) -> cons c (univoques d)) l)
  | Vide l ->
      begin match List.map (fun (c,d) -> c, univoques d) l with
        (* On peut supposer l<>[] pour éviter des représentations multiples
         * et inefficaces d'un même langage. *)
        | [] -> assert false
        | [c,[[]]] -> [[]]
        | l -> List.concat (List.map (fun (c,u) -> cons c u) l)
      end

let univoques_dico = univoques dico