(* Master Mind en Caml
   l'ordinateur cherche à deviner un code (sans tricher !)
   Algorithme bête : on teste tout. on ordonne tous les codes (ici par ordre lexicographique)
   et on les propose un par un, en ne proposant jamais les codes qui, s'ils étaient le code secret
   recherché, donneraient une contradiction avec les coups précédents (cet algorithme ne nécessite
   pas d'autre mémoire que celle nécessaire à conserver les coups déjà joués; par contre, il
   peut être très lent). à noter : l'algo est facilement implémentable en assembleur (manipulation
   de tableaux d'entiers).

   amélioration possible : au lieu de proposer le premier code non contradictoire, on pourrait
   chercher un code discriminatoire, c'est à dire dont la réponse donnerait le plus d'informations
   possible (informations = 1/(nombre de coups non contradictoires avec ceux déjà joués)).
   en début de partie, on cherche à obtenir des renseignements, et non à trouver tout de suite
   la solution.

   Alain FRISCH
   alfie2@mygale.org
   yala.friscg@wanadoo.fr

   http://www.mygale.org/05/alfie2

   le 29 mai 1998
*)

#open "random";;
#open "printf";;

(*
  Représentation des données :
    couleur : entier de 0 à nbcoul-1
    code    : tableau de "nbtrous" couleurs
    resultat: couple (bien placés / mal placés)
*)

(* Dimensions *)
let nbcoul  = 5;;
let nbtrous = 7;;

(* Affichage *)
let affiche_code code =
 for i=0 to (nbtrous-1) do
  print_int code.(i);
  print_string " ";
 done;;

let affiche_res res =
 printf " blancs:%u noirs:%u" (fst res) (snd res);;

let rec affiche_jeu = function
 | [] -> ()
 | (c,r)::q -> affiche_code c; affiche_res r; print_newline(); affiche_jeu q;;

(* Routines utilitaires *)

let iter cond vrai faux ideb ifin init =
  let rec aux i val =
   if i=ifin then val
   else
    aux (i+1) (if (cond i) then (vrai i val ) else (faux i val))
  in aux ideb init;;

let incr_cell v i = v.(i)<-v.(i)+1;;
let decr_cell v i = if v.(i)=0 then 0 else (v.(i)<-v.(i)-1;1);;

let init_vect n i f =
 let v = make_vect n i
 in
  for k=0 to (n-1) do
   v.(k)<-(f k)
  done;
  v;;


(* Algorithme à proprement parler *)

let evalue_res secret propos =
 let reste = make_vect nbcoul 0 in
 let ok i = secret.(i)=propos.(i) in
 let bien_placés =
  iter ok (fun i n -> n+1) (fun i n -> incr_cell reste secret.(i); n) 0 nbtrous 0
 in
 let mal_placés =
  iter ok (fun i n -> n) (fun i n -> n+(decr_cell reste propos.(i))) 0 nbtrous 0
 in
  (bien_placés, mal_placés);;

let code_suivant code =
 let rec aux i =
  if code.(i)<(nbcoul-1)
   then incr_cell code i
   else (code.(i)<-0; aux (i+1))
 in
  aux 0;;

let verifie_coherence secret =
 let rec aux = function
  | [] -> true
  | (prop,res)::reste -> if (evalue_res secret prop)<>res then false else aux reste
 in aux;;

let code_coherent_suivant jeu code =
 let rec aux () = if not (verifie_coherence code jeu) then (code_suivant code; aux())
 in aux ();;

let jouer evaluation =
 let code = make_vect nbtrous 0
 in
 let rec coups jeu =
  code_coherent_suivant jeu code;
  let res=evaluation code
  in
  let j=(copy_vect code,res)::jeu
  in
   if res<>(nbtrous,0) then (code_suivant code; coups j) else j
 in
  coups [];;

(* exemple : l'ordinateur choisit un code aléatoire *)

let jeu_aleat () =
 let secret = init_vect nbtrous 0 (fun i-> int nbcoul)
 in
  affiche_jeu (jouer (evalue_res secret));;

jeu_aleat ();;