(* ################### *)
(* # PROJET OCAML T9 # *)
(* ################### *)

(* ################################################ *)
(* # Défition des types et de leur prototype vide # *)
(* ################################################ *)

(* Type arbre des clés de position *)
type tree_pos = { branches : (int * tree_pos) list};;
let empty_pos = { branches = [] };;

(* Type arbre spécifique au T9 *)
type tree = { position : tree_pos ; subtrees : (int * tree) list };;
let empty = { position = empty_pos ; subtrees = [] } ;;

(* ############################################################# *)
(* # Transformation des characteres en T9 : position et touche # *)
(* ############################################################# *)

(* Charactère vers numéro de la touche *)
let char_to_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
  | _ -> -1;;

(* Charactère vers position sur la touche *)
let char_to_position = function
  | 'a' | 'd' | 'g' | 'j' | 'm' | 'p' | 't'| 'w' -> 1
  | 'b' | 'e' | 'h' | 'k' | 'n' | 'q' | 'u'| 'x' -> 2
  | 'c' | 'f' | 'i' | 'l' | 'o' | 'r' | 'v'| 'y' -> 3
  | 's' | 'z' -> 4
  | _ -> -1;;

(* Chaîne de caractère vers tableau des touches *)
let rec string_to_keys = function
	| "" -> []
	| c -> (char_to_key (String.get c 0))::(string_to_keys (String.sub c 1 ((String.length c)-1)));;

(* Chaîne de caractère vers tableau des positions sur la touche *)
let rec string_to_positions = function
	| "" -> []
	| c -> (char_to_position (String.get c 0))::(string_to_positions (String.sub c 1 ((String.length c)-1)));;

(* ################################################ *)
(* # Constructeur de l'arbre des clés de position # *)
(* ################################################ *)

(* Retourne l'arbre associer à la clé parmis les sous arbres : le créer sinon *)
let eject_key_pos key subtrees =
	match key,subtrees with
	| key,subtrees when List.mem_assoc key subtrees.branches -> (key,(List.assoc key subtrees.branches)),(List.remove_assoc key subtrees.branches)
	| key,subtrees -> (key,empty_pos),subtrees.branches;;

(* Insert la liste des clés de position dans l'arbre *)
let insert_pos positions tree =
	let rec aux keys tree =
		match keys,tree with
		| [],_ -> empty_pos
		| key::tlkeys,tree -> let r_eject_key = eject_key_pos key tree in
													let subkeytree = (fst r_eject_key) and othertrees = (snd r_eject_key) in
													let rec_subkeytrees = key,{branches = ((aux tlkeys (snd subkeytree)).branches)} in
															{branches = rec_subkeytrees::othertrees}
		in
		aux positions tree;;

(* ######################################### *)
(* # Constructeur d'arbre spécifique au T9 # *)
(* ######################################### *)

(* Insert la clé de la touche dans l'arbre spécifique au T9 *)
let eject_key key tree =
	match key,tree with
	| key,tree when List.mem_assoc key tree.subtrees -> (key,(List.assoc key tree.subtrees)),{position = tree.position ; subtrees = (List.remove_assoc key tree.subtrees)}
	| key,tree -> (key,{position = empty_pos ; subtrees = []}),tree;;

(* Insert une chaîne de charactères dans l'arbre spécifique au T9 *)
let insert word treeT9 =
	let rec aux keys positions treeT9 =
		match keys,treeT9 with
		| [],_ -> {position = (insert_pos positions treeT9.position) ; subtrees = treeT9.subtrees}
		| key::ltkeys, treeT9 -> let r_eject_key = eject_key key treeT9 in
													   let subtreekey = (fst r_eject_key) and tree_without_key_one = (snd r_eject_key) in
														 let fill_subtreekey = key,(aux ltkeys positions (snd subtreekey)) in
														 	{position = treeT9.position ; subtrees = fill_subtreekey::tree_without_key_one.subtrees}
	in
	aux (string_to_keys word) (string_to_positions word) treeT9;;

(* ######################## *)
(* # Découpage de l'arbre # *)
(* ######################## *)

(* Retourne les sous arbres associés aux touches d'un arbre T9 *)
let assoc keys tree =
	let rec aux keys tree =
		match keys,tree with
		| [],tree -> tree
		| key::ltkeys,tree when List.mem_assoc key tree.subtrees -> aux ltkeys (List.assoc key tree.subtrees)
		| key::ltkeys,tree -> empty
	in
		aux keys tree;;

(* ################################################################## *)
(* # Gestion de reconstitution en chaîne de caractère d'un arbre T9 # *)
(* ################################################################## *)

(* Fonction de sortie *)
(* Transforme un couple (touche,position) en un string *)
let key_position_to_string = function
	| (2,1) -> "a" | (2,2) -> "b" | (2,3) -> "c"
	| (3,1) -> "d" | (3,2) -> "e" | (3,3) -> "f"
	| (4,1) -> "g" | (4,2) -> "h" | (4,3) -> "i"
	| (5,1) -> "j" | (5,2) -> "k" | (5,3) -> "l"
	| (6,1) -> "m" | (6,2) -> "n" | (6,3) -> "o"
	| (7,1) -> "p" | (7,2) -> "q" | (7,3) -> "r" | (7,4) -> "s"
	| (8,1) -> "t" | (8,2) -> "u" | (8,3) -> "v"
	| (9,1) -> "w" | (9,2) -> "x" | (9,3) -> "y" | (9,4) -> "z"
	| _ -> "?";;

(* Retourne le mot associé aux listes de touches,positions *)
let rec printW keys positions =
		match keys, positions with
		| [],[] -> ""
		| key::ltkeys,pos::ltpositions -> (key_position_to_string (key,pos))^(printW ltkeys ltpositions)
		| _ -> failwith "error";;

(* Envoie à une fonction de sortie le mot associé aux listes de touches,positions *)
let print_word keys positions =
	let rec aux keys tree positions =
		match tree.branches with
		| [] when (List.length keys) == (List.length positions) && (List.length keys > 0) ->  print_string ((printW keys (List.rev positions))^"\n")
		| subtrees when (List.length subtrees) > 0 -> let rec map_rec keys sub pos =
											match sub with
											| [] -> ()
											| thetree::othertrees -> begin

																								(aux keys (snd thetree) ((fst thetree)::pos) );
																								(map_rec keys othertrees pos);
																							end
									in
									(map_rec keys subtrees positions)
		| _ -> ()
	in
	aux keys positions  [];;

(* Envoie à une fonction de sortie tout les mots de l'arbre *)
let save_word tree =
	let rec aux keys tree =
		match tree.position,tree.subtrees with
		| treeposition,[] -> print_word (List.rev keys) treeposition
		| treeposition,subtrees -> let rec map_rec ks sub =
																match sub with
																| [] -> ()
																| (node,sub)::othertrees -> (aux (node::ks) sub);
																														(map_rec ks othertrees);
															 in
																begin
															  	(print_word (List.rev keys) treeposition);
																	(map_rec keys subtrees);
																end
	in
	aux [] tree;;

(* ######################################## *)
(* # Reconstitution d'un fichier en arbre # *)
(* ######################################## *)

let path = "/home/petillot/workspace/ocaml_project/dico_test.txt";;

let read_to_tree path_file =
	let rec aux file tree =
		let str = try input_line file with End_of_file -> "" in
			match str with
			| "" -> tree
			| str -> (aux file (insert str tree))
	in
	aux (open_in path_file) empty;;

let dico = read_to_tree path;;
save_word dico;;