(**************************************************************************) (* *) (* Thibaut Balabonski, Sylvain Conchon, Jean-Christophe Filliâtre, *) (* Kim Nguyen, Laurent Sartre *) (* *) (* Informatique - MP2I/MPI - CPGE 1re et 2e années. *) (* Cours et exercices corrigés. Éditions Ellipses, 2022. *) (* *) (* https://www.informatique-mpi.fr/ *) (* *) (**************************************************************************) (* L'Âne rouge Cf https://fr.wikipedia.org/wiki/L%27%C3%82ne_rouge *) open Format (* On représente la grille comme ceci : j 0 1 2 3 i +-+-+-+-+ 0 | | | | | +-+-+-+-+ 1 | | | | | +-+-+-+-+ 2 | | | | | +-+-+-+-+ 3 | | | | | +-+-+-+-+ 4 | | | | | +-+-+-+-+ *) type pos = int * int (* Une pièce est définie par sa hauteur `h`, sa largeur `w` et sa position. *) type block = { h: int; w: int; p: pos } (* Une configuration est une liste *triée* de pièces. En triant, on garantit l'unicité. *) type state = block list let norm s = List.sort Stdlib.compare s (* La configuration de départ *) let start = norm [ (* A 1x1 *) { h=1; w=1; p=(3,1); }; { h=1; w=1; p=(3,2); }; { h=1; w=1; p=(4,0); }; { h=1; w=1; p=(4,3); }; (* B 1x2 *) { h=1; w=2; p=(2,1); }; (* C 2x1 *) { h=2; w=1; p=(0,0); }; { h=2; w=1; p=(0,3); }; { h=2; w=1; p=(2,0); }; { h=2; w=1; p=(2,3); }; (* D 2x2 *) { h=2; w=2; p=(0,1); }; ] (* Les configurations gagnantes *) let success = let ok {h;w;p} = h=2 && w=2 && p=(3,1) in List.exists ok (* Affichage d'une configuration *) let color = function | 1,1 -> 'A' | 1,2 -> 'B' | 2,1 -> 'C' | 2,2 -> 'D' | _ -> assert false let print fmt s = let m = Array.make_matrix 5 4 '.' in let add c (i,j) = m.(i).(j) <- c in let draw {h;w;p=(i,j)} = let c = color (h,w) in for di = 0 to h-1 do for dj = 0 to w-1 do add c (i+di,j+dj) done done in List.iter draw s; for i = 0 to 4 do for j = 0 to 3 do printf "%c" m.(i).(j) done; printf "@\n" done (* Impression au format OCaml, pour le dessin avec Mlpost *) let printo fmt s = let block {h;w;p=(i,j)} = fprintf fmt "(%d,%d,%d,%d);@ " h w i j in fprintf fmt "[@["; List.iter block s; fprintf fmt "@]]" let () = printf "%a@." print start let () = printf "%a@." printo start (* Déplacements. *) let moves (s: state) : state list = let free = Array.make_matrix 5 4 true in let fill { h; w; p=(i,j) } = for di = 0 to h-1 do for dj = 0 to w-1 do free.(i+di).(j+dj) <- false done done in List.iter fill s; let free i j = free.(i).(j) in let can_move_up { w; p=(i,j) } = i > 0 && free (i-1) j && (w = 1 || free (i-1) (j+1)) in let can_move_down { w; h; p=(i,j) } = i+h < 5 && free (i+h) j && (w = 1 || free (i+h) (j+1)) in let can_move_left { h; w; p=(i,j) } = j > 0 && free i (j-1) && (h = 1 || free (i+1) (j-1)) in let can_move_right { w; h; p=(i,j) } = j+w < 4 && free i (j+w) && (h = 1 || free (i+1) (j+w)) in let a = Array.of_list s in let m = ref [] in let move k ({ h; w; p=(i,j) } as b) = let add b' = a.(k) <- b'; m := norm (Array.to_list a) :: !m; in if can_move_up b then add {b with p=(i-1,j)}; if can_move_down b then add {b with p=(i+1,j)}; if can_move_right b then add {b with p=(i,j+1)}; if can_move_left b then add {b with p=(i,j-1)}; a.(k) <- b in Array.iteri move a; !m (* Plus court chemin, avec un parcours en largeur *) module Queue = Iqueue (* nos files *) let bfs source = let dist = Hashtbl.create 65536 in let path = Hashtbl.create 65536 in let q = Queue.create () in let add p v d = Hashtbl.add dist v d; Queue.enqueue q v; Hashtbl.add path v p in add source source 0; let rec loop () = if Queue.is_empty q then raise Not_found; let v = Queue.dequeue q in let d = Hashtbl.find dist v in if success v then v, d, path else ( List.iter (fun w -> if not (Hashtbl.mem dist w) then add v w (d+1)) (moves v); loop ()) in loop () let rec build_path path acc v = let p = Hashtbl.find path v in if p = v then v :: acc else build_path path (v :: acc) p let () = printf "BFS:@."; let s, d, path = bfs start in printf " %d états explorés@." (Hashtbl.length path); printf " distance %d@." d; let p = build_path path [] s in printf " longueur %d@." (List.length p - 1); (* List.iter (fun s -> printf "%a@." printo s) p; *) () (* 24048 états explorés longueur 116 1s de calcul *) (* Chemin quelconque, avec un parcours en profondeur *) let dfs source = let exception Found of state in let path = Hashtbl.create 65536 in let rec dfs p v = if not (Hashtbl.mem path v) then ( Hashtbl.add path v p; if success v then raise (Found v); List.iter (dfs v) (moves v); ) in try dfs source source; raise Not_found with Found v -> v, path let () = printf "DFS:@."; let s, path = dfs start in printf " %d états explorés@." (Hashtbl.length path); let p = build_path path [] s in printf " longueur %d@." (List.length p - 1); (* List.iter (fun s -> printf "%a@." print s) p; *) () (* 1634 états explorés longueur 1171 0.02s de calcul *) (* Combien d'états au total ? Composantes connexes ? Construction du graphe complet. *) let states = Hashtbl.create 65536 let add_state = let next = ref 0 in fun s -> assert (not (Hashtbl.mem states s)); (* par construction *) Hashtbl.add states s !next; incr next (* recherche de tous les sommets i.e. toutes les configurations avec du retour sur trace *) let () = let free = Array.make_matrix 5 4 true in let rec fill s = function | [] -> add_state s | (h, w) :: sizes -> for i = 0 to 5 - h do for j = 0 to 4 - w do if free.(i).(j) && (w = 1 || free.(i).(j+1)) && (h = 1 || free.(i+1).(j)) && (w = 1 || h = 1 || free.(i+1).(j+1)) then ( let b = { h; w; p = (i,j) } in (* IMPORTANT on construit une liste croissante *) if s = [] || b < List.hd s then ( for di = 0 to h-1 do for dj = 0 to w-1 do free.(i+di).(j+dj) <- false done done; fill (b :: s) sizes; for di = 0 to h-1 do for dj = 0 to w-1 do free.(i+di).(j+dj) <- true done done ) ) done done in fill [] [2,2; 2,1; 2,1; 2,1; 2,1; 1,2; 1,1; 1,1; 1,1; 1,1; ] let n = Hashtbl.length states let () = printf "%d sommets@." (Hashtbl.length states) (* 65880 sommets *) (* Construction du graphe *) let v = Array.make n [] let () = Hashtbl.iter (fun s i -> v.(i) <- s) states let g = Graph.create n let () = let e = ref 0 in let add i s = incr e; Graph.add_edge g i (Hashtbl.find states s) in for i = 0 to n-1 do List.iter (add i) (moves v.(i)) done; printf "%d arcs@." !e (* 206780 arcs *) (* Recherche des composantes connexes *) let nc, num = Components.components g let () = printf "%d composantes connexes@." nc (* 898 composantes connexes *) (* À quoi ressemble les composantes ? *) let tot = Array.make nc 0 let win = Array.make nc 0 let () = let add i c = tot.(c) <- tot.(c) + 1; if success v.(i) then win.(c) <- win.(c) + 1 in Array.iteri add num (* let () = * for i = 0 to n-1 do * if tot.(num.(i)) = 4 then ( * printf "%a@." printo v.(i); * exit 0 * ) * done *) let () = let a = Array.map2 (fun t w -> t, w) tot win in Array.sort Stdlib.compare a; for i = 0 to nc - 1 do let t, w = a.(i) in printf " %d configurations, %d gagnantes@." t w done