zwyx
Messages postés146Date d'inscriptionjeudi 22 novembre 2007StatutMembreDernière intervention21 mars 2016
-
20 déc. 2007 à 11:00
zwyx
Messages postés146Date d'inscriptionjeudi 22 novembre 2007StatutMembreDernière intervention21 mars 2016
-
2 janv. 2008 à 16:57
Bonjour à tous,
Pour ceux qui aiment bien se creuser la tête sur de l'algorithmie... J'ai écrit un code permettant de résoude une grille de sudoku récursivement. J'ai simplement adapté l'exellente méthode de backtracking écrite en C par Bernard Helmstetter. Tout semble correctement écrit, sauf qu'à l'exécution, mon programme se contente, dans le meilleur des cas, de ne remplir que quelques cases. J'ai beau vérifier le code dans tous les sens, je ne trouve pas l'erreur.
Alors je poste le source ci-dessous, au cas ou une âme charitable aurait le temps et la patience d'étudier ça. Je précise que je travaille sous Delphi6, et que le fichier Unit1.dfm correspondant est composé de:
- sgrGrid: un TStringGrid de 9 par 9 avec aucune ligne ou colonne figée
- btnSolve: un TBitBtn qui exécute la procédure btnSolveClick sur l'évènement OnClick
- btnEmpty: un TBitBtn qui exécute la procédure btnEmptyClick sur l'évènement OnClick
- lblAdvance: un TLabel pas indispensable, qui affiche à chaque nouvel appel à BackTrack, le nombre d'appels récursifs.
{-------------------------------------------------------}
{ }
{ petite application permettant de résoudre un sudoku }
{ ~ }
{ adaptation de la méthode backtracking avec propation }
{ des contraintes, écrite en C par Bernard Helmstetter }
{ ~ }
{ copyleft zwyx, décembre 2007 }
{ }
{-------------------------------------------------------}
// fenêtre de l'application
TForm1 = class(TForm)
sgrGrid: TStringGrid;
btnSolve: TBitBtn;
lblAdvance: TLabel;
btnEmpty: TBitBtn;
procedure FormShow(Sender: TObject);
procedure btnSolveClick(Sender: TObject);
procedure btnEmptyClick(Sender: TObject);
private
SudokuGrid: array [1..81] of Byte; // tableau unidimensionnel représentant la grille
PossibleValues: array [1..81] of array [0..9] of Boolean; // valeurs possibles pour chaque case de la grille
NbPossibleValues: array [1..81] of Byte; // nombre de valeurs possibles pour chaque case
NodesCount: Word; // compteur de noeuds
public
procedure Plot(Msg: ShortString);
procedure ShowGrid();
procedure InitPossibleValues();
procedure NarrowPossibleValues(index: Byte);
procedure BackTrack();
end;
{-------------------------------------------------------}
{--------------< gestion des évênements >---------------}
{-------------------------------------------------------}
{-------------------------------------------------------}
// déclenché à l'apparition de la fenêtre du programme
procedure TForm1.FormShow(Sender: TObject);
begin
Plot(' S x'+' u '+' D y '+' s o '+' o K '+' l u '+' w v '+' e '+'z r ');
end;
{-------------------------------------------------------}
// quand on clique sur le bouton résoudre
procedure TForm1.btnSolveClick(Sender: TObject);
var
iCol, iRow: Byte;
begin
// enregistrement des chiffres saisis par l'utilisateur
for iCol := 1 to 9 do
begin
for iRow := 1 to 9 do
begin
if (StrToIntDef(sgrGrid.Cells[iCol-1, iRow-1], -1) >= 1) and (StrToIntDef(sgrGrid.Cells[iCol-1, iRow-1], -1) <= 9) then
SudokuGrid[(iCol-1)+(9*(iRow-1))+1] := StrToInt(sgrGrid.Cells[iCol-1, iRow-1])
else
SudokuGrid[(iCol-1)+(9*(iRow-1))+1] := UNKNOWN;
end; // for iRow
end; // for iCol
ShowGrid; // affiche les chiffres saisis précédés d'un espace pour centrer dans les cases
InitPossibleValues; // initialise les valeurs possibles pour chaque case vide
// premier appel à la fonction qui résoud le puzzle récursivement
NodesCount := 0;
BackTrack;
end;
{-------------------------------------------------------}
// quand on clique sur le bouton vider
procedure TForm1.btnEmptyClick(Sender: TObject);
var
i: Byte;
begin
Form1.Plot(' '); // il y a 81 espaces à afficher, 1 par case
for i := 1 to 81 do
SudokuGrid[i] := UNKNOWN;
end;
{-------------------------------------------------------}
// affiche dans les 81 cases les 81 caractères passés en paramètres
procedure TForm1.Plot(Msg: ShortString);
var
i: Byte;
begin
i := 1;
while Msg[i]<>#0 do
begin
sgrGrid.Cells[(i-1) mod 9, (i-1) div 9] := #32+Msg[i]; // un espace pour centrer dans la case
Inc(i);
end; // while
end;
{-------------------------------------------------------}
// affiche la grille complètée par les valeurs trouvées
procedure TForm1.ShowGrid();
var
i: Byte;
begin
for i := 1 to 81 do
if SudokuGrid[i]<>UNKNOWN then
sgrGrid.Cells[(i-1) mod 9, (i-1) div 9] := #32+IntToStr(SudokuGrid[i]);
end;
{-------------------------------------------------------}
// pour chaque case, assigne les valeurs possible an fonction de la grille saisie
procedure TForm1.InitPossibleValues();
var
iPos, iVal: Byte;
begin
{-------------------------------------------------------}
// affecte toutes les valeurs possibles
for iPos := 1 to 81 do
begin
NbPossibleValues[iPos] := 9;
for iVal := 1 to 9 do
PossibleValues[iPos, iVal] := True;
end; // for iPos
{-------------------------------------------------------}
// restreint d'après les valeurs présentes dans la grille
for iPos := 1 to 81 do
if SudokuGrid[iPos]<>UNKNOWN then
NarrowPossibleValues(iPos);
end;
{-------------------------------------------------------}
// restreint les ensembles des valeurs possibles d'après celle contenue dans la case d'indice index
procedure TForm1.NarrowPossibleValues(index: Byte);
var
Col, Row, BoxCol, BoxRow: Byte;
i, iCol, iRow: Byte;
begin
{-------------------------------------------------------}
// calcul des position ligne, colonne, et carré de 3x3 cases
Col := ((index-1)mod 9)+1;
Row := ((index-1)div 9)+1;
BoxCol := ((Col-1)div 3)+1;
BoxRow := ((Row-1)div 3)+1;
{-------------------------------------------------------}
// contrainte sur la colonne contenant la case index
for iRow := 1 to 9 do
begin
i := (iRow-1)*9 +1 +Col;
if PossibleValues[i, SudokuGrid[index]] then
begin
PossibleValues[i, SudokuGrid[index]] := False;
Dec(NbPossibleValues[i]);
end; // if
end; // for iRaw
{-------------------------------------------------------}
// contrainte sur la ligne contenant la case index
for iCol := 1 to 9 do
begin
i := (Row-1)*9 +1 +iCol;
if PossibleValues[i, SudokuGrid[index]] then
begin
PossibleValues[i, SudokuGrid[index]] := False;
Dec(NbPossibleValues[i]);
end; // if
end; // for iRaw
{-------------------------------------------------------}
// contrainte sur le carré de 3x3 cases contenant la case index
for iRow := 1 to 3 do
begin
for iCol := 1 to 3 do
begin
i := ((BoxRow-1)*3 + iRow-1)*9 +((BoxCol-1)*3 + iCol-1) +1;
if PossibleValues[i, SudokuGrid[index]] then
begin
PossibleValues[i, SudokuGrid[index]] := False;
Dec(NbPossibleValues[i]);
end; // if
end; // for iCol
end; // for iRow
end;
{-------------------------------------------------------}
// appelée récursivement, cette méthode calcule petit à petit la solution du puzzle
procedure TForm1.BackTrack();
var
index: Byte; // indice utilisé pour parcourir toutes les cases de la grille
UnknownBox: ShortInt; // indice d'une case encore vide, vaut -1 si elles sont toutes pleines
MinPossibleValues: Byte; // nombre minimal de valeurs possibles parim toutes les cases de la grille
PossibleValues2: array [1..81] of array [0..9] of Boolean; // valeurs possibles pour chaque case de la grille
NbPossibleValues2: array [1..81] of Byte; // nombre de valeurs possibles pour chaque case
begin
{-------------------------------------------------------}
// initialisation des variables
UnknownBox := -1;
MinPossibleValues := 10;
// cherche la case ayant le moins de valeurs possibles, soit le plus de contraintes
for index := 1 to 81 do
if (SudokuGrid[index]=UNKNOWN) and (NbPossibleValues[index]<MinPossibleValues) then
begin
UnknownBox := index;
MinPossibleValues := NbPossibleValues[index];
end; // if
{-------------------------------------------------------}
// recherche s'il existe au moins une case encore vide
if UnknownBox= -1 then
begin
ShowGrid;
Exit;
end; // if
{-------------------------------------------------------}
// sinon, on réitère un appel à cette même procédure
Inc(NodesCount);
for index := 1 to 9 do
begin
if not(PossibleValues[UnknownBox, index]) then
Continue;
SudokuGrid[UnknownBox] := index;
Form1.lblAdvance.Caption := 'itérat° '+IntToStr(NodesCount); // affiche le nombre d'appel à cette procédure
// sauvegarde d'état actuel pour le rétablir après l'appel récursif
Move(PossibleValues, PossibleValues2, SizeOf(PossibleValues)); // copie PossibleValues dans PossibleValues2
Move(NbPossibleValues, NbPossibleValues2, SizeOf(NbPossibleValues)); // copie NbPossibleValues dans NbPossibleValues2
NarrowPossibleValues(UnknownBox); // restreint les valeurs possibles
BackTrack; // appel récursif
Move(PossibleValues2, PossibleValues, SizeOf(PossibleValues2)); // copie PossibleValues2 dans PossibleValues
Move(NbPossibleValues2, NbPossibleValues, SizeOf(NbPossibleValues2)); // copie NbPossibleValues_2 dans NbPossibleValues
end; // for SudokuGrid[UnkonwnBox]
SudokuGrid[UnknownBox] := UNKNOWN;
end;
{-------------------------------------------------------}
{ fin du programme }
{-------------------------------------------------------}
WhiteHippo
Messages postés1154Date d'inscriptionsamedi 14 août 2004StatutMembreDernière intervention 5 avril 20123 21 déc. 2007 à 15:39
zwyx
Le backtracking se fait par l'utilisation de la pile. A chaque nouvel appel de la procedure, les parametres utilisés par celle ci (iValue en priorité) sont sauvegardés sur la pile. Ce qui fait, qu'à chaque retour (sortie de la procedure), les anciennes valeurs sont restaurées de la pile. Ceci permet de reprendre avec la dernière iValeur utilisée.
Dans ton cas, tu utilises des variables qui ne sont pas sauvegardées sur la pile puisqu'elles ne sont pas déclarées à l'interieur de la procédure. Donc si par exemple tu appelles 3 fois ta procedure, tu n'auras pas le même comportement si les variables sont déclarées à l'intérieur ou à l'estérieur de ta procédure.
P.S. Attention, cependant, si tu déclares tes variables dans la procedure à ne pas avoir de débordement de pile, du fait de la taille de données.
Cordialement.
<hr />"L'imagination est plus importante que le savoir." Albert Einstein
WhiteHippo
Messages postés1154Date d'inscriptionsamedi 14 août 2004StatutMembreDernière intervention 5 avril 20123 20 déc. 2007 à 23:35
Bonsoir
zwyx, ton programme me semblait bien compliqué ! J'en ai fais une version simplifiée de façon rapide donc pas de garantie "bug free" ni de commentaires ni de tests approfondis, ni de code optimisé, etc, etc... Ce programme est juste là pour t'indiquer une voie possible à suivre.
var
i,j:integer;
begin
for i:=0 to 8 do
for j:=0 to 8 do
begin
if GRILLE_2[j][i+1]='.' then sgrGrid.Cells[i,j]:=''
else sgrGrid.Cells[i,j]:=GRILLE_2[j][i+1];
end ;
end;
function TForm1.CheckConstraints(ACol,Arow:Integer):boolean;
var
BoxCol, BoxRow: Byte;
iCol, iRow: Byte;
begin
Result := false ;
BoxCol := 3 * ( ACol div 3 ) ;
BoxRow := 3 * ( ARow div 3 ) ;
for iRow := 0 to 8 do
if (iRow<>ARow) and ( sgrGrid.Cells[ACol,ARow]=sgrGrid.Cells[ACol,iRow]) then Exit ;
for iCol := 0 to 8 do
if (iCol<>ACol) and ( sgrGrid.Cells[ACol,ARow]=sgrGrid.Cells[iCol,ARow]) then Exit ;
for iRow := BoxRow to BoxRow+2 do
for iCol := BoxCol to BoxCol+2 do
if ( (iRow<>ARow) or (iCol<>ACol)) and ( sgrGrid.Cells[ACol,ARow]=sgrGrid.Cells[iCol,iRow]) then Exit ;
Result := TRUE ;
end;
procedure TForm1.BackTrack(Acol,ARow:Integer);
var
Value: Integer;
begin
if ( Arow=9) then
begin
Found:=true ;
Exit ;
end ;
if (sgrGrid.Cells[Acol,ARow]<>'') then
begin
if (ACol<8) then backtrack(Acol+1,ARow)
else if (ARow<=8) then backtrack(0,ARow+1) ;
if FOund then Exit ;
end ;
inc(NodesCount);
lblAdvance.caption := inttostr(NodesCount);
for Value := 1 to 9 do
begin
sgrGrid.Cells[Acol,ARow]:=InttoStr(Value);
Application.ProcessMessages ;
if ( CheckConstraints(ACol,Arow) ) then
begin
if (ACol<8) then backtrack(Acol+1,ARow)
else if (ARow<=8) then backtrack(0,ARow+1) ;
if Found then Exit ;
end ;
end ;
sgrGrid.Cells[Acol,ARow]:='';
end;
end.
Cordialement. <hr />"L'imagination est plus importante que le savoir." Albert Einstein
zwyx
Messages postés146Date d'inscriptionjeudi 22 novembre 2007StatutMembreDernière intervention21 mars 2016 21 déc. 2007 à 14:12
Merci beaucoup WhiteHippo, de m'avoir donné une piste aussi vite.
J'ai en effet vu que ma procédure NarrowPossibleValues manquait de clarté au niveau du calcul des indices des cases de la même région (ligne, colonne, ou carré de 3x3) que celle passée en argument. Je l'ai donc ré-écrite plus proprement.
C'est vrai que j'ai un tableau unidimensionnel [1..81] au lieu d'un double [1..9][1..9], mais une fois les formules mathématiques trouvées pour passer d'un modèle à l'autre, c'est tout aussi pratique.
Maintenant, le code semble plus que jamais correcte, mais à l'éxécution, il ne me trouve que les chiffres de la première ligne. Ensuite, il ne semble plus y avoir d'appel récursif à la méthode BackTrack.
Je poste ci-dessous juste la méthode qui élimine dans les cases d'une même région les valeurs interdites. En attendant, si je peux aider pour le tri des vieux missiles russes tout rouillés...
____________________________________________________
/ procedure TForm1.NarrowPossibleValues(Index: Byte) \______________________
// restreint les ensembles des valeurs possibles d'après celle contenue dans la case d'indice index
procedure TForm1.NarrowPossibleValues(Index: Byte);
var
Col, Row, BoxCol, BoxRow: Byte; // positions de la case index calculées
iIndex, iCol, iRow: Byte; // variables de boucles for
IndexTemp, BoxColTemp, BoxRowTemp: Byte; // positions temporaires, recalculées à chaque passage dans une boucle
begin
{-------------------------------------------------------}
// calcul des positions ligne, colonne et carré 3x3 cases d'après l'argument index
Col := ((Index-1)mod 9)+1;
Row := ((Index-1)div 9)+1;
BoxCol := ((Col-1)div 3)+1;
BoxRow := ((Row-1)div 3)+1;
{-------------------------------------------------------}
// contraintes sur la colonne contenant la case index
for iRow := 1 to 9 do // boucle sur les lignes
begin
IndexTemp := (iRow-1)*9 +Col; // indice (1..81) recalculé en fonction de iRow qui varie
if PossibleValues[IndexTemp, SudokuGrid[Index]] then // si la valeur insérée est autorisée dans une autre case de la région
begin
PossibleValues[IndexTemp, SudokuGrid[Index]] := false; // on l'interdit dans cette case
Dec(NbPossibleValues[IndexTemp]); // le nombre de valeurs encore autorisées dans cette autre case de la région diminue
end; // if
end; // for iRow
{-------------------------------------------------------}
// contraintes sur la ligne contenant la case index
for iCol := 1 to 9 do // boucle sur les colonnes
begin
IndexTemp := (Row-1)*9 +iCol; // indice (1..81) recalculé en fonction de iCol qui varie
if PossibleValues[IndexTemp, SudokuGrid[Index]] then // si la valeur insérée est autorisée dans une autre case de la région
begin
PossibleValues[IndexTemp, SudokuGrid[Index]] := false; // on l'interdit dans cette case
Dec(NbPossibleValues[IndexTemp]); // le nombre de valeurs encore autorisées dans cette autre case de la région diminue
end; // if
end; // for iCol
{-------------------------------------------------------}
// contraintes sur le carré de 3x3 cases contenant la case index
for iIndex := 1 to 81 do // pour chaque case, on calcul si elle est dans le même carré
begin
BoxColTemp := 1+(((iIndex-1)mod 9)div 3); // indice horizontal (1..3) du carré 3x3 recalculé
BoxRowTemp := 1+(((iIndex-1)div 9)div 3); // indice vertical (1..3) du carré 3x3 recalculé
if (BoxColTemp=BoxCol) and (BoxRowTemp=BoxRow) then // si on est dans le même carré de 3x3 case que la case modifiée
begin
if PossibleValues[iIndex, SudokuGrid[Index]] then // si la valeur insérée est autorisée dans une autre case de la région
begin
PossibleValues[iIndex, SudokuGrid[Index]] := false; // on l'interdit dans cette case
Dec(NbPossibleValues[iIndex]); // le nombre de valeurs encore autorisées dans cette autre case de la région diminue
end; // if
end; // if
end; // for iIndex
end;
WhiteHippo
Messages postés1154Date d'inscriptionsamedi 14 août 2004StatutMembreDernière intervention 5 avril 20123 21 déc. 2007 à 14:39
"Maintenant, le code semble plus que jamais correcte, mais à
l'éxécution, il ne me trouve que les chiffres de la première ligne.
Ensuite, il ne semble plus y avoir d'appel récursif à la méthode
BackTrack."
Ne le prends pas mal zwyx, mais j'ai eu beaucoup de mal à relire ton
programme, ce qui suppose que soit les médocs m'ont ramollis les
neurones, soit c'est loin d'etre clair. Les deux étant sans doutes
vrais, c'est pour ça que j'ai écrit un nouveau programme.
Tu utilises une procedure de backtracking mais à laquelle tu ne passes aucun parametres !! Comment peux tu alors revenir en arrière dans ton traitement ?
P.S. Je te conseillerais donc vivement d'analyser le fonctionnement de mon programme et/ou de repartir de lui en le modifiant selon tes besoins (ajout de ta SudokuGrid, ...)
Cordialement.
<hr />"L'imagination est plus importante que le savoir." Albert Einstein
zwyx
Messages postés146Date d'inscriptionjeudi 22 novembre 2007StatutMembreDernière intervention21 mars 2016 21 déc. 2007 à 15:03
Je comprends ta remarque. J'ai du mal à faire simple quand je code. Mais c'est normal que ça me paraisse clair, puisque je suis dedans depuis le début. Cela dit, je conçois que ceux qui lisent le source voient du charabia. Enfin, je me plaîs à penser que c'est écrit proprement. En tout cas, merci pour ton aide.
Cependant, je pensais que ma méthode ne posait aucun problème pour revenir en arrière dans le traitement, grâce à
Move(PossibleValues, PossibleValues2, SizeOf(PossibleValues));
Move(NbPossibleValues, NbPossibleValues2, SizeOf(NbPossibleValues));
NarrowPossibleValues(UnknownBox); // restreint les valeurs possibles
BackTrack; // appel récursif
Move(PossibleValues2, PossibleValues, SizeOf(PossibleValues2));
Move(NbPossibleValues2, NbPossibleValues, SizeOf(NbPossibleValues2));
Je sauvegarde la situation actuelle avant de faire un appel récursif. En sortie de cet appel, je restaure la configuration initiale gardée en mémoire.
Mais je me trompe peut-être.
zwyx
Messages postés146Date d'inscriptionjeudi 22 novembre 2007StatutMembreDernière intervention21 mars 2016 21 déc. 2007 à 15:53
Merci pour ce petit éclaircissement.
En effet, je n'avais pas pensé que mes variables de sauvegarde, déclarées en local dans la fonction, ne seront pas conservée.
Ceci explique certainement pourquoi l'algorithme s'arrête de tourner avant que la grille ne soit complétée. N'y a-t-il pas une autre fonction qui pourrait remplacer mon
Move(const Source; var Dest; Count: Integer)
et qui empilerait la situation courante de manière à pouvoir la restaurer plus tard ?
WhiteHippo
Messages postés1154Date d'inscriptionsamedi 14 août 2004StatutMembreDernière intervention 5 avril 20123 21 déc. 2007 à 16:29
"N'y a-t-il pas une autre fonction qui pourrait remplacer mon
Move(const Source; var Dest; Count: Integer)
et qui empilerait la situation courante de manière à pouvoir la restaurer plus tard ?"
Non, comme dis precedemment, soit tu les mets dans la procedure, soit tu crées un objet TPile pour gérer toi même l'empilage et le dépilage de tes valeurs.
P.S. Si tu insistes, tu peux toujours utiliser mon bout de programme
Cordialement.
<hr />"L'imagination est plus importante que le savoir." Albert Einstein
zwyx
Messages postés146Date d'inscriptionjeudi 22 novembre 2007StatutMembreDernière intervention21 mars 2016 30 déc. 2007 à 15:35
Et bien en ce moment, je profite fêtes avec la famille et les amis. Mais dès la rentrée, je m'y remets, promis.
Certes, ton code marche parfaitement, et je t'en remercie, mais le copier-coller me paraît être une solution trop facile. Comme je débute, je préfère essayer par moi-même, ça me permets d'apprendre. Donc, je pense que je vais essayer de construire une TPile, ça m'apprendra une nouvelle technique.
Si cette étape ne me permets pas de inir ce ridicule programme, je prendrai ta solution.
zwyx
Messages postés146Date d'inscriptionjeudi 22 novembre 2007StatutMembreDernière intervention21 mars 2016 2 janv. 2008 à 16:57
Me revoila ! A peine la rentrée et je ne peux m'empêcher de remettre le nez dans ce code.
J'ai commencé par construire ma TPile, alors que je me suis aperçu qu'un composant similaire existait déjà: TStack. Le problème, c'est que TStack empile des pointeurs, alors que mes variables sont des tableaux statiques.
J'allais donc finalement m'avouer vaincu et copier ta solution, quand j'eus une idée toute simple (et pas du tout élégante, mais bon...). J'ai ajouté deux tableaux dynamiques qui jouent le rôle de pile LIFO. C'est en effet pas très élégant puisque je décale à chaque fois toutes les valeurs vers la droite pour empiler, ou vers la gauche pour dépiler. Mais ça marche du tonnerre.
La solution s'affiche presque instantanément, sauf la case 'A2' (touché-coulé) qui reste vide, malgré que mon tableau connaisse bien les 81 valeurs à afficher.
Cela-dit, voici le code opérationnel, si on néglige le mystère de la case fantôme et les noms de variables qui sont complètement imbuvables.
Merci beaucoup pour ta précieuse aide WhiteHippo.
{-------------------------------------------------------}
{ }
{ petite application permettant de résoudre un sudoku }
{ ~ }
{ adaptation de la méthode backtracking avec propation }
{ des contraintes, écrite en C par Bernard Helmstetter }
{ ~ }
{ copyleft zwyx, décembre 2007 }
{ }
{-------------------------------------------------------}
// fenêtre de l'application
TForm1 = class(TForm)
sgrGrid: TStringGrid;
btnSolve: TBitBtn;
lblAdvance: TLabel;
btnEmpty: TBitBtn;
procedure FormShow(Sender: TObject);
procedure btnSolveClick(Sender: TObject);
procedure btnEmptyClick(Sender: TObject);
private
SudokuGrid: array [1..81] of Byte; // tableau unidimensionnel représentant la grille
PossibleValues: array [1..81] of array [0..9] of Boolean; // valeurs possibles pour chaque case de la grille
NbPossibleValues: array [1..81] of Byte; // nombre de valeurs possibles pour chaque case
PossValStack: array of Boolean; // pile pour sauvegarder PossibleValues avant l'appel récursif
NbPossValStack: array of Byte; // pile pour sauvegarder NbPossibleValues avant l'appel récursif
NodesCount: Word; // compteur de noeuds dans le parcours de graphe
public
procedure Plot(Msg: ShortString);
procedure ShowGrid();
procedure InitPossibleValues();
procedure NarrowPossibleValues(Index: Byte);
procedure BackTrack();
end;
{-------------------------------------------------------}
{--------------< gestion des évênements >---------------}
{-------------------------------------------------------}
{-------------------------------------------------------}
// déclenché à l'apparition de la fenêtre du programme
procedure TForm1.FormShow(Sender: TObject);
begin
Plot(' S x'+' u '+' D y '+' s o '+' o K '+' l u '+' w v '+' e '+'z r ');
end;
{-------------------------------------------------------}
// quand on clique sur le bouton résoudre
procedure TForm1.btnSolveClick(Sender: TObject);
var
iCol, iRow: Byte;
begin
// enregistrement des chiffres saisis par l'utilisateur
for iCol := 1 to 9 do
begin
for iRow := 1 to 9 do
begin
if (StrToIntDef(sgrGrid.Cells[iCol-1, iRow-1], -1) >= 1) and (StrToIntDef(sgrGrid.Cells[iCol-1, iRow-1], -1) <= 9) then
SudokuGrid[(iCol-1)+(9*(iRow-1))+1] := StrToInt(sgrGrid.Cells[iCol-1, iRow-1])
else
SudokuGrid[(iCol-1)+(9*(iRow-1))+1] := UNKNOWN;
end; // for iRow
end; // for iCol
ShowGrid; // affiche les chiffres saisis précédés d'un espace pour centrer dans les cases
InitPossibleValues; // initialise les valeurs possibles pour chaque case vide
// premier appel à la fonction qui résoud le puzzle récursivement
NodesCount := 0;
// crée les piles de NbPossibleValues et de Possible Values
PossValStack := nil;
NbPossValStack := nil;
BackTrack;
end;
{-------------------------------------------------------}
// quand on clique sur le bouton vider
procedure TForm1.btnEmptyClick(Sender: TObject);
var
i: Byte;
begin
btnSolve.Caption := '&Résoudre';
btnSolve.Enabled := true;
Form1.Plot(' ');
for i := 1 to 81 do
SudokuGrid[i] := UNKNOWN;
// vide les piles de NbPossibleValues et de Possible Values
Finalize(PossValStack);
Finalize(NbPossValStack);
end;
{-------------------------------------------------------}
// affiche dans les 81 cases les 81 caractères passés en paramètres
procedure TForm1.Plot(Msg: ShortString);
var
i: Byte;
begin
i := 1;
while Msg[i]<>#0 do
begin
sgrGrid.Cells[(i-1) mod 9, (i-1) div 9] := #32+Msg[i]; // un espace pour centrer dans la case
Inc(i);
end; // while
end;
{-------------------------------------------------------}
// affiche la grille complètée par les valeurs trouvées
procedure TForm1.ShowGrid();
var
i: Byte;
begin
for i := 1 to 81 do
if SudokuGrid[i]<>UNKNOWN then
sgrGrid.Cells[(i-1) mod 9, (i-1) div 9] := #32+IntToStr(SudokuGrid[i]);
end;
{-------------------------------------------------------}
// pour chaque case, assigne les valeurs possible an fonction de la grille saisie
procedure TForm1.InitPossibleValues();
var
iPos, iVal: Byte;
begin
{-------------------------------------------------------}
// affecte toutes les valeurs possibles
for iPos := 1 to 81 do
begin
NbPossibleValues[iPos] := 9;
for iVal := 1 to 9 do
PossibleValues[iPos, iVal] := true;
end; // for iPos
{-------------------------------------------------------}
// restreint d'après les valeurs présentes dans la grille
for iPos := 1 to 81 do
if SudokuGrid[iPos]<>UNKNOWN then
NarrowPossibleValues(iPos);
end;
{-------------------------------------------------------}
// restreint les ensembles des valeurs possibles d'après celle contenue dans la case d'indice index
procedure TForm1.NarrowPossibleValues(Index: Byte);
var
Col, Row, BoxCol, BoxRow: Byte; // positions de la case index calculées
iIndex, iCol, iRow: Byte; // variables de boucles for
IndexTemp, BoxColTemp, BoxRowTemp: Byte; // positions temporaires, recalculées à chaque passage dans une boucle
begin
{-------------------------------------------------------}
// calcul des positions ligne, colonne et carré 3x3 cases d'après l'argument index
Col := ((Index-1)mod 9)+1;
Row := ((Index-1)div 9)+1;
BoxCol := ((Col-1)div 3)+1;
BoxRow := ((Row-1)div 3)+1;
{-------------------------------------------------------}
// contraintes sur la colonne contenant la case index
for iRow := 1 to 9 do // boucle sur les lignes
begin
IndexTemp := (iRow-1)*9 +Col; // indice (1..81) recalculé en fonction de iRow qui varie
if PossibleValues[IndexTemp, SudokuGrid[Index]] then // si la valeur insérée est autorisée dans une autre case de la région
begin
PossibleValues[IndexTemp, SudokuGrid[Index]] := false; // on l'interdit dans cette case
Dec(NbPossibleValues[IndexTemp]); // le nombre de valeurs encore autorisées dans cette autre case de la région diminue
end; // if
end; // for iRow
{-------------------------------------------------------}
// contraintes sur la ligne contenant la case index
for iCol := 1 to 9 do // boucle sur les colonnes
begin
IndexTemp := (Row-1)*9 +iCol; // indice (1..81) recalculé en fonction de iCol qui varie
if PossibleValues[IndexTemp, SudokuGrid[Index]] then // si la valeur insérée est autorisée dans une autre case de la région
begin
PossibleValues[IndexTemp, SudokuGrid[Index]] := false; // on l'interdit dans cette case
Dec(NbPossibleValues[IndexTemp]); // le nombre de valeurs encore autorisées dans cette autre case de la région diminue
end; // if
end; // for iCol
{-------------------------------------------------------}
// contraintes sur le carré de 3x3 cases contenant la case index
for iIndex := 1 to 81 do // pour chaque case, on calcul si elle est dans le même carré
begin
BoxColTemp := 1+(((iIndex-1)mod 9)div 3); // indice horizontal (1..3) du carré 3x3 recalculé
BoxRowTemp := 1+(((iIndex-1)div 9)div 3); // indice vertical (1..3) du carré 3x3 recalculé
if (BoxColTemp=BoxCol) and (BoxRowTemp=BoxRow) then // si on est dans le même carré de 3x3 case que la case modifiée
begin
if PossibleValues[iIndex, SudokuGrid[Index]] then // si la valeur insérée est autorisée dans une autre case de la région
begin
PossibleValues[iIndex, SudokuGrid[Index]] := false; // on l'interdit dans cette case
Dec(NbPossibleValues[iIndex]); // le nombre de valeurs encore autorisées dans cette autre case de la région diminue
end; // if
end; // if
end; // for iIndex
end;
{-------------------------------------------------------}
// appelée récursivement, cette méthode calcule petit à petit la solution du puzzle
procedure TForm1.BackTrack();
var
index: Byte; // indice utilisé pour parcourir toutes les cases de la grille
i, j: Byte; // variable de boucle utilisé pour empiler et dépiler
UnknownBox: ShortInt; // indice d'une case encore vide, vaut -1 si elles sont toutes pleines
MinPossibleValues: Byte; // nombre minimal de valeurs possibles parim toutes les cases de la grille
begin
{-------------------------------------------------------}
// initialisation des variables
UnknownBox := -1;
MinPossibleValues := 10;
// cherche la case ayant le moins de valeurs possibles, soit le plus de contraintes
for index := 1 to 81 do
if (SudokuGrid[index]=UNKNOWN) and (NbPossibleValues[index]<MinPossibleValues) then
begin
UnknownBox := index;
MinPossibleValues := NbPossibleValues[index];
end; // if
{-------------------------------------------------------}
// recherche s'il existe au moins une case encore vide
if UnknownBox= -1 then
begin
ShowGrid;
btnSolve.Caption := 'Et voila';
btnSolve.Enabled := false;
Exit;
end; // if
{-------------------------------------------------------}
// sinon, on réitère un appel à cette même procédure
Inc(NodesCount);
for index := 1 to 9 do // utilise index pour ne pas déclarer d'autre variable locale, mais en fait, c'est un des chiffres de 1 à 9
begin
if not(PossibleValues[UnknownBox, index]) then
Continue;
SudokuGrid[UnknownBox] := index; // assigne la valeur testé, mais on la restaurera après
sgrGrid.Cells[(index-1)mod 9, (index-1)div 9] := IntToStr(index); // affiche dans la grille la valeur testée
Form1.lblAdvance.Caption := 'itérat° '+IntToStr(NodesCount); // affiche le nombre d'appel à cette procédure
{-------------------------------------------------------}
// sauvegarde d'état actuel pour le rétablir après l'appel récursif
// empile PossibleValues
SetLength(PossValStack, Length(PossValStack) + SizeOf(PossibleValues)); // agrandit la pile
for i := 1 to Length(PossValStack) - SizeOf(PossibleValues) do
PossValStack[i] := PossValStack[i + SizeOf(PossibleValues)]; // décale les valeurs de la pile vers la base
for i := 1 to 81 do
for j := 0 to 9 do
PossValStack[(10*(i-1))+j+1] := PossibleValues[i,j]; // recopie la situation dans la pile
// empile NbPossibleValues
SetLength(NbPossValStack, Length(NbPossValStack) + SizeOf(NbPossibleValues)); // agrandit la pile
for i := 1 to Length(NbPossValStack) - SizeOf(NbPossibleValues) do
NbPossValStack[i] := NbPossValStack[i + SizeOf(NbPossibleValues)]; // décale les valeurs de la pile vers la base
for i := 1 to 81 do
NbPossValStack[i] := NbPossibleValues[i]; // recopie la situation dans la pile
{-------------------------------------------------------}
NarrowPossibleValues(UnknownBox); // restreint les valeurs possibles
BackTrack; // appel récursif
{-------------------------------------------------------}
// dépile PossibleValues
for i := 1 to 81 do
for j := 0 to 9 do
PossibleValues[i,j] := PossValStack[(10*(i-1))+j+1]; // restitue la situation en copiant la pile
for i := 1 to Length(PossValStack) - SizeOf(PossibleValues) do
PossValStack[i] := PossValStack[i + SizeOf(PossibleValues)]; // décale les valeurs de la pile vers le sommet
SetLength(PossValStack, Length(PossValStack) - SizeOf(PossibleValues)); // diminue la taille de la pile
// dépile NbPossibleValues
for i := 1 to 81 do
NbPossibleValues[i] := NbPossValStack[i]; // restitue la situation en copiant la pile
for i := 1 to Length(NbPossValStack) - SizeOf(NbPossibleValues) do
NbPossValStack[i] := NbPossValStack[i + SizeOf(NbPossibleValues)]; // décale les valeurs de la pile vers le sommet
SetLength(NbPossValStack, Length(NbPossValStack) - SizeOf(NbPossibleValues)); // diminue la taille de la pile
{-------------------------------------------------------}
end; // for SudokuGrid[UnkonwnBox]
sgrGrid.Cells[(index-1)mod 9, (index-1)div 9] := ''; // efface le chiffre testé dans la grille
SudokuGrid[UnknownBox] := UNKNOWN; // restaure la valeur comme inconnue
end;