Info_MPSI/MP/Mines2021.ml

let numero_interieur z = let x = z/8 and y = z mod 8 in
  (y <= 6 && x <= 6 && (abs(x-3) + abs(y-3)) <= 4 && x>=0 && y >= 0);;

let rec intervalle a b = match a with
  | a when a = b -> [a]
  | a -> a::(intervalle (a+1) b);;

let numeros_europeens = List.filter numero_interieur (intervalle 0 53);;

type motif = int;;
type ponctuel = motif;;

let numero_vers_ponctuel (z:int) :ponctuel =
  (1 lsl z);; 

let rec numeros_vers_motifs (l:int list) :motif = match l with
  | [] -> 0
  | h::t -> (numero_vers_ponctuel h)lor(numeros_vers_motifs t);;

let motif_europeen = numeros_vers_motifs numeros_europeens;;

let est_ponctuel (m:motif) :bool = (m land (m-1)) = 0 && (m>0);;

let inclus (m:motif) (p:ponctuel) :bool = (m land p) <> 0;;

let valide (p:ponctuel):bool = inclus motif_europeen p;;

let voisin_g (p:ponctuel) : ponctuel = let res = p lsl 1 in
  if valide res then res else 0;;

let voisin_d (p:ponctuel) : ponctuel = let res = p lsr 1 in
  if valide res then res else 0;;

let voisin_h (p:ponctuel) : ponctuel = let res = p lsl 8 in
  if valide res then res else 0;;

let voisin_b (p:ponctuel) : ponctuel = let res = p lsr 8 in
  if valide res then res else 0;;

let voisins p = [voisin_g p ;voisin_d p ;voisin_h p ;voisin_b p];;

let retirer_ponctuel_dans_motif (m:motif) (p:ponctuel) :motif = m land (lnot p);;

let existence_ponctuel_p_dans_motif (m:motif) (p:ponctuel) :bool = (m land p) =p;;

(*let ajouter_ponctuel;;*)

let coup_simple ((m,p) :motif*ponctuel) =
  let coup_voisin = 
    let case_suivante = voisins p in
    let case_dapres = voisins case_suivante in
    if (inclus m case_suivante) && not (inclus m case_dapres) && case_dapres <> 0 then
      [m-p-case_suivante+case_dapres;case_dapres]
    else
      []
    in List.flatten (List.map coup voisins)
;;

let coup_compose (c:motif*ponctuel) =

  let rec aux l = 
    if l = [] then []
    else
      let nv_couples = List.flatten (List.map coup_simple l) in
      nv_couples@(aux nv_couples)
  in aux [c]
;;

let mouvements (m:motif) : motif list =
  let rec aux (p:ponctuel) =
    if p = 1 lsl 53 then []
    else (if inclus m p then coup_compose (m,p) else [])
      @(aux (2*p))

  in List.map fst (aux 4)
;;
let add_and_mem d (s:int) (m:motif) : bool =
  let dedans = Hashtbl.mem d m in
  if not dedans then Hashtbl.add d m s;
  dedans
;;

let rec strate d (s:int) (l:motif list): motif list =
  let nv_motifs = List.flatten (List.map mouvements l) in

  if add_and_mem d s nv_motifs then
    strate d (s+1) nv_motifs
  else
    []
;;