164 lines
3.9 KiB
OCaml
164 lines
3.9 KiB
OCaml
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;;
|
|
|