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 [] ;;