Delphi, grille de Sudoku

Salut,

Tu sais ce que c'est un moteur de recherches ? Tu as jamais entendu parler de google ?

Et tu as pas vu qu'il y à un moteur de recherche haut gauche sur developpez ?

En deux secondes, je tape Sudoku Delphi dans la boite recherches de developpez.com, et oh surprise je trouve un code source Sudoku pour Delphi : https://pascalfonteneau.developpez.com/sudoku/

C'est pas beau de vilipender des personnes qui essayent de t'aider...

Ces personnes qui veulent t'aider ne peuvent pas savoir clairement ou tu en est, ton niveau, ta formation, etc, et ce que tu veux précisément si tu n'explique pas en détail...

Par ailleurs quand on est Prof, donner la soluce toute faite est contre productif, on ne sais pas si ce que tu recherche c'est un exercice, ou un hobbie, les personnes du forum ne sont pas des "medium"...

Le but normalement c'est que toi tu apprenne programmer, d'où des liens sur les tutoriels...

Ouh là... c'est que ça commence à dater tout ça !
Je ne sais pas si je l'ai encore, mais c'était en Caml Light, je vais regarder si je le retrouve.

Bon, j'ai mis un peu de temps, mais j'ai réussi à le retrouver !
Le code date de 2007, c'était l'un de mes tout premiers programmes, alors autant dire qu'il est loin d'être parfait...
Je pourrais le corriger, l'améliorer, mettre des commentaires ou indenter mon code, mais je n'ai pas trop de temps alors je le laisse brut comme ça, tel qu'il était dans mes archives ;-)

Pour démarrer le programme, je pense qu'il faut faire sudoku();; mais il y avait d'autres fonctionnalités (notamment sauvegarder la grille) mais je ne sais plus trop comment on fait...

#open "graphics";;
open_graph "";;

let init () =
[|[|[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
	[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];|];
  [|[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];|];
  [|[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];|];
  [|[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];|];
  [|[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];|];
  [|[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];|];
  [|[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];|];
  [|[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];|];
  [|[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];
    [|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];[|0;1;2;3;4;5;6;7;8;9|];|]|];;
    
let grille simple=
let t=ref 3 and p=ref 1 in
if simple then begin clear_graph (); t:=9 ; p:=0 end;
set_color black;
moveto 0 0;
for i=0 to !t do
moveto (!p+270*i/ !t) 0; lineto (!p+270*i/ !t) 270;
done;
for i=0 to !t do
moveto 0 (!p+270*i/ !t); lineto 270 (!p+270*i/ !t);
done;;

let clear_fichier ()=
let canal=open_out "C:/sudo.ini" in
output_byte canal 0;
close_out canal;;

let etat cube=
let e=make_matrix 9 9 0 in
for i=0 to 8 do for j=0 to 8 do
e.(i).(j)<-cube.(i).(j).(0)
done; done; e;;

let sauvegarde fin cube=
let s=ref "sudo.ini" in
if fin then s:="sudo2.ini";
let e=etat cube in
let canal=open_out ("C:/"^(!s)) in
for i=0 to 8 do for j=0 to 8 do
if cube.(i).(j).(0)<>0 then begin
output_byte canal i;
output_byte canal j;
output_byte canal (cube.(i).(j).(0)); end;
done; done;
close_out canal;;

let début fin=
let s=ref "sudo.ini" in
if fin then s:="sudo2.ini";
let l=ref [] in
begin try
let canal=open_in ("C:/"^(!s)) in
if fin then set_color black else set_color red;
while true do
let a=input_byte canal in let b=input_byte canal in let c=input_byte canal in 
l:= !l@[(a,b,c)]; moveto (30*a+11) (30*b+5);
draw_string (string_of_int c);
done;
close_in canal;
with |End_of_file -> ();
	 |sys__Sys_error a -> clear_fichier ();
end;
!l;;

let rec modif t=
grille false;
let s=ref t in
set_color black;
moveto 0 350;
draw_string "pour effacer la grille appuyer sur S";
moveto 0 300;
draw_string "cliquer sur une case pour en modifier la valeur ";
moveto 0 275;
draw_string "pour calculer appuyer sur la barre d'espace ";
let continue1=ref true in
while !continue1 do
let e=wait_next_event [Button_down; Key_pressed] in
if e.button then begin
let i=e.mouse_x/30 and j=e.mouse_y/30 in
if i<9 & j<9 then begin
continue1:=false;
set_color green;
fill_rect (30*i) (30*j) 30 30;
set_color black;
moveto 0 350;
draw_string "                                     ";
moveto 0 300;
draw_string "entrer une valeur de case (0 pour effacer)      ";
moveto 0 275;
draw_string "                                            ";
let continue2=ref true in
while !continue2 do
let f=wait_next_event [Key_pressed] in
let n=(int_of_char f.key-48) in
if n>(-1) & n<10 then begin
continue2:=false;
set_color white;
fill_rect (30*i) (30*j) 30 30;
set_color black;
moveto (30*i) (30*j+30);
lineto (30*i) (30*j);
lineto (30*i+30) (30*j);
moveto (30*i+11) (30*j+5);
set_color red;
if n>0 then draw_string (string_of_int n);
s:=modif (t@[(i,j,n)]);
end; done; end; end;
if e.keypressed & e.key=' ' then begin s:=t; continue1:=false; end;
if e.keypressed & e.key='s' then begin 
clear_fichier (); grille true; grille false;
end; done;
!s;;

let initiation t =
let cube=init () in
let n=list_length t in
let x=ref t in
for k=0 to n-1 do
match hd(!x) with
|(a,b,c)-> if c=0
then cube.(a).(b)<-[|0;1;2;3;4;5;6;7;8;9|]
else cube.(a).(b)<-[|c;0;0;0;0;0;0;0;0;0|];
x:=tl(!x); done; cube;;

let voisins cube v w x y =
let m=cube.(v).(w).(0) and n=cube.(x).(y).(0) in
if m=0 then cube.(v).(w).(n)<-0;
if n=0 then cube.(x).(y).(m)<-0;;

let recherche_ligne cube l=
for i=0 to 8 do for j=0 to 8 do
voisins cube l i l j;
done; done;;

let recherche_colonne cube c=
for i=0 to 8 do for j=0 to 8 do
voisins cube i c j c;
done; done;;

let recherche_région cube m n=
for i=0 to 2 do for j=0 to 2 do
for k=0 to 2 do for l=0 to 2 do
voisins cube (3*m+i) (3*n+j) (3*m+k) (3*n+l);
done; done; done; done;;

let recherche_combi cube l c n=
let l1=ref false and l2=ref false and l3=ref false and L=ref 0 in
let c1=ref false and c2=ref false and c3=ref false and C=ref 0 in
for k=0 to 8 do
if cube.(3*l).(k).(n)=0 then l1:=true;
if cube.(3*l+1).(k).(n)=0 then l2:=true;
if cube.(3*l+2).(k).(n)=0 then l3:=true;
if cube.(k).(3*c).(n)=0 then c1:=true;
if cube.(k).(3*c+1).(n)=0 then c2:=true;
if cube.(k).(3*c+2).(n)=0 then c3:=true;
done;
begin
match (!l1,!l2,!l3) with 
|(true,true,false)->L:=3
|(true,false,true)->L:=2
|(false,true,true)->L:=1
|_->()
end;
begin
match (!c1,!c2,!c3) with 
|(true,true,false)->C:=3
|(true,false,true)->C:=2
|(false,true,true)->C:=1
|_->()
end;
if !L<>0 & !C<>0
then cube.(3*l+ !L-1).(3*c+ !C-1)<-[|n;0;0;0;0;0;0;0;0;0|];;

let rec mini l= match l with
|[]-> 9
|0::q ->(mini q)
|a::q -> min a (mini q);;

let rec maxi l= match l with
|[]-> 0
|a::q -> max a (maxi q);;

let actualiser cube=
let l=ref [] and n=ref 0 in
for i=0 to 8 do
for j=0 to 8 do
l:=list_of_vect cube.(i).(j);
if (mini !l)=(maxi !l) & hd(!l)=0 then begin
cube.(i).(j)<-[|(mini !l);0;0;0;0;0;0;0;0;0|];
set_color blue;
moveto (30*i+11) (30*j+5);
draw_string (string_of_int (mini !l));
end; done; done;;

let global fin=
grille true;
let cube=initiation (modif (début fin)) in
if not fin then (sauvegarde false cube);
let mémoire=ref [|[||]|] in
while !mémoire<>(etat cube) do
for k=0 to 8 do
mémoire:=etat cube;
recherche_colonne cube k;
recherche_ligne cube k;
recherche_région cube (k/3) (k-3*(k/3));
done;
(*
for l=0 to 2 do
for c=0 to 2 do
for n=1 to 9 do
recherche_combi cube l c n
done; done; done;
*)
actualiser cube;
done;
sauvegarde true cube;;
let sudoku ()=global false;;
let continue ()=global true;;

exception stop;;

let vérif ()=
let etat=make_matrix 9 9 0 in
begin try 
let canal=open_in "C:/sudo2.ini" in
while true do
let i=input_byte canal in
let j=input_byte canal in
let k=input_byte canal in
etat.(i).(j)<-k;
done;
close_in canal;
with End_of_file->();
end;
try
let s1=ref 0 and s2=ref 0 in
for i=0 to 8 do
for j=0 to 8 do
if etat.(i).(j)=0 then raise (stop);
s1:= !s1+etat.(i).(j);
s2:= !s2+etat.(j).(i);
done;
if (!s1<>45)||(!s2<>45) then raise(stop);
s1:=0; s2:=0;
done; true;
with stop-> false;;

Quelques remarques :

En publiant le code, il y a eu un bug, ce qui fait que le code ne marche pas...
À la fin de "modif" il est écrit e.key=' ' et e.key='s' mais il s'agit bien ici de caractères donc il faut encadrer les valeurs avec des accents graves [Alt Gr+7] et non pas avec des apostrophes [Alt Gr+4]

Sinon, il y a bien une sauvegarde de la grille mais elle est automatique dans les fichiers "C:\sudo.ini" avant calcul, et "C:\sudo2.ini" après calcul, mais le code tel qu'il est là ne permet pas faire de sauvegarde manuel.
Donc au final seul sudoku();; est à utiliser.