type automate = 
    {
      final : bool vect;
      initial : int;
      transitions : (char*int) list vect;
    };;

let a = `a`;;
let b = `b`;;
let c = `c`;;

(* QUESTION 1 ============================================================= *)

let make_automate n i =
  {
    final = make_vect n false;
    initial = i;
    transitions = make_vect n [];
  };;

let ajoute_final a f =
  a.final.(f) <- true;;

let ajoute_transition a (c,i,j) =
  a.transitions.(i) <-
    (c,j) :: a.transitions.(i);;

let auto = 
  let auto = make_automate 3 0 in
  do_list 
    (ajoute_final auto) 
    [0; 1];
  do_list 
    (ajoute_transition auto)
    [ a,0,0;
      b,0,1;
      a,1,0;
      b,1,2;
      a,2,2;
      b,2,2 ];
  auto;;

(* QUESTION 2 ============================================================= *)

type lecteur =
    {
      lire : char -> unit;
      reconnu : unit -> bool;
    };;

let reconnaitre lecteur mot = 
  for i = 0 to string_length mot - 1 do
    lecteur.lire mot.[i]
  done;
  lecteur.reconnu ();;

let deterministe auto =
  let etat = ref auto.initial in
  {
    lire = (fun c -> etat := assoc c (auto.transitions.(!etat)));
    reconnu = (fun () -> auto.final.(!etat))
  };;

(* QUESTION 3 ============================================================= *)

let auto_nd =
  let auto = make_automate 5 0 in
  do_list (ajoute_final auto) [2; 4];
  do_list (ajoute_transition auto)
    [ a,0,0;
      b,0,0;
      a,0,1;
      b,0,3;
      b,1,2;
      a,3,4 ];
  auto;;

(* QUESTION 4 ============================================================= *)

let rec assoc_all c = function
  | [] -> []
  | (c2,n)::t -> 
      if c2 = c 
      then n::(assoc_all c t)
      else assoc_all c t;;

let rec fusion = function
  | [] -> []
  | h::t -> union h (fusion t);;

let nondeterministe auto =
  let etat = ref [auto.initial] in
  {
    lire = 
      (fun c -> 
        etat := fusion (map 
          (fun i -> assoc_all c auto.transitions.(i)) 
          !etat));
    reconnu = 
      (fun () ->
        exists (fun i -> auto.final.(i)) !etat);
  };;

(* QUESTION 5 ============================================================= *)

(* Mettre une epsilon-transition du noeud A au noeud B revient à:
   - si B -(q)-> C, alors A -(q)-> C.
   - si B est final, alors A est final. 

   Cela représente le fait que, en partant de A, on peut suivre un epsilon 
   pour aller à B avant d'aller en C ou de finir. 

   Bien sûr, pour que cela marche, il faut ajouter les epsilon-transitions
   dans le bon ordre (à savoir, si A -(e)-> B -(e)-> C, il faut d'abord
   ajouter B -(e)-> C, puis A -(e)-> B. Dans le sens inverse, ajouter
   B -(e)-> C en deuxième ne remarquera pas que A -(e)-> C est possible
   par transitivité.
*)

let ajoute_epsilon auto (i,j) =
  auto.final.(i) <- 
    auto.final.(j) || auto.final.(i);
  auto.transitions.(i) <- 
    union auto.transitions.(j) auto.transitions.(i);;

let auto_eps =
  let auto = make_automate 4 0 in
  ajoute_final auto 3;
  do_list (ajoute_transition auto)
    [ a,0,1;
      b,1,1;
      b,0,2;
      a,2,2 ];
  do_list (ajoute_epsilon auto)
    [ 1,0; 2,3 ];
  auto;;

(* QUESTION DIFFICILE ===================================================== *)

(* Une arete a un poids réel positif, sait de quel noeud elle part
   (a) et sait vers quelle noeud elle va (b). *)
type 'a arete =
{
	valeur : 'a;
	poids : int;
	a : 'a noeud;
	b : 'a noeud;
}
	 	
(* Chaque noeud du graphe porte un nom, et sait quelles aretes en
   partent (suiv) et quelles aretes y entrent (prec). *)
and 'a noeud = 
{
	id : int;
	mutable prec : 'a arete list;
	mutable suiv : 'a arete list;
};;

(* Fonctions d'aide à la construction *)
let relie x w a b =
	let arete = {
		valeur = x;
		poids = w;
		a = a;
		b = b;
	} in 
	a.suiv <- arete :: a.suiv;
	b.prec <- arete :: b.prec;;
	
let noeud id = 
	{ id = id; prec = []; suiv = []; };;
	
(* Un exemple de graphe: l'automate qui reconnaît des suites de
   a et de b non consécutifs. On renvoie le noeud initial et le
   noeud final. *)
let exemple1 () =
	let n1 = noeud 0
	and n2 = noeud 1
	and n3 = noeud 2 in
	
	relie "a" 1 n1 n1;
	relie "b" 1 n1 n2;
	relie "a" 1 n2 n1;
	relie ""  0 n1 n3;
	relie ""  0 n2 n3;
	
	(n1,n3);;
	
(* Un autre exemple de graphe: les mots contenant un nombre 
   impair de 'b' *)
let exemple2 () =
	let n1 = noeud 0
	and n2 = noeud 1 in
	
	relie "a" 1 n1 n1;
	relie "a" 1 n2 n2;
	relie "b" 1 n1 n2;
	relie "b" 1 n2 n1;
	
	(n1,n2);;
	
(* Déterminer le plus court chemin dans un graphe de taille n.
   Algorithme de Dijkstra: longueur du plus court chemin.
   
   http://en.wikipedia.org/wiki/Dijkstra's_algorithm
   
   On suppose qu'il n'y a pas de cycles de poids inférieur
   ou égal à 0 pour que ça marche.
*)
let dijkstra (d,f) n =

	let dist = make_vect n max_int in
	dist.(d.id) <- 0;
	
	let todo = ref [d,0] in
	let rec insertion (e,l) = function
		| [] -> [e,l]
		| (n,d)::q -> if l < d then (e,l)::(n,d)::q
		              else (n,d)::(insertion (e,l) q)
	in
	
	let relaxer a = 
		let candidat = dist.(a.a.id) + a.poids in
		if dist.(a.b.id) > candidat then begin
			dist.(a.b.id) <- candidat;
			todo := insertion (a.b,candidat) !todo;
		end
	in
	
	let rec loop () =
	match !todo with
	 	| [] -> ()
	 	| (n,d)::q ->
	begin
		todo := q; 
		if d = dist.(n.id) then 
			do_list relaxer n.suiv;
		loop ()
	end
	in loop ();
		
  	dist;;
  	
let rec chemin (d,f) dist =
	if d.id = f.id then ""
	else let rec find = function
		| [] -> failwith "Erreur!"
		| t::q -> 
			if t.poids = dist.(f.id) - dist.(t.a.id) 
			then (chemin (d,t.a) dist)^(t.valeur)
			else find q
	in find f.prec;;
	
let g = exemple2 () in
chemin g (dijkstra g 3);;

(* Déterminer les plus courts chemins du noeud de départ à 
   un noeud final donné: on travaille récursivement sur le
   noeud final. Pour calculer le k-ème chemin le plus court
   aboutissant à un noeud, on examine les noeuds qui le
   précèdent, et on y prend le plus court chemin non encore
   utilisé (pour un des plus courts chemins précédents). 
   
   On stocke alors dans chaque noeud:
    - Les k plus courts chemins permettant d'y aboutir,
      avec leur longueur.
    - L'indice du plus court chemin de chaque antécédent
      n'ayant pas encore été utilisé. 
      
   Pour calculer le (k+1)-ème plus court chemin, on extrait
   les indices des plus courts chemins non encore utilisés,
   on prend le plus court (en incluant le poids de l'arête
   entrante) et on le stocke et renvoie, augmentant de
   un l'indice concerné. 
*)
type data =
{
	mutable courts : (string * int) vect;
	mutable priorite : (string arete * int * int) list;
};;

let ajouter v e = 
	init_vect 
		(vect_length v + 1) 
		(fun i -> if i < vect_length v then v.(i) else e);;

exception PlusRien;;
		
let chemins (d,f) c n =
	let dist = dijkstra (d,f) c in
	
	(* Initialisation des données. *)
	let donnees =
		let init = make_vect n false in
		
		let donnees = 
			init_vect n (fun _ -> { courts = [| |]; priorite = []; })
		in
		
		let rec remplir n =
			if not init.(n.id) then begin
				init.(n.id) <- true;
				donnees.(n.id).priorite <- 
					sort __ sort 
						(fun (_,_,i) (_,_,j) -> i <= j)
						(map 
							(fun a -> a, 0, dist.(a.a.id) + a.poids) 
							(n.prec));
				if n.id = d.id then 
					donnees.(n.id).courts <- 
						[| "", 0 |];
				do_list (fun a -> remplir a.a) n.prec;
			end
		in
		
		remplir f;
		
		donnees
	in
	
	(* Une fonction qui calcule récursivement le k-ème plus court chemin,
	   en le stockant au passage dans le tableau.
	   *)
	let rec keme n k =
			
		let moi = donnees.(n.id) in
		
		if vect_length moi.courts < k then 
			(let _ = keme n (k-1) in ());
			
		if vect_length moi.courts = k then begin 
			match moi.priorite with
			| [] -> raise PlusRien
			| (a,l,d)::t -> 
				let (mot,d2) = keme a.a l in 
				moi.courts <- ajouter  moi.courts (mot^a.valeur,d);
				begin try 
					let (_,d) = keme a.a (l+1) in
					moi.priorite <-
						sort __ merge 
							(fun (_,_,i) (_,_,j) -> i <= j)
							[a,l+1,d+a.poids] t;
				with PlusRien -> (); 
				end;
		end;
		moi.courts.(k)
	in

	for i = 1 to n do
		printf __ printf "%d-eme: %s\n" i (fst (keme f (i-1)))
	done;;