Résolution sudoku backtrack [Résolu]

Messages postés
152
Date d'inscription
jeudi 22 novembre 2007
Statut
Membre
Dernière intervention
21 mars 2016
- - Dernière réponse : zwyx
Messages postés
152
Date d'inscription
jeudi 22 novembre 2007
Statut
Membre
Dernière intervention
21 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.

________________________
/ code source: Unit1.pas \_____________________________________________________

{-------------------------------------------------------}
{ }
{ 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 }
{ }
{-------------------------------------------------------}

unit Unit1;

{-------------------------------------------------------}
{ interface }
{-------------------------------------------------------}

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Grids, Math;

type

// 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;

var
Form1: TForm1;

{-------------------------------------------------------}
{ implémentation }
{-------------------------------------------------------}

implementation
{$R *.dfm}

const
UNKNOWN = 0;

{-------------------------------------------------------}
{--------------< 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;

{-------------------------------------------------------}
{--------------< méthodes spécifiques >-----------------}
{-------------------------------------------------------}

{-------------------------------------------------------}
// 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 }
{-------------------------------------------------------}

end.
Afficher la suite 

14 réponses

Meilleure réponse
Messages postés
1270
Date d'inscription
samedi 14 août 2004
Statut
Membre
Dernière intervention
5 avril 2012
3
Merci
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

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 186 internautes nous ont dit merci ce mois-ci

Commenter la réponse de WhiteHippo
Messages postés
2526
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
26 juillet 2018
12
0
Merci
Salut,

Nos spécialistes sont en train de trier de vieux missiles russes tout rouillés.

J'sais donc pas si tu auras beaucoup de réponses...
Commenter la réponse de Caribensila
Messages postés
3809
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
1 septembre 2019
32
0
Merci
Toujours le mot pour rire

 
@+
Cirec

<hr siz="" />
Commenter la réponse de Cirec
Messages postés
4992
Date d'inscription
dimanche 26 février 2006
Statut
Modérateur
Dernière intervention
27 mars 2018
9
0
Merci
mdr !

cantador
Commenter la réponse de cs_cantador
Messages postés
1270
Date d'inscription
samedi 14 août 2004
Statut
Membre
Dernière intervention
5 avril 2012
0
Merci
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.

unit Unit1;



interface



uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, Math;



type
  TForm1 = class(TForm)
    sgrGrid: TStringGrid;
    btnSolve: TBitBtn;
    btnEmpty: TBitBtn;
    lblAdvance: TLabel;
    procedure btnSolveClick(Sender: TObject);
    procedure btnEmptyClick(Sender: TObject);
  private
    Found :boolean;
    NodesCount: Word;
    function CheckConstraints(ACol,Arow:Integer):boolean;
  public
    procedure BackTrack(ACol,ARow:Integer);
  end;



var
  Form1: TForm1;



implementation
{$R *.dfm}



procedure TForm1.btnSolveClick(Sender: TObject);
var
  oldcursor : tcursor ;
begin
  btnSolve.Enabled := false ;
  btnEmpty.Enabled := false ;
  oldcursor := screen.Cursor ;
  screen.Cursor := crHourGlass ;
  try
    Found := false ;
    BackTrack(0,0);
  finally
    screen.Cursor := oldcursor ;
    btnSolve.Enabled := true;
    btnEmpty.Enabled := true;
  end ;
end;



procedure TForm1.btnEmptyClick(Sender: TObject);
const
  GRILLE_1 : array[0..8] of string =
    ( ( '.....923.' )
    , ( '.71.4.59.' )
    , ( '.53276...' )
    , ( '.2..93...' )
    , ( '.681.597.' )
    , ( '...86..1.' )
    , ( '...95714.' )
    , ( '.45.3.72.' )
    , ( '.194.....' )
    ) ;



  GRILLE_2 : array[0..8] of string =
    ( ( '6.5....37' )
    , ( '8.......4' )
    , ( '4...9.2..' )
    , ( '3.1.54...' )
    , ( '...237...' )
    , ( '...61.3.9' )
    , ( '..8.7...2' )
    , ( '9.......8' )
    , ( '24....5.3' )
    ) ;



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
Commenter la réponse de WhiteHippo
Messages postés
152
Date d'inscription
jeudi 22 novembre 2007
Statut
Membre
Dernière intervention
21 mars 2016
0
Merci
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;
Commenter la réponse de zwyx
Messages postés
1270
Date d'inscription
samedi 14 août 2004
Statut
Membre
Dernière intervention
5 avril 2012
0
Merci
"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
Commenter la réponse de WhiteHippo
Messages postés
152
Date d'inscription
jeudi 22 novembre 2007
Statut
Membre
Dernière intervention
21 mars 2016
0
Merci
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.
Commenter la réponse de zwyx
Messages postés
152
Date d'inscription
jeudi 22 novembre 2007
Statut
Membre
Dernière intervention
21 mars 2016
0
Merci
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 ?
Commenter la réponse de zwyx
Messages postés
1270
Date d'inscription
samedi 14 août 2004
Statut
Membre
Dernière intervention
5 avril 2012
0
Merci
"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
Commenter la réponse de WhiteHippo
Messages postés
1270
Date d'inscription
samedi 14 août 2004
Statut
Membre
Dernière intervention
5 avril 2012
0
Merci
Alors zwyx où tu en es ?

Cordialement.
<hr />"L'imagination est plus importante que le savoir." Albert Einstein
Commenter la réponse de WhiteHippo
Messages postés
152
Date d'inscription
jeudi 22 novembre 2007
Statut
Membre
Dernière intervention
21 mars 2016
0
Merci
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.

D'ici là, passe de bonnes fêtes de fin d'année.
Commenter la réponse de zwyx
Messages postés
1270
Date d'inscription
samedi 14 août 2004
Statut
Membre
Dernière intervention
5 avril 2012
0
Merci
Bonnes fêtes à toi et à toute ta famille.

Cordialement.
<hr />"L'imagination est plus importante que le savoir." Albert Einstein
Commenter la réponse de WhiteHippo
Messages postés
152
Date d'inscription
jeudi 22 novembre 2007
Statut
Membre
Dernière intervention
21 mars 2016
0
Merci
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              }
{                                                       }
{-------------------------------------------------------}



unit Unit1;



{-------------------------------------------------------}
{                       interface                       }
{-------------------------------------------------------}



interface



uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, Math;



type



  // 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;



var
  Form1: TForm1;



{-------------------------------------------------------}
{                   implémentation                      }
{-------------------------------------------------------}



implementation
{$R *.dfm}



const
  UNKNOWN = 0;



{-------------------------------------------------------}
{--------------< 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;



{-------------------------------------------------------}
{--------------< méthodes spécifiques >-----------------}
{-------------------------------------------------------}



{-------------------------------------------------------}
// 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;



end.
Commenter la réponse de zwyx