(** Projet Puzzle
@author Lilian Besson <lilian.bessonATens-cachan.fr> *) |
(* intro *)
let ex () = print_string "\n#use \"resolution.ml\";;\n";;
let d_d s = Sys.command s;;
let print_signature () = d_d "ocamlc -i resolution.ml";;
(* Ouverture des modules extérieurs *)
open List;;
open String;;
open Graphics;;
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
(* Declaration des types utilisés dans le fichier *)
| (** *) |
| (** D'abord la définition de notre réprésentation formelle des objets étudiés *) |
| (** *) |
| (** Pour les couleurs : simplement les entiers, entre 1 et c. *) |
type couleur = int;;
| (** Pour les pièces du puzzle : quatre emplacements mémoire pour les couleurs. *) |
type piece = {
b : couleur;
g : couleur;
h : couleur;
d : couleur;
};;
| (** Pour le plateau du puzzle, : on utilise un type option pour gérer simplement le cas ou on a pas encore posé la pièce sur le plateau (a voir). *) |
type plateau = {
mutable c : int;
| (** nombre de couleurs, *) |
mutable n : int;
| (** nombre de colonnes, *) |
mutable m : int;
| (** nombre de lignes, *) |
mutable p : ((piece option ) array array);
(** matrice des pièces placées sur le plateau. Si pij = None, on a tout simplement pas encore posé de pièce, *) |
mutable v : bool;
| (** un booléen qui informe de savoir si plateau est valide, ie : si l'agencement de pièce satisfait les conditions de compatibilités horizontale (compatible_h) et verticale (compatible_v). *) |
};;
| (** Pour une instance du problème. *) |
type instance = {
mutable ci : int;
| (** nombre de couleurs, *) |
mutable ni : int;
| (** nombre de colonnes, *) |
mutable mi : int;
| (** nombre de lignes, *) |
mutable pi : piece list;
| (** liste des pièces donnée à l'entrée. *) |
};;
(** CONVENTION : sur les 'array array'
Si a = Array.create_matrix 2 7 '.';;
on conviend que a est une matrice, de type char array array, de taille : dimX = 2, dimY = 7,
ie : avec 2 colonnes, et 7 lignes
a.0 est un array de taille 7, qui est une COLONNE de la matrice,
et | a.[0].[j] ; ..; a.[n-1].[j] | est la jieme LIGNE de la matrice,
*) |
if (!(Sys.interactive)) then ex();;
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
(* Declaration des exceptions utilisées dans le fichier *)
| (** *) |
| (** Quelques exceptions *) |
| (** *) |
| (** Si on a cherché a se débarasser d'un élément de type 'a option valant "None". *) |
exception Erreur_option;;
| (** Notre procédure de recherche sera exhaustive, et donc possiblement peu efficace. On stoppe la recherche dès qu'on trouve une possibilité qui va bien. *) |
exception Solution_trouvee;;
exception Solution_trouvee_arg of plateau;;
| (** Si on a aucune solution au puzzle. *) |
exception Aucune_solution;;
| (** Si lors de la lecture d'un plateau dans un fichier extérieure (ie : une solution possible, ou partielle), on découvre une erreur. *) |
exception Mauvais_tableau;;
| (** Si une paire de pièce ne satisfait pas h, la relation de satisfaisabilité horizontale. *) |
exception Erreur_compatibilite_h of (int * int);;
| (** Si une paire de pièce ne satisfait pas v, la relation de satisfaisabilité verticale. *) |
exception Erreur_compatibilite_v of (int * int);;
| (** Si l'utilisateur demande l'interruption d'une des fonctions d'écritures. *) |
exception Ecriture_refusee;;
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
(* Declaration des fonctions utilisées dans le fichier *)
| (** Note : j'utilise des arguments nommés (déclarés par des '~<arg>') afin de faciliter l'utilisation des fonctions dans les autres programmes. Ainsi, la signature de nombreuses fonctions ici définies contiendra des '~arg:<type>'. J'espère être plus clair et compréhensible par cet outil. Et parfois des arguments optionnels, déclarés par des '?(<arg>:<valeur_par_defaut>). Tant qu'on n'utilise que les valeurs de tels arguments optionnels, et pas leur type (pas de match..with notamment), l'utilisation est la même que pour les arguments optionnels *) |
| (** *) |
| (** Fonctions outils, macros *) |
(* note : certaine de ces fonctions viennent de mes autres projets, je les ai juste recopié ici *)
| (** *) |
| (** Pour faciliter l'accès au dimension d'un matrice : *) |
| (** Dimension selon x. *) |
let dimX (tab : 'a array array) = Array.length tab;;
| (** Calcule le nombre de colonne d'une matrice (array array). *) |
let nombreColonne = dimX;;
| (** Dimension selon y. *) |
let dimY (tab : 'a array array) = Array.length (tab.(0));;
| (** Calcule le nombre de ligne d'une matrice (array array). *) |
let nombreLigne = dimY;;
| (** Test l'appartenance d'un élément a une liste *) |
let rec in_list element = function
|[] -> false;
|el :: ssl -> (element = el) || (in_list element ssl);;
| (** Pour extraire une sous-string. *) |
let monsub mastr idebut taille =
let res = ref "" in
if taille >= 0 then res := (String.sub mastr idebut taille);
!res;;
| (** Pour faciliter la gestion des 'out_channel'. *) |
let ecrire_sortie monoutchanel machaine =
output monoutchanel machaine 0 (String.length machaine);
flush monoutchanel;;
| (** Pour découper une chaine de caractères en morceau, en commancant un nouveau morceau pour chaque 'e' trouvé. Par défaut, si le parametre 'e' (pour 'effacé') n'est pas spécifié, il vaut ' ' le caractère espace. *) |
let rec decoupe ?(e = [' ']) ma_string =
let n = (String.length ma_string);
and result = ref [];
and i = ref 0; in
if (n > 0) then
begin
while ( (!i < (n - 1)) && not(in_list ma_string.[!i] e)) do
incr i;
done;
if (!i = (n - 1)) then result := [ma_string];
if (!i <= (n - 2)) then result := [(monsub ma_string 0 !i)]@(decoupe ~e (monsub ma_string (!i + 1) (n - !i - 1) ));
end;
!result;;
(*decoupe_custom ~e:['K'] "je serais decoupe a chaque k majuscule : K et voila. Un autre pour etre sur : K : ok ca marche !";;*)
(*decoupe_custom ~e:[',';';';':';'-'] "je serais decoupe a chaque en 5 morceaux : et d'un pour un deux points , un autre avec une virgule ; et un avec un point.virgule - et le dernier par un tiret !";;*)
| (** Converti une matrice en une liste, selon les conventions d'indiçages universelles. *) |
let list_of_matrix ma_matrice =
let (m, n) = (nombreColonne ma_matrice, nombreLigne ma_matrice) in
let res = ref [] in
for j = 0 to (n-1) do
for i = 0 to (m-1) do
res := !res @ [ma_matrice.(i).(j)]
done;
done;
!res;;
(** Converti une liste en une matrice, selon les conventions d'indicages universelles, en supposant qu'on connaisse la taille de destination. A propos des arguments nommés : ils peuvent être indiqués dans un ordre quelconque lors de l'appel.
Exemples :
$> matrix_of_list ~n:4 ~m:1 ~l:0;1;2;3
est un appel valide
$> matrix_of_list ~l:0;1 ~n:1 ~m:2
et celui-là aussi. *) |
let matrix_of_list ~l ~m ~n =
let nn = List.length l in
if (nn <> (m * n)) then (raise (Invalid_argument("matrix_of_list : dimensions mismatch |l| <> n*m")));
let res = Array.create_matrix m n (hd l) in
for j = 0 to (n-1) do
for i = 0 to (m-1) do
res.(i).(j) <- (List.nth l (i + j*m));
done;
done;
res;;
| (** Pour se débarasser simplement du type option. *) |
let kill_option = function
| Some(u) -> u;
| None -> raise Erreur_option;;
| (** Pour améliorer la lecture d'un entier au clavier. (Attention : on modifie une fonction standard de Ocaml). *) |
let read_int () =
try (read_int ()) with Failure "int_of_string" -> 0;;
(* List.concat (List.map Array.to_list (Array.to_list m));;*)
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
| (** *) |
| (** Fonctions de vérifications : compatibilités, validités *) |
| (** *) |
| (** Relation de compatibilité horizontale. *) |
let compatible_h ~pieceG ~pieceD =
| (** G est compatible horizontalement avec D ssi G.d = D.g, *) |
pieceG.d = pieceD.g;;
| (** en effet, G.d : couleur de droite de G, D.g : couleur de gauche de D. *) |
| (** Relation de compatibilité horizontale. *) |
let compatible_v ~pieceB ~pieceH =
| (** B est compatible horizontalement avec H ssi B.h = H.b, *) |
pieceB.h = pieceH.b;;
| (** pour ces deux fonctions, attention à l'ordre des arguments, ils ne sont pas commutatifs. *) |
if (!(Sys.interactive)) then ex();;
| (** Pour vérifier qu'un plateau ne contredit pas les compatibilités. *) |
let nest_pas_faux (mon_plateau:plateau) =
let (c, n, m, p) = (mon_plateau.c, mon_plateau.n, mon_plateau.m, mon_plateau.p) in
| (** Nous supposons que tous les 'array array' manipulés seront bien rectangles, et que de plus tout les plateaux auront des paramètres n et m correspondant effectivement à leurs dimensions. *) |
| (** Ainsi, n = nombreColonne p, et m = nombreLigne p. *) |
| (** On vérifie d'abord horizontalement, *) |
let result_h = ref true in
for i = 0 to (m-2) do
for j = 0 to (n-1) do
match (p.(i).(j), p.(i+1).(j)) with
| Some x, Some y ->
result_h := !result_h && (compatible_h ~pieceG:x ~pieceD:y );
| _ -> ()
done;
done;
| (** Puis verticalement. *) |
let result_v = ref true in
for i = 0 to (m-1) do
for j = 0 to (n-2) do
match (p.(i).(j), p.(i).(j+1)) with
| Some x, Some y ->
result_v := !result_v && (compatible_v ~pieceB:x ~pieceH:y );
| _ -> ()
done;
done;
(!result_h && !result_v);;
| (** Pour vérifier qu'un plateau ne contredit pas les compatibilités. *) |
let compatible (mon_plateau:plateau) =
let (c, n, m, p) = (mon_plateau.c, mon_plateau.n, mon_plateau.m, mon_plateau.p) in
| (** On vérifie d'abord horizontalement, *) |
for i = 0 to (m-2) do
for j = 0 to (n-1) do
match (p.(i).(j), p.(i+1).(j)) with
| Some x, Some y ->
if not(compatible_h ~pieceG:x ~pieceD:y ) then raise (Erreur_compatibilite_h(i, j));
| _ -> ()
done;
done;
| (** Puis verticalement. *) |
for i = 0 to (m-1) do
for j = 0 to (n-2) do
match (p.(i).(j), p.(i+1).(j)) with
| Some x, Some y ->
if not(compatible_v ~pieceB:x ~pieceH:y ) then raise (Erreur_compatibilite_v(i, j));
| _ -> ()
done;
done;
();;
| (** Pour vérifier qu'un plateau est valide. *) |
let est_valide_plateau (mon_plateau:plateau) =
let (c, n, m, p) = (mon_plateau.c, mon_plateau.n, mon_plateau.m, mon_plateau.p) in
| (** On vérifie d'abord qu'aucune des cases du tableau ne soit un 'None'. *) |
for i = 0 to (m-1) do
for j = 0 to (n-1) do
match p.(i).(j) with
| Some _ -> ();
| None -> raise Mauvais_tableau;
done;
done;
| (** On vérifie d'abord horizontalement; *) |
for i = 0 to (m-2) do
for j = 0 to (n-1) do
match (p.(i).(j), p.(i+1).(j)) with
| Some x, Some y ->
if not(compatible_h ~pieceG:x ~pieceD:y ) then raise (Erreur_compatibilite_h(i, j));
| (** Si le tableau contient un case sans piece attribuée, on déclenche 'Mauvais_tableau'; *) |
| _ -> raise Mauvais_tableau;
done;
done;
| (** Puis verticalement. *) |
for i = 0 to (m-1) do
for j = 0 to (n-2) do
match (p.(i).(j), p.(i).(j+1)) with
| Some x, Some y ->
if not(compatible_v ~pieceB:x ~pieceH:y ) then raise (Erreur_compatibilite_v(i, j));
| _ -> raise Mauvais_tableau;
done;
done;
| (** On use et on abuse des exceptions pour gérer des valeurs de retours spécifiques. *) |
raise Solution_trouvee;
();;
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
| (** *) |
| (** Fonctions de création d'instances aléatoires *) |
| (** *) |
| (** On charge ici le module standard 'Random' de Ocaml, et on l'initialise. *) |
open Random;;
Random.self_init();;
| (** Pour créer une couleur alétoire entre 1 et c. *) |
let couleur_random ~c () = ((Random.int c) + 1 : couleur);;
| (** Pour créer une pièce aléatoire du puzzle. Nécessite de préciser le nombre de couleurs , par exemple '~c:4'. *) |
let piece_random ~c () = {
b = couleur_random ~c ();
g = couleur_random ~c ();
h = couleur_random ~c ();
d = couleur_random ~c ();
};;
| (** Fonction outil générale, Pour créer une liste d'élément générés aléatoires, créés par l'argument '~gen:<..>'. La signature imposée a 'gen' est faite pour être compatible avec les deux fonctions précédentes 'couleur_random' et 'piece_random'. *) |
let rec creer_liste_random ~gen = function
| 0 -> [];
| n -> (gen() ) :: (creer_liste_random gen (n-1));;
| (** Pour créer une instance aléatoire du problème. Nécessite de préciser le nombre de couleurs, et la taille du plateau. Par exemple '~c:4 ~m:1 ~n:2' pour une instance similaire à celle donnée dans l'énoncé. *) |
let creer_instance_random ?(m = 1) ?(n = 2) ?(c = 4) () =
{
ci = c;
ni = n;
mi = m;
pi = creer_liste_random ~gen:(piece_random ~c:c) (n * m);
} ;;
(*!*) (* ESSAIS *)
| (** Un exemple d'instance. *) |
(*let newi = creer_instance_random ();;*)
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
if (!(Sys.interactive)) then ex();;
| (** *) |
| (** Fonctions de lectures et écritures dans un fichier *) |
| (** *) |
(* ECRITURE *)
let demande_confirmation file =
| (** Comme on est poli, on demande confirmation avant d'écraser un fichier déja existant ! *) |
print_string ("Projet Puzzle - ecriture_instance : le fichier '"^file^"' existe deja. Voulez-vous l'ecraser ? [O/n]\n");
(* A voir comment adapter cela après avec l'interface graphique. Peut etre l'enlever. *)
match (read_line ()) with
|"n" -> raise Ecriture_refusee;
| _ -> ();;
| (** Pour écrire une instance. *) |
let ecriture_instance ?(action_confirmation = demande_confirmation ) ~i ~file =
| (** On demande de plus l'adresse (relative ou absolue) du fichier où on veut écrire. *) |
| (** /!\ CONVENTION : on utilise la réprésentation fichier de Unix. Par exemple : "/home/superman/Bureau/puzzle_de_la_mort_qui_tue.instance". *) |
| (** On ouvre le canal, on vérifie si on peut écrire. *) |
if (Sys.file_exists file) && (file <> "stdout") then (
| (** Comme on est poli, on demande confirmation avant d'écraser un fichier déja existant ! *) |
action_confirmation file;
);
let canal_sortie = (* Le canal de sortie 'stdout', celui de l'écran actuel *)
(match file with (* a droit a un traitement spécial, parce qu'on ne peut *)
| "stdout" -> stdout; (* le fermer par un 'close_out'. *)
| _ -> open_out file;)
in
let mprint s = ecrire_sortie canal_sortie s; in
let mprint_int s = ecrire_sortie canal_sortie ((string_of_int s)^" "); in
| (** Macros pour imprimer dans le fichier de sortie, et pour l'actualiser (ecrire_sortie le fait tout seul). *) |
| (** On écrit, *) |
let (c, n, m, p) = (i.ci, i.ni, i.mi, i.pi) in
| (** La premiere ligne : m n c, *) |
mprint_int m;
mprint_int n;
mprint (string_of_int c); (* pour ne pas mettre d'espace en fin de ligne *)
mprint "\n";
| (** Puis une ligne par pièce : couleur de droite, du haut, de gauche, et du bas. *) |
let rec print_liste_piece = function
| [] -> ();
| x :: sslistp ->
mprint_int x.d;
mprint_int x.h;
mprint_int x.g;
mprint (string_of_int x.b);(* pour ne pas mettre d'espace en fin de ligne *)
mprint "\n";
print_liste_piece sslistp;
in
print_liste_piece p;
| (** On conclut. *) |
flush canal_sortie;
match file with
| "stdout" -> ();
| _ -> close_out canal_sortie;
();;
(*
1 2 4
4 1 4 2
1 2 4 3
*)
| (** Pour n'afficher qu'une piece. *) |
let print_piece x =
print_int x.d; print_string " ";
print_int x.h; print_string " ";
print_int x.g; print_string " ";
print_int x.b;(* pour ne pas mettre d'espace en fin de ligne *)
print_string "\n";;
(*!*) (* ESSAIS *)
| (** Exemple de la représentation par le type 'instance' de l'exemple présenta dans l'énoncé. *) |
(*let instance_test =*)
(* {ci = 4; ni = 2; mi = 1;*)
(* pi = [{b = 2; g = 4; h = 1; d = 4}; {b = 3; g = 4; h = 2; d = 1};]*)
(* };;*)
(* *)
(*print_string "ESSAI : ecriture_instance\n";;*)
(*try (ecriture_instance instance_test "sortie_test.instance") with _ -> ();;*)
| (** On peut aussi afficher à l'écran, en utilisant le nom de fichier spécial 'stdout' (sortie écran) *) |
let test_ecriture () = ecriture_instance (creer_instance_random ()) "stdout";;
(*test_ecriture();;*)
(*test_ecriture();;*)
(*test_ecriture();;*)
(*test_ecriture();;*)
| (** Raccourcis pour afficher une instance à l'écran directement (et pas dans un fichier extérieur). On affiche simplement sous la même forme que sous laquelle on écrit. Les fonctions d'affichage dans des fenètres, avec de la couleur, sont disponibles dans le module "interface". *) |
let print_instance i = ecriture_instance i "stdout";;
(* LECTURE *)
exception Error_Parse_instance;;
(** Convertit une liste de couleurs d; h; g; b en une piece équivalente. *) |
let piece_of_listcouleur ma_listeint =
| (** Suppose que la liste a exactement 4 entiers comme élément : d h g b. *) |
{b = (List.nth ma_listeint 3); g = (List.nth ma_listeint 2); h = (List.nth ma_listeint 1); d = (List.nth ma_listeint 0)};;
| (** Pour lire une instance écrite dans le fichier 'file'. *) |
let lecture_instance ~file =
(*(** file : correspond à l'adresse (relative ou absolue) du fichier que l'on veut lire. *)
(** /!\ CONVENTION : on utilise toujours la réprésentation fichier de Unix : /home/superman/Bureau/puzzle_de_la_mort_qui_tue.instance *)
*)
| (** On ouvre le canal. *) |
let canal_entree = open_in file; in
let finlecture = ref false; in
let nb_ligne = ref 0; in
| (** On commence à lire, *) |
let m = ref 0 and n = ref 0 and c = ref 0 in
let p = ref [] in
let rec auxi mon_ce =
let res_input = (try (((input_line mon_ce))) with End_of_file -> (finlecture := true; "")); in
(* print_string ("Numéro de ligne "^(string_of_int !nb_ligne)^": \tLigne importee :\n\t["^res_input^"]\n");*) (* DEBUG *)
| (** Si on a pas finit de lire, on analyse : *) |
if (not !finlecture)
then
(
| (** 1' cas : c'est la première ligne lue; *) |
if (!nb_ligne = 0) then (
| (** On a importé une ligne qui correspond d'abord au header : m n c, *) |
let liste_header = List.map int_of_string (decoupe res_input); in (* une liste de strings transformées en entiers donc *)
if (List.length liste_header) <> 3 then raise Error_Parse_instance;
| (** En cas de non cohérence, l'exception est lancée 'Error_Parse_instance'. *) |
m := List.nth liste_header 0;
n := List.nth liste_header 1;
c := List.nth liste_header 2;
| (** On a réussi a lire et convertir la ligne. *) |
);
| (** 2' cas : ce n'est pas la première ligne lue; *) |
if (!nb_ligne <> 0) then (
| (** On a importé une ligne qui correspond à une piece, *) |
let liste_couleur_piece = List.map int_of_string (decoupe res_input); in (* une liste de strings transformées en entiers donc *)
if (List.length liste_couleur_piece) <> 4 then raise Error_Parse_instance;
| (** En cas de non cohérence, l'exception est lancée 'Error_Parse_instance'. *) |
p := !p @ [piece_of_listcouleur liste_couleur_piece];
| (** On a réussi a lire et convertir la ligne. *) |
);
incr nb_ligne;
(auxi mon_ce);
)
else close_in canal_entree;
| (** Sinon, on clos le canal d'entrée, et on passe a la suite. *) |
in
auxi canal_entree;
| (** On vérifie le bon nombre de lignes, les autres spécificités des fichiers .instance ont déja été vérifiée. *) |
if (!nb_ligne <> ((!n * !m) + 1)) then raise Error_Parse_instance;
| (** On conclut en fermant le canal d'entréé et en construisant l'instance lue. *) |
close_in canal_entree;
{ ci = !c; ni = !n; mi = !m; pi = !p };;
(*!*)(* ESSAI *)
| (** Testons la lecture de l'instance test qu'on a écrite plus haut : *) |
(*print_instance (lecture_instance "sortie_test.instance");;*)
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
| (** Les memes fonctions de lecture et écriture, mais pour des plateaux *) |
| (** Pour se débarasser simplement du type option, mais en affichant quand meme si on tombe sur un None. *) |
let kill_option2 = function
| Some(u) -> u;
| None -> {b = 0; g = 0; h = 0; d = 0};;
| (** Jusque là, on lit et écrit des instances, pas des solutions (type plateau) *) |
let instance_of_plateau (mon_plateau:plateau) =
let (c, n, m, p) = (mon_plateau.c, mon_plateau.n, mon_plateau.m, mon_plateau.p) in
| (** On doit juste transformer la matrice de piece 'p' en une liste de pieces 'pi' Mais il faut etre cohérent avec la convention d'écriture d'une solution, ** qu'on fera par conversion + écriture d'une instance. *) |
{
ci = c;
ni = n;
mi = m;
pi = List.map kill_option2 (list_of_matrix p);
};;
| (** LA FONCTION SUIVANTE N'EST PAS LA FONCTION DE RESOLUTION. Il s'agit de la conversion naive. *) |
let plateau_of_instance (mon_instance:instance) =
let (ci, ni, mi, pi) = (mon_instance.ci, mon_instance.ni, mon_instance.mi, mon_instance.pi) in
let mon_plateau = {
c = ci;
n = ni;
m = mi;
p = matrix_of_list ~l:(List.map (fun u -> Some(u)) pi) ~m:mi ~n:ni;
v = false;
} in
(* mon_plateau.v <- (try (est_valide_plateau mon_plateau; false;) with *)
(*| Solution_trouvee -> true;*)
(*| (Erreur_compatibilite_h(i, j)) -> print_string ("Projet Puzzle - plateau_of_instance : lors de la conversion naive, une erreur de compatibilite horizontale a ete trouve pour les indices suivants i="^(string_of_int i)^" et j="^(string_of_int j)); false;*)
(*| Mauvais_tableau -> print_string ("Projet Puzzle - plateau_of_instance : lors de la conversion naive, une erreur de taille du tableau a ete trouvee."); false;*)
(*| (Erreur_compatibilite_v(i, j)) -> print_string ("Projet Puzzle - plateau_of_instance : lors de la conversion naive, une erreur de compatibilite verticale a ete trouve pour les indices suivants i="^(string_of_int i)^" et j="^(string_of_int j)); false;*)
(* );*)
mon_plateau;;
(* On créé alors trivialement les trois fonctions suivantes *)
| (** Pour ecrire une solution (de type 'plateau') dans un fichier externe. ~p correspond au plateau, ~file a l'emplacement du fichier de destination. *) |
let ecriture_plateau ~p = ecriture_instance ~i:(instance_of_plateau p);;
| (** Pour afficher une solution. On affiche simplement sous la même forme que sous laquelle on écrit. Les fonctions d'affichage dans des fenètres, avec de la couleur, sont disponibles dans le module "interface". *) |
let print_plateau mon_plateau = print_instance (instance_of_plateau mon_plateau);;
| (** Pour lire une solution depuis un fichier externe. Il faut que l'instance enregistrée dans ce fichier soit une solution correcte, sinon le plateau produit ne sera pas valide. *) |
let lecture_plateau ~file = plateau_of_instance (lecture_instance ~file);;
(*!*)(* ESSAI *)
| (** Un test. *) |
(*let plateau_test = plateau_of_instance instance_test;;*)
(*print_plateau (lecture_plateau "sortie_test.instance");;*)
| (** Une fonction de test de toutes les fonctions précédentes : génération aléatoire, lecture, écriture, conversion naïve plateau - instance, affichage dans le terminal. Si une des lignes ne termine pas par 'check !', une erreur s'est produite. *) |
let test_complet ~m ~n ~c =
let ps s = print_string (s^"\n") in
ps "\nTEST complet : création, écriture, lecture, conversion (pas résolution) ... en cours";
let i = creer_instance_random ~m ~n ~c () in
ps "\nTest création aléatoire d'un instance : check !";
print_instance i;
ps "Test affichage instance : check !";
ecriture_instance ~i:i ~file:"test_complet.instance";
ps "Test ecriture instance dans le fichier externe 'test_complet.instance' : check !";
let i2 = lecture_instance ~file:"test_complet.instance" in
if (i2 = i) then ps "Test lecture instance depuis le meme fichier externe : check !"
else ps "Test lecture instance depuis le meme fichier externe : fail ...";
let i3 = instance_of_plateau (plateau_of_instance i) in
if (i3 = i) then ps "Test double conversion plateau <-> instance (pas résolution) : check !"
else ps "Test double conversion plateau <-> instance (pas résolution) : fail ...";
let p1 = plateau_of_instance i in
ps "Test conversion instance -> plateau : check !";
print_plateau p1;
ps "Test affichage plateau : check !";
ecriture_plateau ~p:p1 ~file:"test_complet.plateau";
ps "Test ecriture plateau dans le fichier externe 'test_complet.instance' : check !";
let p2 = lecture_plateau ~file:"test_complet.plateau" in
if (p2 = p1) then ps "Test lecture plateau depuis le meme fichier externe : check !"
else ps "Test lecture plateau depuis le meme fichier externe : fail ...";
ps "\n\nTEST réussi !";;
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
| (** *) |
| (** Résolution *) |
| (** *) |
(** On propose d'abord un genre d'interface qui propose trois niveaux de verbosité pendant la résolution.
Que la résolution soit utilisée pour afficher une solution, en mode graphique avec des couleurs (via 'interface.ml'), ou en mode textuel pour sauvegarder le résultat, il est possible d'afficher des informations pendant la résolution.
On distingue deux types d'informations :- les plateaux courant,
|
| (** Type utilisé pour différencier les modes. *) |
type verbosity = Muet | Verbeux_textuel | Bavard_textuel | Verbeux_graphique | Bavard_graphique;;
| (** Pour afficher les informations textuelles. *) |
let myprint verb s =
match verb with
| Muet -> ();
| Verbeux_textuel -> print_string (s^"\n");
| Bavard_textuel -> print_string (s^"\n");
| Verbeux_graphique -> print_string (s^"\n");
| Bavard_graphique -> print_string (s^"\n");;
| (** De plus, on propose en fait a nos fonctions de prendre un argument optionnel qui est la méthode utilisée pour afficher un plateau. Elle peut donc etre 'print_plateau' définit ici, qui affiche la plateau à l'écran, tel qu'il est affiché dans un fichier externe; et dans la partie graphique cette méthode (ie : fonction : plateau -> unit;) pourra etre 'afficher_plateau'. L'argument optionnel s'appele '~printP' *) |
(* Commenter celui qui vous plait, selon le niveau d'informations voulu. *)
(*let myverb = Verbeux_textuel;;*)
let myverb = Muet;;
| (** On donne ici les premières fonctions de résolution du puzzle. *) |
| (** On supposera toujours que les pièces manipulées sont construites avec le bon nombre de couleurs, cohérent avec le champ d'enregistrement 'c' du plateau manipulé. Je précise quand j'y pense les autres points que l'on suppose avoir dans chaque fonction. *) |
| (** Pour créer le plateau vide avec lequel on commence à travailler. *) |
let creer_plateau_vide ~printP (mon_instance:instance) =
myprint myverb "Création de plateau vide ... a partir de l'instance argument.";
let (ci, ni, mi, pi) = (mon_instance.ci, mon_instance.ni, mon_instance.mi, mon_instance.pi) in
let mon_plateau = {
c = ci;
n = ni;
m = mi;
p = Array.create_matrix mi ni None;
v = false;
} in
printP mon_plateau;
mon_plateau;;
| (** Si on tente de rajouter une pièce sur une case qui n'est pas vide (ie qui ne contient pas un élément de type piece option, réduit à "None"). *) |
exception Case_deja_occupee ;;
| (** Relation de compatibilité horizontale adaptée avec le type option. *) |
let compatible_h_option pieceG pieceD =
myprint myverb "Appel a la relation de compatibilite horizontale.";
match (pieceG, pieceD) with
| Some x, Some y ->
myprint myverb "\tLes deux cases sont des 'Some'.";
x.d = y.g;
| _, _ ->
myprint myverb "\tUne des deux cases est un 'None'.";
true;;
| (** Relation de compatibilité horizontale adaptée avec le type option. *) |
let compatible_v_option pieceB pieceH =
myprint myverb "Appel a la relation de compatibilite verticale.";
match (pieceB, pieceH) with
| Some x, Some y ->
myprint myverb "\tLes deux cases sont des 'Some'.";
x.h = y.b;
| _, _ ->
myprint myverb "\tUne des deux cases est un 'None'.";
true;;
(*
myprint myverb "";
*)
| (** Pour savoir si la piece '~pi' est rajoutable en case ('~i', '~j') du plateau courant '~pl'. *) |
let est_rajoutable ~piece ~i ~j ~pl =
myprint myverb ("Appel a 'est_rajoutable'. Indices : i="^(string_of_int i)^" et j="^(string_of_int j)^" !");
| (** Ici les 4 couleurs de '~pi' sont donc toutes des couleurs admissibles pour le plateau courant. Et l'indice i (resp. j) est entre 0 et m-1 (resp. n-1). *) |
let (c, n, m, p) = (pl.c, pl.n, pl.m, pl.p) in
let result = ref true in
match p.(i).(j) with
| Some _ ->
| (** On essaie ici de rajouter une piece '~pi' sur une case déjà remplie de notre tableau, *) |
(* raise Case_deja_occupee;*)
print_string "\tException non lancée : Case_deja_occupee";
myprint myverb "\tResultat renvoyé : false";
false;
| None ->
| (** là on tente de mettre une pièce sur une case libre. Il faut vérifier que cette pièce ne contredit pas les 4 (ou moins) relations de satisfaisabilité horizontales (avec la pièce à gauche et à droite), et verticales (avec la pièce en bas et en haut. *) |
| (** Il y a plusieurs cas où on a différents nombres de compatibilité à vérifier. *) |
if (i > 0) then | (** on peut comparer à gauche, *) |
result := !result && (compatible_h_option p.(i-1).(j) (Some piece));
if (j > 0) then | (** on peut comparer en bas, *) |
result := !result && (compatible_v_option p.(i).(j-1) (Some piece));
if (i < m-1) then | (** on peut comparer à droite, *) |
result := !result && (compatible_h_option (Some piece) p.(i+1).(j));
if (j < n-1) then | (** on peut comparer en haut, *) |
result := !result && (compatible_v_option (Some piece) p.(i).(j+1));
| (** On fait le "ET" des quatres résultats de ces tests, avec un "true" initialement, cela permet de dire que le résultat final est vrai ssi chaque test est vrai. *) |
myprint myverb ("\tResultat renvoyé : "^(string_of_bool !result));
!result;;
| (** Pour supprimer un élément d'une liste. *) |
let rec suppri_liste element = function
| [] ->
myprint myverb "Appel a 'suppri_liste' avec une liste vide.";
[];
| el :: sliste ->
myprint myverb "Appel a 'suppri_liste' avec une liste non vide.";
match (el = element) with
|true ->
myprint myverb "\tElement trouvé et supprimé.";
(sliste); | (** On ne l'enlève qu'une fois ! *) |
|false ->
myprint myverb "\tElement non trouvé et non supprimé.";
el :: (suppri_liste element sliste);;
| (** Pour trouver l'indice (i,j) suivant dans notre numérotation courante. *) |
let indices_suivants ~i ~j ~n ~m =
myprint myverb ("Appel a la 'indices_suivants' avec Indices : i="^(string_of_int i)^" et j="^(string_of_int j)^" ! et avec Indices : n="^(string_of_int n)^" et m="^(string_of_int m)^" !");
(* On a k_courant = i + j*m, on aura k_suivant = k_courant + 1. Deux solutions, selon qu'on est en fin de ligne ou pas. *)
match (i < m-1) with
|true ->
myprint myverb "\tLigne non finie : on continue d'avancer.";
((i + 1), j);
|false ->
myprint myverb "\tLigne finie : on monte.";
(0, (j + 1));; (* ok marche *)
| (** Fonction macro pour simplifier la rédaction de la première fonction de résolution. *) |
let argument_suivant ~printP ~liste_piece ~plateau ~icourant ~jcourant ~piece_choisie =
myprint myverb ("\t<<<<<<<<<<<<<<<<");
myprint myverb ("Appel a 'argument_suivant' avec Indices : icourant="^(string_of_int icourant)^" et jcourant="^(string_of_int jcourant)^" ! et la piece choisie est :");
if (myverb = Verbeux_textuel) then print_piece piece_choisie;
| (** Suppose que la piece choisie peut effectivement se mettre en case (i,j) du plateau courant, qu'elle satisfait tout ce qu'il faut, et qu'elle est bien une des pièces de la liste de piece. *) |
let liste_piece_suivant = (suppri_liste piece_choisie liste_piece) in
(* On enleve la piece choisie des pieces à placer, *)
let (i_suivant, j_suivant) = (indices_suivants ~i:icourant ~j:jcourant ~n:plateau.n ~m:plateau.m) in
(* On passe à l'indice suivant, *)
myprint myverb "\t<<\n\tLe plateau argument dans 'argument_suivant' est, avant modification, :";
if (myverb = Verbeux_textuel) then printP plateau;
let plateau_suivant = {
c = plateau.c;
n = plateau.n;
m = plateau.m;
p = Array.map Array.copy (plateau.p); (* précaution *)
v = true; (* test *)
} in
(* On fait une copie du plateau courant, *)
myprint myverb "\t<<\n\tDans 'argument_suivant', on viend de construire le nouveau plateau. Testons :";
myprint myverb ("\t<<\n\t Egalité pour les valeurs :"^(string_of_bool (plateau = plateau_suivant))^" Egalité machine :"^(string_of_bool (plateau == plateau_suivant))^". Alors ?");
myprint myverb "\t<<\n\tLe plateau suivant dans 'argument_suivant' est, avant modification, :";
if (myverb = Verbeux_textuel) then printP plateau_suivant;
(*!!*) plateau_suivant.p.(icourant).(jcourant) <- Some piece_choisie; (* cette ligne là ne peut pas changer 'plateau' ! Pourquoi alors on observe un changement ?!?! *)
myprint myverb "\t<<\n\tLe plateau suivant dans 'argument_suivant' est, après modification, :";
if (myverb = Verbeux_textuel) then printP plateau_suivant;
myprint myverb "\t<<\n\tLe plateau argument dans 'argument_suivant' est, après modification, :";
if (myverb = Verbeux_textuel) then printP plateau;
(* Et on le modifie en plaçant la piece choisie sur la case choisie. *)
(* On renvoie enfin le tout dans un quadruplet, pour l'utiliser dans la fonction suivante. *)
( liste_piece_suivant, plateau_suivant, i_suivant, j_suivant);;
| (** La fonction récursive naïve de résolution. *) |
let rec resoud_naivement_aux ~printP ~liste_piece ~plateau ~icourant ~jcourant =
myprint Verbeux_textuel ("\t$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$");
myprint Verbeux_textuel ("\n#\nAppel a 'resoud_naivement_aux' avec Indices : icourant="^(string_of_int icourant)^" et jcourant="^(string_of_int jcourant)^" !");
myprint Verbeux_textuel "\t$\n\tLe plateau courant est :";
if (Verbeux_textuel = Verbeux_textuel) then printP plateau;
| (** ON FAIT UNE RECHERCHE A PRIORI TRES LONGUE. ICI ON S'ARRETE DES QU'ON A UNE SOLUTION. *) |
(try (est_valide_plateau plateau) with
| Solution_trouvee -> raise (Solution_trouvee_arg(plateau));
| Mauvais_tableau -> ();
| Erreur_compatibilite_h(_,_) -> ();
| Erreur_compatibilite_v(_,_) -> ();
);
(* est_valide_plateau plateau;*)
(* print_string (string_of_bool (est_valide_plateau plateau));*)
(* read_line ();*)
| (** Suppose que le plateau a la même taille que l'instance sur les trois paramètres c, n, m. En effet, cette fonction sera appelée ensuite avec un plateau vide créé par "creer_plateau_vide". *) |
match liste_piece with
| [] ->
myprint myverb ("\tLa liste de pièces est vide. On renvoit le plateau que l'on devait continuer de compléter. Il est sensé etre complet.");
(* On a finit : on a placé toutes les pièces sur le plateau, le résultat est donc la liste contenant seulement le plateau courant. *)
[plateau];
| _ ->
myprint myverb ("\tLa liste de pièces n'est pas encore vide.");
let liste_arguments_suivants = ref [] in
let fauxi_ajoute piecex =
(
myprint myverb ("\t##\n\tAppel interne a 'fauxi_ajoute' avec la piece suivante :");
if (myverb = Verbeux_textuel) then print_piece piecex;
myprint myverb "\t$$\n\tLe plateau courant est :";
if (myverb = Verbeux_textuel) then printP plateau;
match (est_rajoutable ~piece:piecex ~i:icourant ~j:jcourant ~pl:plateau) with
| true ->
myprint myverb ("\tLa piece est rajoutable.");
| (** On fait de la concaténation de listes : la complexité est très lourde (vraiment très lourde !) ! *) |
liste_arguments_suivants := !liste_arguments_suivants @ [(argument_suivant ~printP:printP ~liste_piece:liste_piece ~plateau:plateau ~icourant:icourant ~jcourant:jcourant ~piece_choisie:piecex)];
| false ->
myprint myverb ("\tLa piece n'est pas rajoutable.");
();
)
in
List.iter fauxi_ajoute liste_piece;
let fauxi_continue ( liste_piece_suivant, plateau_suivant, i_suivant, j_suivant) =
myprint myverb ("\t###\n\tAppel interne a 'fauxi_continue' avec Indices : icourant="^(string_of_int i_suivant)^" et jcourant="^(string_of_int j_suivant)^" !");
(resoud_naivement_aux ~printP:printP ~liste_piece:liste_piece_suivant ~plateau:plateau_suivant ~icourant:i_suivant ~jcourant:j_suivant);
in
| (** On fait du List.concat : la complexité est très lourde (vraiment très lourde !) ! Je sais que pour améliorer, il faudrait utiliser des listes chainées. *) |
List.concat (List.map fauxi_continue !liste_arguments_suivants);;
ex();;
(** Et enfin la fonction de résolution naive. A adapter après avec l'interface graphique. Pour le moment, on affiche dans la console la solution trouvée (la première de la liste des solutions). Et j'ai interfacé cette fonction avec une procédure plus générale, l'argument 'printP' correspond à la méthode choisie pour afficher le plateau (cela peut etre à l'écran dans la partie graphique avec des couleurs, ou dans la console ici.). *) |
let resoud_naivement ?(printP = print_plateau) (mon_instance:instance) =
myprint Verbeux_textuel ("##############################################################################################");
myprint Verbeux_textuel ("Appel a 'resoud_naivement' avec l'instance suivante :");
if (Verbeux_textuel = Verbeux_textuel) then print_instance mon_instance;
let liste_solutions =
(try (resoud_naivement_aux ~printP:printP ~liste_piece:mon_instance.pi ~plateau:(creer_plateau_vide ~printP:printP mon_instance) ~icourant:0 ~jcourant:0)
with Solution_trouvee_arg(ele) ->
(print_string "\n\nUne solution a été trouvée. La voici :\n";
print_string "###############\n";
printP ele;
print_string "###############";
[ele]; (* On renvoit la solution en plus de l'afficher. *)
)
)
(* (resoud_naivement_aux ~liste_piece:mon_instance.pi ~plateau:(creer_plateau_vide mon_instance) ~icourant:0 ~jcourant:0)*)
in
match liste_solutions with
| [] ->
print_string "\n\nAucune solution n'a été trouvée.\n";
raise Aucune_solution;
| el :: ssl ->
print_string "\n\n\tVoila tout les plateaux renvoyés :";
List.map (fun k -> print_string "\n"; printP k;) (el :: ssl);
print_string ("\n\n\t"^(string_of_int (List.length (el :: ssl)))^" candidats solutions ont été trouvés.");
(try (est_valide_plateau el; el;) with
| Solution_trouvee ->
(print_string "\n\nUne solution a été trouvée. La voici :\n";
printP el;
el; (* On renvoit la solution en plus de l'afficher. *)
)
| Mauvais_tableau ->
(print_string "\n\nLa plateau construit n'est pas structurelement correct.\n Erreur de construction !";
raise Mauvais_tableau;
)
| Erreur_compatibilite_h(i,j) ->
(print_string ("\n\nLa plateau construit n'est pas valide.\n Erreur de compatibilité horizontale aux cases : i="^(string_of_int i)^" et j="^(string_of_int j)^" !");
raise (Erreur_compatibilite_h(i,j));
)
| Erreur_compatibilite_v(i,j) ->
(print_string ("\n\nLa plateau construit n'est pas valide.\n Erreur de compatibilité verticale aux cases : i="^(string_of_int i)^" et j="^(string_of_int j)^" !");
raise (Erreur_compatibilite_v(i,j));
)
);;
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
(*!*)(* ESSAIS *)
| (** Premier essai : une seule piece ! *) |
let instance1 = {
ci = 4;
ni = 1;
mi = 1;
pi = [{b = 3; g = 4; h = 1; d = 2}];
};;
if (!(Sys.interactive)) then print_plateau( resoud_naivement instance1 );;
| (** Second essai : deux pieces ! *) |
let instance2 = {
ci = 4;
ni = 1;
mi = 2;
pi = [{b = 2; g = 4; h = 1; d = 4}; {b = 3; g = 4; h = 2; d = 1}];
};;
if (!(Sys.interactive)) then print_plateau( resoud_naivement instance2 );;
| (** Troisieme essai : deux pieces ! *) |
let instance3 = {
ci = 4;
ni = 1;
mi = 2;
pi = [{b = 3; g = 4; h = 2; d = 1}; {b = 2; g = 4; h = 1; d = 4}];
};;
if (!(Sys.interactive)) then print_plateau( resoud_naivement instance3 );;
| (** Pour permettre de stopper le test suivant. *) |
exception Interuption_clavier;;
| (** Quatrieme test : autant de fois que l'utilisateurs le veut, avec les paramètres qu'il rentre. *) |
let test_resolution () =
print_string "\n################################################################################";
print_string "\n## Tests : résolution de puzzle ! Projet Puzzle. Lilian BESSON (c) 2012 ##";
print_string "\n################################################################################\n";
print_string "\n\tCombien voulez-vous faire d'essais ? Nb=";
let nombre = read_int () in
print_string "\n\tCombien voulez-vous de couleurs différents ? c=";
let my_c = read_int () in
print_string "\n\tCombien voulez-vous de colonnes ? m=";
let my_m = read_int () in
print_string "\n\tCombien voulez-vous de lignes ? n=";
let my_n = read_int () in
print_string "\n\tLes tests vont commencer.";
for k = 1 to nombre do
print_string ("\n\t\tTest numéro "^(string_of_int k)^".");
let instance_courante = (creer_instance_random ~m:my_m ~n:my_n ~c:my_c ()) in
print_string "\n\t\t Instance aléatoire crée :\n";
print_instance instance_courante;
ecriture_instance ~i:instance_courante ~file:("test_resolution_"^(string_of_int k)^".instance");
print_string "\n\t\t Résolution en cour ...";
(try (
let plateau_courant = (resoud_naivement instance_courante) in
print_plateau plateau_courant;
ecriture_plateau ~p:plateau_courant ~file:("test_resolution_"^(string_of_int k)^".plateau");
()
) with
|Aucune_solution -> print_string "\n\t\t/!/ \tErreur Aucune solution !\n";
|Mauvais_tableau -> print_string "\n\t\t/!/ \tErreur Mauvais tableau !\n";
|Erreur_compatibilite_h(_,_) -> print_string "\n\t\t/!/ \tErreur compatibilite h !\n";
|Erreur_compatibilite_v(_,_) -> print_string "\n\t\t/!/ \tErreur compatibilite v !\n";);
(* print_plateau (resoud_naivement instance_courante);*)
print_string "\n\t\t Instance qu'on voulait résoudre :\n";
print_instance instance_courante;
print_string "\n\t\t Voulez-vous continuer ?[O/n]";
if (read_line ()) = "n" then raise Interuption_clavier;
done;
print_string "\nLes test sont finis.";
print_string "\n################################################################################";
print_string "\n## Tests : résolution de puzzle ! Projet Puzzle. Lilian BESSON (c) 2012 ##";
print_string "\n################################################################################\n";;
| (** On lance un test si on est dans le toplevel. *) |
(*if !(Sys.interactive) then (test_resolution ());;*)
print_string "\nPour refaire un test :\ntest_resolution ();;\n";;
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
let lecture_et_resolution file =
print_string ("\nLecture de l'instance enregistrée dans le fichier : "^file);
let mon_instance = (lecture_instance file) in
print_string "\nDébut de la résolution";
try (
let plateau_courant = (resoud_naivement mon_instance) in
print_plateau plateau_courant;
ecriture_plateau ~p:plateau_courant ~file:("solution_"^file);
()
) with
|Aucune_solution -> print_string "\n\t\t/!/ \tErreur Aucune solution !\n";
|Mauvais_tableau -> print_string "\n\t\t/!/ \tErreur Mauvais tableau !\n";
|Erreur_compatibilite_h(_,_) -> print_string "\n\t\t/!/ \tErreur compatibilite h !\n";
|Erreur_compatibilite_v(_,_) -> print_string "\n\t\t/!/ \tErreur compatibilite v !\n";
();;
let tioi = "lecture_et_resolution \"test_resolution_4.instance\";;";;
let ps x = print_string (x^"\n");;
if (!(Sys.interactive)) then ps tioi;;
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
| (** Pour générer une instance aléatoire qui admet une solution. On va en fait générer une solution, puis on la mélangera ! *) |
| (** Supprime une case d'une liste. *) |
let suppri_liste_indice i l =
let liste_sortie = ref [] in
for j = 0 to ((List.length l) - 1) do
if (i <> j) then liste_sortie := !liste_sortie @ [List.nth l j];
done;
!liste_sortie;;
| (** Auxilliaire à la suivante. *) |
let rec auxi_melange_liste ~lnm ~lm =
(* suppri_liste*)
match (List.length lnm) with
| 0 -> lm (* @ [List.nth lnm 0] *);
| _ -> (
let i = Random.int(List.length lnm) in
(auxi_melange_liste ~lnm:(suppri_liste_indice i lnm) ~lm:(lm @ [List.nth lnm i]))
);;
| (** Pour mélanger une liste. *) |
let melange_liste l = auxi_melange_liste ~lnm:l ~lm:[];;
| (** Comme son nom l'indique, pour transformer une matrice en liste, en mélangeant aléatoirement. *) |
let melanger_matrix_to_list ma_matrice () = (melange_liste (list_of_matrix ma_matrice));;
| (** Pour actualiser une couleur courante en fonction de la pièce considérée. *) |
let actualise_couleur ma_couleur k = function
| Some p ->
(match k with
| "bas" -> ma_couleur := p.h;
| "haut" -> ma_couleur := p.b;
| "gauche" -> ma_couleur := p.d;
| "droite" -> ma_couleur := p.g;
| _ -> raise (Invalid_argument "actualise_couleur");
)
| None -> ();;
| (** Pour générer un plateau aléatoire qui soit déjà solution (chaque pièce est bien placée). *) |
let generer_plateau_solution ~n ~m ~c () =
let mon_plateau = {n = n; m = m; c = c; p = (Array.create_matrix m n None); v = false} in
let nouvelle_piece_sous_contrainte ~i ~j ~pl () =
let (b, g, h, d) = ( (ref (couleur_random ~c:c ())), (ref (couleur_random ~c:c ())), (ref (couleur_random ~c:c ())), (ref (couleur_random ~c:c ())) ) in
if (i > 0) then | (** on peut comparer à gauche, *) |
actualise_couleur g "gauche" pl.(i-1).(j);
if (j > 0) then | (** on peut comparer en bas, *) |
actualise_couleur b "bas" pl.(i).(j-1);
if (i < m-1) then | (** on peut comparer à droite, *) |
actualise_couleur d "droite" pl.(i+1).(j);
if (j < n-1) then | (** on peut comparer en haut, *) |
actualise_couleur h "haut" pl.(i).(j+1);
{b = !b; g = !g; d = !d; h = !h};
in
for ii = 0 to (m - 1) do
for jj = 0 to (n - 1) do
mon_plateau.p.(ii).(jj) <- Some (nouvelle_piece_sous_contrainte ~i:ii ~j:jj ~pl:(mon_plateau.p) () );
done;
done;
mon_plateau;;
| (** Pour générer une instance aléatoire qui admette une solution. *) |
let generer_instance_solution ~n ~m ~c () =
{ci = c; ni = n; mi = m; pi = (List.map kill_option2 (melanger_matrix_to_list (generer_plateau_solution ~n:n ~m:m ~c:c ()).p ()))};;
(*--------------------------------------------------------------------------------------------------------------------------------------------- *)
if (!(Sys.interactive)) then ex();;
if (!(Sys.interactive)) then print_string "\n#use \"interface.ml\";;\n";;