(* Tentative de Résolution du Taquin avec A* *)

type taquin = { vide : int * int ; cases : int array array }

type deplacement = H | B | G | D

let taqWin = { vide = (0,0); cases = [| 
            [| 0; 1; 2; 3 |];
            [| 4; 5; 6; 7 |]; 
            [| 8; 9; 10; 11 |];
            [| 12; 13; 14; 15 |]; |]};;

(* taquins exemples *)

let taq1 = { vide = (0,1); cases = [|
          [| 1; 0; 2; 7 |];
          [| 4; 5; 3; 6 |];
          [| 8; 9; 10; 11 |];
          [| 12; 13; 14; 15 |]; |]};;

let taq2 = { vide = (1,1) ; cases = [|
          [| 4; 6; 1; 3 |];
          [| 8; 0; 2; 7 |];
          [| 10; 12; 14; 11 |];
          [| 9; 13; 5; 15 |]; |]};;

(* Fonctions utilitaires *)

let affiche_taquin taq =
  Printf.printf "-------------\n";
  for i = 0 to 3 do
    for j = 0 to 3 do
      let v = taq.cases.(i).(j) in
      if v = 0 then 
        Printf.printf "|  "
      else if  v < 10 then
        Printf.printf "| %d" v
      else
        Printf.printf "|%d" v
    done;
    Printf.printf "|\n"
  done;
  Printf.printf "-------------\n"
;;

affiche_taquin taqWin;;
affiche_taquin taq1;;
affiche_taquin taq2;;

let opp depl = match depl with
| H -> B
| B -> H
| G -> D
| D -> G
;;

let affiche_depl depl = match depl with
| H -> print_string "H"
| B -> print_string "B"
| G -> print_string "G"
| D -> print_string "D"
;;

(** Le jeu **)

let coups_possibles taq = match taq.vide with
(* les coins, les bords, le milieu *)
| (0, 0) -> [B; D]
| (3, 0) -> [H; D]
| (0, 3) -> [B; G]
| (3, 3) -> [H; G]
| (0, _) -> [B; G; D]
| (3, _) -> [H; G; D]
| (_, 0) -> [H; B; D]
| (_, 3) -> [H; B; G]
| (_, _) -> [H; B; G; D]
;;

let joue taq depl = (* joue un coup : renvoie le nouveau taquin *)
  let cases = Array.make_matrix 4 4 0 in
  for i = 0 to 3 do
    for j = 0 to 3 do
      cases.(i).(j) <- taq.cases.(i).(j)
    done
  done;
  let iv, jv = taq.vide in (* ancienne case vide *)
  let inv, jnv = match depl with (* nouvelle case vide *)
    | B -> (iv+1, jv)
    | H -> (iv-1, jv)
    | G -> (iv, jv-1)
    | D -> (iv, jv+1)
  in
  cases.(iv).(jv) <- cases.(inv).(jnv);
  cases.(inv).(jnv) <- 0;
  { vide = (inv, jnv) ; cases = cases }
;;

let rec joue_partie taq coups = (* joue plusieurs coups : renvoie le taquin final *)
  match coups with
| [] -> taq
| depl::ccoups -> let taq2 = joue taq depl in joue_partie taq2 ccoups
;;

(* Affiche *)
let affiche_voisins taq =
  let cp = coups_possibles taq in
  let voisins = List.map (fun c -> joue taq c) cp in
  List.iter affiche_taquin voisins;;

Printf.printf "Voisins de taq1\n";
affiche_voisins taq1;
Printf.printf "Voisins de taq2\n"; 
affiche_voisins taq2;;

(** L' Heuristique **)

(* les coordonnées cibles pour chaque valeur *)
let coord_cible = 
  let tab = Array.make 16 (0,0) in
  for i = 0 to 3 do
    for j = 0 to 3 do
      tab.(taqWin.cases.(i).(j)) <- (i,j)
    done
  done;
  tab;;

let h taq = 
  let s = ref 0 in
  for i = 0 to 3 do
    for j = 0 to 3 do
      let v = taq.cases.(i).(j) in
      let (i_c, j_c) = coord_cible.(v) in
      s := !s + abs (i - i_c) + abs (j - j_c)
    done
  done; !s
;;

Printf.printf "h(taq1)=%d h(taq2)=%d\n" (h taq1) (h taq2);;


(** La File de priorité : liste (element, prio) trié par priorité croissante **)

type 'a fileprio = { mutable liste : ('a * int) list };;

let creeFP () = { liste = [] };;

let ajouterFP fp e prio = 
  let rec inserer (e,p) l = match l with
  | [] -> [(e,p)]
  | (e1, p1) :: ll when p <= p1 -> (e, p) :: l
  | (e1, p1) :: ll -> (e1, p1) :: (inserer (e,p) ll)
  in 
  fp.liste <- inserer (e, prio) fp.liste
;;

let estVideFP fp = fp.liste = [];;

let extraireMinFP fp = match fp.liste with
| [] -> failwith "FP vide"
| (e,p)::ll -> fp.liste <- ll; e;;

let testFP () =
  let fp = creeFP() in
  ajouterFP fp "test" 3;
  ajouterFP fp "ceci" 1;
  ajouterFP fp "est un" 2;
  while not (estVideFP fp) do
    let s = extraireMinFP fp in print_endline s
  done;;

testFP ();;

(** Les associations : taquin ->  distance, deplacement **)

let memoire = Hashtbl.create 10000;;

let dejavu taq = Hashtbl.mem memoire taq;;

let recup_info taq  = Hashtbl.find memoire taq;;

let maj_info taq (dist, depl) =
  if Hashtbl.mem memoire taq then begin
    Hashtbl.remove memoire taq; 
    Hashtbl.add memoire taq (dist, depl);
  end else 
    Hashtbl.add memoire taq (dist, depl);
;;



(** Algo A* **)

exception Success;;

let explorer taq0 =
  let fp = creeFP () in (* la file de priorité *)

  (* on ajoute le taquin initial *)
  maj_info taq0 (0, H); (* NB : mouvement quelconque *)
  ajouterFP fp taq0 (0 + h taq0);

  let count = ref 0 in (* compteur du nombre de sorties de file*)

  while not (estVideFP fp) do
    count := !count + 1;
    let taq = extraireMinFP fp in
    
    if taq = taqWin then begin (* victoire ! *)
      Printf.printf "SUCCESS : %d taquins sortis de file\n" !count;
      raise Success
    end else
      (* on récupère les infos sur le taquin *)
      let (dist, depl) = recup_info taq in

      (* on récupère tous les coups possibles *)
      let coups = coups_possibles taq in

      (* on "traite" chaque coup *)
      let traite_coup coup =
        let taq2 = joue taq coup  (* le taquin voisin *)
        in 
          if dejavu taq2 then begin (* déjà vu ? *)
            let (dist2, depl2) = recup_info taq2 in
                if dist + 2 < dist2 then begin
                  maj_info taq2 (dist + 2, coup);
                  ajouterFP fp taq2 (dist + 2 + h taq2)
                end
          end else begin (* jamais vu *)
            maj_info taq2 (dist + 2, coup);
            ajouterFP fp taq2 (dist + 2 + h taq2)
          end;
       in 
       List.iter traite_coup coups
  done;
  Printf.printf "ECHEC ??\n"
;;


let resoudre taq0 =
  Hashtbl.reset memoire; (* remise à zéro de la mémoire *)
  try
    explorer taq0
  with
    Success -> begin
      (* toutes les informations sont dans la table de hachage *)
      let rec remonte taq = (* Constuit la liste de déplacements à rebours *)
        if taq = taq0 then [] 
        else begin
          let (_, depl) = recup_info taq in
          let taq_pere = joue taq (opp depl) in
          depl :: remonte taq_pere
        end
      in 
      let chemin = List.rev (remonte taqWin) in
      List.iter affiche_depl chemin; print_newline ();
      assert (joue_partie taq0 chemin = taqWin) (* verification *)
  end
;;


(* Resolution *)

resoudre taq1;;  (* solution en 7 coups - 12 taquins sortis de file *)

resoudre taq2;;  (* solution en 20 coups - 3599 taquins sortis de file *)