Résolution sudoku backtrack

Résolu
zwyx Messages postés 146 Date d'inscription jeudi 22 novembre 2007 Statut Membre Dernière intervention 21 mars 2016 - 20 déc. 2007 à 11:00
zwyx Messages postés 146 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.

14 réponses

WhiteHippo Messages postés 1154 Date d'inscription samedi 14 août 2004 Statut Membre Dernière intervention 5 avril 2012 3
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
3
Caribensila Messages postés 2527 Date d'inscription jeudi 15 janvier 2004 Statut Membre Dernière intervention 16 octobre 2019 18
20 déc. 2007 à 19:37
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...
0
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
20 déc. 2007 à 19:57
Toujours le mot pour rire

 
@+
Cirec

<hr siz="" />
0
cs_cantador Messages postés 4720 Date d'inscription dimanche 26 février 2006 Statut Modérateur Dernière intervention 31 juillet 2021 13
20 déc. 2007 à 20:55
mdr !

cantador
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
WhiteHippo Messages postés 1154 Date d'inscription samedi 14 août 2004 Statut Membre Dernière intervention 5 avril 2012 3
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.

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
0
zwyx Messages postés 146 Date d'inscription jeudi 22 novembre 2007 Statut Membre Dernière intervention 21 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;
0
WhiteHippo Messages postés 1154 Date d'inscription samedi 14 août 2004 Statut Membre Dernière intervention 5 avril 2012 3
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
0
zwyx Messages postés 146 Date d'inscription jeudi 22 novembre 2007 Statut Membre Dernière intervention 21 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.
0
zwyx Messages postés 146 Date d'inscription jeudi 22 novembre 2007 Statut Membre Dernière intervention 21 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 ?
0
WhiteHippo Messages postés 1154 Date d'inscription samedi 14 août 2004 Statut Membre Dernière intervention 5 avril 2012 3
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
0
WhiteHippo Messages postés 1154 Date d'inscription samedi 14 août 2004 Statut Membre Dernière intervention 5 avril 2012 3
23 déc. 2007 à 11:02
Alors zwyx où tu en es ?

Cordialement.
<hr />"L'imagination est plus importante que le savoir." Albert Einstein
0
zwyx Messages postés 146 Date d'inscription jeudi 22 novembre 2007 Statut Membre Dernière intervention 21 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.

D'ici là, passe de bonnes fêtes de fin d'année.
0
WhiteHippo Messages postés 1154 Date d'inscription samedi 14 août 2004 Statut Membre Dernière intervention 5 avril 2012 3
31 déc. 2007 à 10:09
Bonnes fêtes à toi et à toute ta famille.

Cordialement.
<hr />"L'imagination est plus importante que le savoir." Albert Einstein
0
zwyx Messages postés 146 Date d'inscription jeudi 22 novembre 2007 Statut Membre Dernière intervention 21 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              }
{                                                       }
{-------------------------------------------------------}



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.
0
Rejoignez-nous