(* 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 *)