(************************************************************
   trie.ml		Created      : Tue Dec 17 10:36:01 2002
  			Last modified: Tue Dec 17 13:05:43 2002
  Compile: ocamlopt.opt trie.ml -o trie #
  FTP Directory: sources/ocaml #
************************************************************)
(**
   つくれるかな?

2002/12/17
  普通にラベルつきの木。
  問題
    tak takashi のように prefix となっているものの表現はどうする?
    そもそも文字列が存在することを表すものは?
    ノードが文字列を表現するので、ノードのラベルとしてそこで終了する文字列があるかを
    書く (bool)
  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>
*)

open Printf

type array_part = ArrayPart of int * bool * ((array_part option) array) | TreePart of tree_part
and tree_part = T of char * bool * (tree_part list)
;;
let depth_of_array_part = 3
;;
let array_size = 26
;;
let init_array_part () = 
  ArrayPart(1, false, Array.make array_size None)
;;
let init_tree_part () = T('=', false, []) 
;;
let depth = function
    ArrayPart (d, _, _) -> d | _ -> assert false
;;
(* 探しているtree partを取り出してくる。削除したリストも返す *)
let remove_tree_part_from_list ch lst =
  (* prev 部分が逆順に!! *)
  let rec iter remain prev =
    match remain with
      [] -> (None, prev) 
    | (T(ch', _, _) as r)::tl ->
	if ch = ch' then
	  (Some r, List.append prev tl)
	else
	  iter tl (r::prev) in
  iter lst []
;;
let print_tree_part t =
  let rec iter space (T(ch, b, lst)) =
    printf "%s%c (%b)\n" space ch b;
    List.iter (fun t -> iter (space^"  ") t) lst in
  iter "" t
;;

(* top level *)
let rec add_to_tree_part t str from_pos =
  let len = String.length str in
  let rec iter (T(ch, b, lst) as t) pos =
    if len = pos then T(ch, true, lst) 
    else
      let ch' = String.get str pos in
      let (t, lst') = remove_tree_part_from_list ch' lst in
      let new_head =
	iter (match t with Some t -> t | None -> (T(ch', b, [])))
	  (pos+1) in
      T(ch, b, new_head::lst') in
  iter t from_pos
;;
let _ =
  let t = 
    List.fold_right (fun s t -> (add_to_tree_part t s 0))
      ["tak"; "takashi"; "takoashi"] 
      (init_tree_part ()) in
  print_tree_part t
;;