type case = Vide | Pion | Invalide
type plateau = case array array
let n = 7
(* un plateau est une matrice 7x7 avec des cases invalides aux coins *)

(* Q1 *)
let print_plateau p =
  for i = 0 to n-1 do
    for j = 0 to n-1 do
      let c = match p.(i).(j) with
        | Invalide -> ' '
        | Vide -> '.'
        | Pion -> '#'
      in print_char c
    done;
    print_newline ()
  done;
  print_newline ()

(* Q2 *)
let plateau_initial () =
  [|
    [| Invalide; Invalide; Pion; Pion; Pion; Invalide; Invalide |];
    [| Invalide; Invalide; Pion; Pion; Pion; Invalide; Invalide |];
    [| Pion; Pion; Pion; Pion; Pion; Pion; Pion |];
    [| Pion; Pion; Pion; Vide; Pion; Pion; Pion |];
    [| Pion; Pion; Pion; Pion; Pion; Pion; Pion |];
    [| Invalide; Invalide; Pion; Pion; Pion; Invalide; Invalide |];
    [| Invalide; Invalide; Pion; Pion; Pion; Invalide; Invalide |]
  |]

(* Q3 *)
type mouvement = (int * int) * (int * int)

let possible p (i1,j1) (i3,j3) =
  let i2, j2 = (i1+i3)/2, (j1+j3)/2 in
  p.(i1).(j1) = Pion && p.(i2).(j2) = Pion && p.(i3).(j3) = Vide

let mouvements p =
  let l = ref [] in
  for i = 0 to n-1 do
    for j = 0 to n-3 do
      if possible p (i,j) (i,j+2)
      then l := ( (i,j), (i,j+2) ) :: !l;
      if possible p (i,j+2) (i,j)
      then l := ( (i,j+2), (i,j) ) :: !l;
      if possible p (j+2,i) (j,i)
      then l := ( (j+2,i), (j,i) ) :: !l;
      if possible p (j,i) (j+2,i)
      then l := ( (j,i), (j+2,i) ) :: !l
    done
  done;
  !l

(* Q4 *)
let compte_pions p =
  let c = ref 0 in
  for i = 0 to n-1 do
    for j = 0 to n-1 do
      if p.(i).(j) = Pion
      then incr c
    done
  done;
  !c

(* Q5 *)
let valide p = compte_pions p = 1

(* Q6 *)
let faire p mouv =
  let (i1,j1), (i3,j3) = mouv in
  let i2, j2 = (i1+i3)/2, (j1+j3)/2 in
  p.(i1).(j1) <- Vide;
  p.(i2).(j2) <- Vide;
  p.(i3).(j3) <- Pion

let defaire p mouv =
  let (i1,j1), (i3,j3) = mouv in
  let i2, j2 = (i1+i3)/2, (j1+j3)/2 in
  p.(i1).(j1) <- Pion;
  p.(i2).(j2) <- Pion;
  p.(i3).(j3) <- Vide

(* Q7 *)
exception Solution of mouvement list

let rec enumere pos chemin =
  if valide pos
  then raise (Solution chemin)
  else let l = mouvements pos in
    List.iter (fun mouv -> 
        faire pos mouv;
        enumere pos (mouv :: chemin);
        defaire pos mouv) l

(* Q8 *)
let resout () =
  let pos = plateau_initial () in
  try
    enumere pos [];
    raise Not_found
  with Solution l -> List.rev l

let _ = resout ()

(* Q9 *)
let code p =
  let c = ref 0 in
  for i = 0 to 6 do
    for j = 0 to 6 do
      if p.(i).(j) = Pion
      then c := !c + 1 lsl (7*i+j)
    done
  done;
  !c

let mauvaises = Hashtbl.create 42
let ajoute x = Hashtbl.add mauvaises x ()
let contient x = Hashtbl.mem mauvaises x

(* Q10 *)
let rec enumere pos chemin =
  if valide pos
  then raise (Solution chemin)
  else
    let c = code pos in
    if not (contient c)
    then begin
      let l = mouvements pos in
      List.iter (fun mouv -> 
          faire pos mouv;
          enumere pos (mouv :: chemin);
          defaire pos mouv) l;
      (* Si on est ici c'est que le noeud ne permet pas de trouver 
         une solution *)
      ajoute c
    end

let resout () =
  let pos = plateau_initial () in
  try
    enumere pos [];
    raise Not_found
  with Solution l -> List.rev l

let _ = resout ()

(* Q11 *)
let affiche_solution () =
  let p = plateau_initial () in
  let rec aux l_mouv = match l_mouv with
    | [] -> print_plateau p
    | m::q ->
      print_plateau p ;
      faire p m;
      Unix.sleep 1;
      aux q
  in aux (resout ())

let _ = affiche_solution ()