- validate user input before trying to solve.
- stop calculating if nothing has changed.
- refine messages if puzzle isn't solved.
- remove unused code.
- rename some methods.


git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7251 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
lazarus-bart
2020-01-09 12:32:47 +00:00
parent b24bcfec2b
commit 153d084e6e
2 changed files with 165 additions and 41 deletions

View File

@ -60,6 +60,8 @@ type
var Editor: TWinControl); var Editor: TWinControl);
private private
{ private declarations } { private declarations }
const
MaxSteps = 50;
//theValues: TValues; //theValues: TValues;
procedure OnCopyBackValues(Sender: TObject; Values: TValues); procedure OnCopyBackValues(Sender: TObject; Values: TValues);
function SolveSudoku(out Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean; function SolveSudoku(out Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
@ -131,14 +133,21 @@ var
Steps: Integer; Steps: Integer;
begin begin
SGrid.Options := SGrid.Options - [goEditing]; SGrid.Options := SGrid.Options - [goEditing];
Res := SolveSudoku(Values, RawData, Steps); try
ValuesToGrid(Values); Res := SolveSudoku(Values, RawData, Steps);
if Res then ValuesToGrid(Values);
ShowMessage(Format('Sudoku solved in %d steps.', [Steps])) if Res then
else ShowMessage(Format('Sudoku solved in %d steps.', [Steps]))
begin else
ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps])); begin
ShowScratchPad(RawData); if (Steps < MaxSteps) then
ShowMessage(Format('Unable to solve sudoku (no progress after step %d).',[Steps-1]))
else
ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps]));
ShowScratchPad(RawData);
end;
except
on E: ESudoku do ShowMessage(E.Message);
end; end;
end; end;
@ -215,8 +224,11 @@ begin
GridToValues(Values); GridToValues(Values);
RawData := Default(TRawGrid); RawData := Default(TRawGrid);
aSudoku := TSudoku.Create; aSudoku := TSudoku.Create;
Result := aSudoku.GiveSolution(Values, RawData, Steps); try
aSudoku.Free; Result := aSudoku.GiveSolution(Values, RawData, Steps);
finally
aSudoku.Free;
end;
end; end;
procedure TForm1.GridToValues(out Values: TValues); procedure TForm1.GridToValues(out Values: TValues);

View File

@ -43,19 +43,29 @@ type
{ TSudoku } { TSudoku }
TSudoku = class(TObject) TSudoku = class(TObject)
function GiveSolution(var Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
private private
FMaxSteps: Integer;
Grid: TRawGrid; Grid: TRawGrid;
procedure CalculateValues(out IsSolved: Boolean); procedure CalculateValues(out IsSolved: Boolean);
procedure CheckRow(Col, Row: Integer); procedure CheckRow(Col, Row: Integer);
procedure CheckCol(Col, Row: Integer); procedure CheckCol(Col, Row: Integer);
procedure CheckBlock(Col, Row: Integer); procedure CheckBlock(Col, Row: Integer);
procedure CheckDigits(ADigit: Integer); procedure CheckDigits(ADigit: Integer);
procedure FillGridFromValues(Values: TValues); procedure CheckInput(Values: TValues);
procedure ValuesToGrid(Values: TValues);
function GridToValues: TValues;
function Solve(out Steps: Integer): Boolean; function Solve(out Steps: Integer): Boolean;
//function Solved: Boolean; public
constructor Create;
function GiveSolution(var Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
property MaxSteps: Integer read FMaxSteps write FMaxSteps default 50;
end; end;
ESudoku = class(Exception);
const
AllDigits: TDigitSet = [1, 2, 3, 4, 5, 6, 7, 8, 9];
function DbgS(ASet: TDigitSet): String; overload; function DbgS(ASet: TDigitSet): String; overload;
function DbgS(ASquare: TSquare): String; overload; function DbgS(ASquare: TSquare): String; overload;
@ -107,9 +117,27 @@ begin
end; end;
end; end;
function IsEqualGrid(const A, B: TRawGrid): Boolean;
var
Col, Row: Integer;
begin
Result := False;
for Col := 1 to 9 do
begin
for Row := 1 to 9 do
begin
if (A[Col,Row].DigitsPossible <> B[Col,Row].DigitsPossible) or
(A[Col,Row].Locked <> B[Col,Row].Locked) or
(A[Col,Row].Value <> B[Col,Row].Value) then
Exit;
end;
end;
Result := True;
end;
{ TSudoku } { TSudoku }
procedure TSudoku.FillGridFromValues(Values: TValues); procedure TSudoku.ValuesToGrid(Values: TValues);
var var
c, r: Integer; c, r: Integer;
begin begin
@ -127,19 +155,34 @@ begin
begin begin
Grid[c, r].Locked := False; Grid[c, r].Locked := False;
Grid[c, r].Value := 0; Grid[c, r].Value := 0;
Grid[c, r].DigitsPossible := [1, 2, 3, 4, 5, 6, 7, 8, 9]; Grid[c, r].DigitsPossible := AllDigits;
end; end;
end; end;
end; end;
end; end;
function TSudoku.GridToValues: TValues;
var
Col, Row: Integer;
begin
for Col := 1 to 9 do
begin
for Row := 1 to 9 do
begin
Result[Col, Row] := Grid[Col, Row].Value;
end;
end;
end;
function TSudoku.Solve(out Steps: Integer): Boolean; function TSudoku.Solve(out Steps: Integer): Boolean;
var var
c, r: Integer; c, r: Integer;
OldState: TRawGrid;
begin begin
Steps := 0; Steps := 0;
repeat repeat
inc(Steps); inc(Steps);
OldState := Grid;
for c := 1 to 9 do for c := 1 to 9 do
begin begin
for r := 1 to 9 do for r := 1 to 9 do
@ -154,22 +197,25 @@ begin
end; end;
for c := 1 to 9 do CheckDigits(c); for c := 1 to 9 do CheckDigits(c);
CalculateValues(Result); CalculateValues(Result);
until Result or (Steps > 50);
//if IsConsole then
// writeln('Steps = ',Steps,', IsEqualGrid(OldState, Grid) = ',IsEqualGrid(OldState, Grid));
until Result or (Steps >= FMaxSteps) or (IsEqualGrid(OldState, Grid));
end;
constructor TSudoku.Create;
begin
inherited Create;
FMaxSteps := 50;
end; end;
function TSudoku.GiveSolution(var Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean; function TSudoku.GiveSolution(var Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
var
c, r: Integer;
begin begin
FillGridFromValues(Values); CheckInput(Values);
ValuesToGrid(Values);
Result := Solve(Steps); Result := Solve(Steps);
for c := 1 to 9 do Values := GridToValues;
begin
for r := 1 to 9 do
begin
Values[c, r] := Grid[c, r].Value;
end;
end;
RawData := Grid; RawData := Grid;
end; end;
@ -289,21 +335,87 @@ begin
end; end;
end; end;
//function TSudoku.Solved: Boolean; procedure TSudoku.CheckInput(Values: TValues);
//var procedure CheckColValues;
// c, r: Integer; var
//begin Col, Row: Integer;
// result := True; DigitSet: TDigitSet;
// for c := 1 to 9 do begin D: Integer;
// for r := 1 to 9 do begin begin
// if not Grid[c, r].Locked then begin for Col := 1 to 9 do
// Result := False; begin
// Break; DigitSet := [];
// end; for Row := 1 to 9 do
// end; begin
// if not result then Break; D := Values[Col, Row];
// end; if (D <> 0) then
//end; begin
if (D in DigitSet) then
Raise ESudoku.CreateFmt('Duplicate value ("%d") in Col %d',[D, Col]);
Include(DigitSet, D);
end;
end;
end;
end;
procedure CheckRowValues;
var
Col, Row: Integer;
DigitSet: TDigitSet;
D: Integer;
begin
for Row := 1 to 9 do
begin
DigitSet := [];
for Col := 1 to 9 do
begin
D := Values[Col, Row];
if (D <> 0) then
begin
if (D in DigitSet) then
Raise ESudoku.CreateFmt('Duplicate value ("%d") in Row %d',[D, Row]);
Include(DigitSet, D);
end;
end;
end;
end;
procedure CheckBlockValues(StartCol, StartRow: Integer);
var
Col, Row: Integer;
DigitSet: TDigitSet;
D: Integer;
begin
DigitSet := [];
for Col := StartCol to StartCol + 2 do
begin
for Row := StartRow to StartRow + 2 do
begin
D := Values[Col,Row];
if (D <> 0) then
begin
if (D in DigitSet) then
Raise ESudoku.CreateFmt('Duplicate value ("%d") in block at Row: %d, Col: %d',[D, Row, Col]);
Include(DigitSet, D);
end;
end;
end;
end;
begin
CheckRowValues;
CheckColValues;
CheckBlockValues(1,1);
CheckBlockValues(1,4);
CheckBlockValues(1,7);
CheckBlockValues(4,1);
CheckBlockValues(4,4);
CheckBlockValues(4,7);
CheckBlockValues(7,1);
CheckBlockValues(7,4);
CheckBlockValues(7,7);
end;
end. end.