Sudoku feladvány megoldása Backtrack algoritmussal

Ez a program Sudoku feladványok megoldásra alkalmas. A használt algoritmus a Backtrack. Csak egyetlen megoldást keres, és ha a feladvány megoldható, akkor talál is. Alapértelmezésben ez így helyes is, mert minden feladványnak csak egyetlen megoldása lehetséges.

A következő lehetőségeket kínálja a program:

- a megjelenített táblára magunk beírhatjuk a megoldandó feladványt,

- a beírt számokat rögzíthetjük, mely piros színnel jelenik meg,

- a már rögzített számok kézzel sem írhatók át,

- megtehetjük, hogy magunk próbáljuk megoldani a feladványt,

- a kézi megoldás keresése közben a gép folyamatosan ellenőrzi, hogy az épp beírt szám beírható-e, ha igen akkor megmarad a mezőben, ha nem a gép automatikusan törli azt,

- a feladvány megoldását a gépre is bízhatjuk, melyet a Backtrack algoritmus segítségével keres,

- a gépi megoldás közben, ha ezt a Megjelenít jelölőnézettel kérjük, lépésenként megjeleníti a keresési állapotokat,

- a gép kijelzi a keresés kezdő és befejező időpontját,

- ha sikerül a feladványt megoldani, akkor Kész felirat jelenik meg, ha nem akkor Vége,

- a gép maximum 1 millió lépésig keres megoldásokat, és minden ezredik lépésben megjeleníti az aktuális állapotot a képernyőn,

- ha kedvünk van, véletlen feladványt kérhetünk a géptől, de ezek nem igazi Sudoku feladványok lesznek, lehet, hogy meg sem oldhatók, de az is lehet, hogy több megoldása is van, ami ugye nem szabályos.

A program indulási képe:

A futási kép gépi generálás előtt:

Az elkészült megoldás:

A program listája:

unit USudokuBTr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, ExtCtrls;

Const GAl=3;
      Max=GAl*GAl;
      LMax=1000000;

type
  TfmSudokuBTr = class(TForm)
    lbSudokuBTr: TLabel;
    btKilepes: TButton;
    sgTabla: TStringGrid;
    btStart: TButton;
    tiIdozito: TTimer;
    cbMegjelenit: TCheckBox;
    btTorles: TButton;
    edIndex: TEdit;
    edStart: TEdit;
    edStop: TEdit;
    lbKesz: TLabel;
    edLepes: TEdit;
    btRandom: TButton;
    btRogzit: TButton;
Procedure Vizsgal;
Function Utkozik(H: Word): Boolean;
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sgTablaDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure btStartClick(Sender: TObject);
procedure tiIdozitoTimer(Sender: TObject);
procedure btTorlesClick(Sender: TObject);
procedure btRandomClick(Sender: TObject);
procedure btRogzitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmSudokuBTr: TfmSudokuBTr;
  SB, SC: Array[1..Max*Max] Of Word;
  Lepes: LongInt;
  Keres: Boolean;

implementation

{$R *.dfm}

procedure TfmSudokuBTr.btKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmSudokuBTr.sgTablaDrawCell(Sender: TObject; Col,
  Row: Integer; Rect: TRect; State: TGridDrawState);
begin
With sgTabla.Canvas.Brush Do
Begin
If Not((gdSelected In State) Or (gdFixed In State)) Then
If Odd(((Col-1) Div GAl)+((Row-1) Div GAl)) Then
    Color:= clAqua Else Color:= clWindow;
If (gdSelected In State) Then Color:= clYellow;
End;
With sgTabla.Canvas.Font Do If SC[(Row-1)*Max+Col]=0 Then
  Color:= clBlack Else Color:= clRed;
sgTabla.Canvas.TextRect(Rect,Rect.Left+16,Rect.Top+4,
                               sgTabla.Cells[Col,Row]);
If gdFocused In State Then sgTabla.Canvas.DrawFocusRect(Rect);
end;

procedure TfmSudokuBTr.FormCreate(Sender: TObject);
begin
  Randomize;
With sgTabla Do
Begin
    ColCount:= Max+2; RowCount:= Max+2;
    ColWidths[0]:= 0; RowHeights[0]:= 0;
    ColWidths[ColCount-1]:= 0; RowHeights[RowCount-1]:= 0;
    Col:= ColCount-1; Row:= RowCount-1;
End;
  Keres:= False;
end;

procedure TfmSudokuBTr.btRogzitClick(Sender: TObject);
begin
  SC:= SB; sgTabla.Repaint;
end;

procedure TfmSudokuBTr.btTorlesClick(Sender: TObject);
Var I, J: Word;
begin
For I:= 1 To Max*Max Do Begin SB[I]:= 0; SC[I]:= 0 End;
For I:= 1 To Max Do For J:= 1 To Max Do sgTabla.Cells[I,J]:= '';
  edIndex.Text:= ''; edLepes.Text:= '';
  edStart.Text:= ''; edStop.Text:= '';
  lbKesz.Visible:= False;
end;

Procedure TfmSudokuBTr.Vizsgal;
Var Kod: Integer;
Begin
With sgTabla Do If Cells[Col,Row]<>'' Then
Begin
    Val(Cells[Col,Row][1],SB[(Row-1)*Max+Col],Kod);
If (SC[(Row-1)*Max+Col]<>0) And
    (SC[(Row-1)*Max+Col]<>SB[(Row-1)*Max+Col]) Then
Begin
SB[(Row-1)*Max+Col]:= SC[(Row-1)*Max+Col];
      Cells[Col,Row]:= IntToStr(SB[(Row-1)*Max+Col]);
End;
If Utkozik((Row-1)*Max+Col) Then
Begin SB[(Row-1)*Max+Col]:= 0; Cells[Col,Row]:= '' End
End;
End;

procedure TfmSudokuBTr.tiIdozitoTimer(Sender: TObject);
begin
If Keres Then Exit; Vizsgal;
end;

Function TfmSudokuBTr.Utkozik(H: Word): Boolean;
Var A, B, I, J, K: Word;
    Ut: Boolean;
Begin
  Ut:= False;
  A:= H-((H-1) Mod Max); B:= H+Max-1-((H-1) Mod Max);
For I:= A To B Do
If (SB[H]<>0) And (I<>H) And (SB[H]=SB[I]) Then
Begin Ut:= True; Break End;
If Not Ut Then
Begin
    I:= 1+(H-1) Mod Max;
While I<Max*Max Do
Begin If (I<>H) And (SB[H]=SB[I]) Then Ut:= True; Inc(I,Max) End;
End;
If Not Ut Then
Begin
    K:= GAl*Max*((H-1) Div (Gal*Max))+GAl*(((H-1) Mod Max) Div GAl)+1;
For J:= 1 To Gal Do For I:= K+(J-1)*Max To K+(J-1)*Max+Gal-1 Do
If (I<>H) And (SB[H]=SB[I]) Then Begin Ut:= True; Break End;
End;
  Utkozik:= Ut;
End;

procedure TfmSudokuBTr.btStartClick(Sender: TObject);
Var I: Word;
begin
  Keres:= True;
  edStart.Text:= TimeToStr(GetTime); edStart.Repaint;
  edStop.Text:= ''; edStop.Repaint;
  SC:= SB; sgTabla.Repaint;
I:= 1; Lepes:= 0;
While (I In [1..Max*Max]) And (Lepes<=LMax) Do
Begin
    Inc(Lepes);
If Lepes Mod 1000=0 Then
Begin
      edIndex.Text:= IntToStr(I);
      edLepes.Text:= IntToStr(Lepes);
      RePaint;
End;
While SC[I]<>0 Do Inc(I);
    Inc(SB[I]);
With sgTabla Do
Begin
If SB[I]<>0 Then Cells[(I-1) Mod Max+1,(I-1) Div Max+1]:= IntToStr(SB[I])
Else Cells[(I-1) Mod Max+1,(I-1) Div Max+1]:= '';
If cbMegjelenit.Checked Then Repaint;
End;
If SB[I]>Max Then
Begin
      SB[I]:= 0;
With sgTabla Do
Begin
Cells[(I-1) Mod Max+1,(I-1) Div Max+1]:= '';
If cbMegjelenit.Checked Then Repaint;
End;
      Dec(I); While SC[I]<>0 Do Dec(I);
End Else
With sgTabla Do If Not Utkozik(I) Then
Begin
If SB[I]<>0 Then
      Cells[(I-1) Mod Max+1,(I-1) Div Max+1]:= IntToStr(SB[I])
Else Cells[(I-1) Mod Max+1,(I-1) Div Max+1]:= '';
If cbMegjelenit.Checked Then Repaint;
      Inc(I);
End;
End;
  edIndex.Text:= IntToStr(I);
  edLepes.Text:= IntToStr(Lepes);
  Keres:= False;
  edStop.Text:= TimeToStr(GetTime);
With lbKesz Do
Begin
If I=Max*Max+1 Then Caption:= 'Kész' Else Caption:= 'Vége';
    Visible:= True;
End;
end;

procedure TfmSudokuBTr.btRandomClick(Sender: TObject);
Var I, H: Word;
begin
  btTorlesClick(Sender);
With sgTabla Do
For I:= 1 To 60 Do
Begin
    H:= Random(Max*Max)+1; SB[H]:= Random(Max)+1;
    Col:= ((H-1) Mod Max)+1;
    Row:= ((H-1) Div Max)+1;
    Cells[Col,Row]:= IntToStr(SB[H]);
    Vizsgal;
End;
end;

end.