(* Bidons 8/5/3 *)

let rec filtre p = function 
 | [] -> [] 
 | t::q when p t -> t::(filtre p q) 
 | _::q -> filtre p q ;;

type bidon = { maxi : int ; actu : int } ;;

type etat = Etat of bidon * bidon * bidon ;;

type graphe = { sommets : etat list ; arcs : (etat * etat) list } ;;

(* Q3 *)

let etat_initial(ma,ca,mb,cb,mc,cc) = 
 let bidona = { maxi = ma ; actu = ca } 
 and bidonb = { maxi = mb ; actu = cb } 
 and bidonc = { maxi = mc ; actu = cc } 
 in Etat (bidona,bidonb,bidonc) ;;

let graphe_initial(ma,ca,mb,cb,mc,cc) = 
 { sommets = [etat_initial(ma,ca,mb,cb,mc,cc)] ; arcs = [] } ;;

(* Q4 *)

let transfert (s,d) q = 
 ({maxi = s.maxi ; actu = s.actu - q} , 
  {maxi = d.maxi ; actu = d.actu + q}) ;;

let operation_elementaire (s,d) = 
 if s.actu + d.actu > d.maxi 
  then transfert (s,d) (d.maxi - d.actu) 
  else transfert (s,d) s.actu ;;

(* Q5 *)

type position = G | M | D ;;

let verse (x,y,z) = function 
 | (G,M) -> let (x',y') = operation_elementaire (x,y) in (x',y',z) 
 | (M,D) -> let (y',z') = operation_elementaire (y,z) in (x,y',z') 
 | (D,G) -> let (z',x') = operation_elementaire (z,x) in (x',y,z') 
 | (M,G) -> let (y',x') = operation_elementaire (y,x) in (x',y',z) 
 | (D,M) -> let (z',y') = operation_elmentaire (z,y) in (x,y',z') 
 | (G,D) -> let (x',z') = operation_elementaire (x,z) in (x',y,z') 
 | (_,_) -> failwith erreur de programmation ;;
 
let successeurs_etat (Etat (x,y,z)) = 
 map (fun s -> Etat(verse (x,y,z) s)) [(G,M);(M,D);(D,G);(M,G);(D,M);(G,D)] ;;

(* Q6 *)

let election g t = let r1 = successeurs_etat t 
 in let r = filtre (fun x -> not(mem x g.sommets)) r1 in 
   ({sommets = t::g.sommets ; arcs = g.arcs},r) ;;

(* Q7 *)

let rec clore_graphe g en_attente = match en_attente with 
 | [] -> g 
 | t::q when mem t g.sommets -> clore_graphe g q 
 | t::q -> let (g',r) = election g t in clore_graphe g' (en_attente @ r) ;;

let construire_graphe (ma,ca,mb,cb,mc,cc) = 
 let i = etat_initial(ma,ca,mb,cb,mc,cc) 
 and gv = {sommets = [] ; arcs = []} 
 in clore_graphe gv [i] ;;

(* Q8 *)

let identiques r s = (sort__sort (prefix <) r) = (sort__sort (prefix <) s) ;;

let projection (Etat(u,v,w)) = map (fun x -> x.actu) [u;v;w] ;;

let liste_accessibles (ma,ca,mb,cb,mc,cc) = 
 let g = construire_graphe (ma,ca,mb,cb,mc,cc) 
 in map projection g.sommets ;;

let est_accessible (x,y,z) (ma,ca,mb,cb,mc,cc) = 
 let composante = liste_accessibles (ma,ca,mb,cb,mc,cc) in 
 filtre (identiques [x;y;z]) composante <> [] ;;

(* Reponses *)

liste_accessibles (8,8,5,0,3,0) ;;

est_accessible (4,4,0) (8,8,5,0,3,0) ;;