type sommet = int;;
type poids = P of int | Inf;;
type liste_adj = (sommet*int) list array;;
type matrice_pond = poids array array;;

let rec foreach f lst = match lst with
	| [] -> ()
	| e::s -> f e;foreach f s;;

let adjToPond adj = 
	let n = Array.length adj in
	let out = Array.make_matrix n n Inf in
	for i=0 to n-1 do
		foreach (fun (j,p) -> out.(i).(j) <- p) adj.(i)
	done;
	out;;
	
let pond2adj pond =
	let n = Array.length pond in
	let out = Array.make n [] in
	for i=0 to n-1 do
		let lst = ref [] in
		for j=0 to n-1 do
			match pond.(i).(j) with
				| Inf -> ()
				| P(p) -> lst := (j,P(p))::!lst
		done;
		out.(i) <- !lst
	done;
	out;;
	
	
let ex01 = 
	[|[(1,P(1));(2,P(3))];
	[(0,P(1));(2,P(1));(3,P(2))];
	[(0,P(3));(1,P(1));(4,P(4))];
	[(1,P(2));(4,P(2));(5,P(6))];
	[(2,P(4));(3,P(2));(5,P(2))];
	[(3,P(6));(4,P(2))]|];;

let ex02 = 
	[|[(1,P(6));(2,P(9))];
	[(0,P(6));(2,P(5));(3,P(8));(6,P(6))];
	[(0,P(9));(1,P(5));(3,P(4));(4,P(8));(5,P(7))];
	[(1,P(8));(2,P(4));(5,P(4));(6,P(5))];
	[(2,P(8));(5,P(9));(7,P(4))];
	[(2,P(7));(3,P(4));(4,P(9));(6,P(3));(7,P(10))];
	[(1,P(6));(3,P(5));(5,P(3));(7,P(6))];
	[(4,P(4));(5,P(10));(6,P(6))]|];;
  
let pond01 = adjToPond ex01;;
let pond02 = adjToPond ex02;;

let somme p q = match p,q with
	| P(i),P(j) -> P(i+j)
	| _ -> Inf;;
	
let inf_s p q = match p,q with
	| Inf,_ -> false
	| P(i),Inf -> true
	| P(i),P(j) -> i<j;;

let minp p q = if (inf_s p q) then p else q;;

let copie_matrice mat = 
	let n = Array.length mat in
	let out = Array.make n [||] in
	for i=0 to n-1 do
		let m = Array.length mat.(i) in
		out.(i) <- (Array.make m mat.(i).(0));
		for j=0 to m-1 do
			out.(i).(j) <- mat.(i).(j)
		done
	done;
	out;;

copie_matrice pond01;;

let floydWarshall pond_in = 
	let pond = copie_matrice pond_in in
	let n = Array.length pond in
	for i=0 to n-1 do
		for j=0 to n-1 do
			for k=0 to n-1 do
				pond.(i).(j) <- minp pond.(i).(j) (somme pond.(i).(k) pond.(k).(j))
			done
		done
	done;
	pond;;

floydWarshall (pond01);;
floydWarshall (pond02);;

type couleur = Bleu | Vert;;

(** TODO à faire avec les tas **)
exception EmptyException
let mini ppq lst = 
	match lst with
		| [] -> raise EmptyException
		| e0::s ->
			let rec aux lst e = match lst with
				| [] -> e
				| t::q -> aux q (if ppq e t then e else t) in
			aux s e0;;
let ppqDrt p q = let (i,s)=p and (j,t)=q in s<=t;;
let miniIP = mini ppqDrt;;

exception NotFoundException;;
let rec removeFirst e lst = match lst with
	| [] -> raise NotFoundException
	| t::s -> if(e=t) then s else t::(removeFirst e s);;
let rec removeIfFirst cond lst = match lst with
	| [] -> raise NotFoundException
	| t::s -> if (cond t) then s else t::(removeIfFirst cond s);;
let enleveMini ppq lst = 
	let  mm = mini ppq lst in removeFirst mm lst;;
let enleveMiniIP = enleveMini ppqDrt;;

let extractMiniIP lst = let  mm = mini ppqDrt lst in (mm,removeFirst mm lst);;

let rec anymatch fn lst = match lst with
	| [] -> false
	| e::s -> (fn e) || anymatch fn s;;

let rec assome e lst = 
	let fn s = let (a,b)=s in e=a in anymatch fn lst;;

let rec updatep f k v = 
	(k,v)::(try (removeIfFirst (fun (a,b)->k=a) f) with NotFoundException -> []);;

let dijkstra adj e = 
	let f = ref [(e,0)] in
	let n = Array.length adj in
	let p = Array.make n (-1) in
	let d = Array.make n Inf in
	let cols = Array.make n Bleu in
	d.(e) <- P(0);
	while !f<>[] do
		let (ss,rst) = extractMiniIP !f in
		let (s,pp) = ss in
		print_int (List.length !f);
		print_endline "";
		f := rst;
		cols.(s) <- Vert;
		foreach (fun (v,pd) -> if((inf_s d.(v) (somme d.(s) pd)) && (cols.(v)=Bleu)) 
					then p.(v)<-s;
					d.(v) <- somme d.(s) pd;
					let P(pdv) = d.(v) in 
					f := updatep !f v pdv) adj.(s)
	done;
	d;;

type 'a tas = Feuille | Noeud of 'a * ('a tas) * ('a tas);;

let rec ajoute e tas = match tas with
	| Feuille(u) when e<=u->Noeud(u,e,Feuille)
	| Feuille(u)                    ->Noeud(e,u,Feuille)
	| Noeud(u,p,q) when e<=u -> Noeud(u,ajoute e p,q)
	| Noeud(u,p,q)                     -> Noeud(e,ajoute u p,q)

dijkstra ex01 2;;