{-------------------------------------------------------}
{                                                       }
{  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('                                                                                 ');
  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.