Sudoku page
by David E. Dirkse
|
goto Sudoku page |
SUDOKU helper/solver programming by David E. Dirkse |
|
type
Tnumber = record
nr : byte;
org : boolean;
end;
TSodoku = array[1..9,1..9] of TNumber;
//------comp search data
var board : TSodoku;
Xboard : array[1..9,1..9] of word;
RowSums : array[1..9] of word;
ColSums : array[1..9] of word;
groupSums: array[1..9] of word;
|
function IJtoGroupNr(i,j : byte) : byte;
//return group Nr of field [i,j]
var x,y : byte;
begin
x := (i-1) div 3;
y := (j-1) div 3;
result := x + 3*y + 1;
end;
procedure MakeHintfields;
//make Xboard array 9*9 of word
//each word has bit set for possible digit
//make Row & column sums
var i,j,group,x,y : byte;
begin
for j := 1 to 9 do
for i := 1 to 9 do
if board[i,j].nr = 0 then Xboard[i,j] := 0 //clear Xboard
else Xboard[i,j] := 1 shl board[i,j].nr; //set xboard
//
for i := 1 to 9 do
begin
Rowsums[i] := $3fe; //init RowSums
ColSums[i] := $3fe; //init Columnsums
GroupSums[i] := $3fe; //init groupsums
end;
//make row sums
for j := 1 to 9 do
for i := 1 to 9 do RowSums[j] := RowSums[j] xor Xboard[i,j];
//make Column sums
for i := 1 to 9 do
for j := 1 to 9 do ColSums[i] := ColSums[i] xor Xboard[i,j];
//make group sums
for group := 1 to 9 do
begin
x := ((group-1) mod 3)*3 + 1;
y := ((group-1) div 3)*3 + 1; //[x,y] is left top of group
for j := 0 to 2 do
for i := 0 to 2 do
GroupSums[group] := Groupsums[group] xor Xboard[x+i,y+j];
end;
//combine column-row-group
for j := 1 to 9 do
for i := 1 to 9 do
if board[i,j].nr = 0 then
Xboard[i,j] := ColSums[i] and Rowsums[j] and GroupSums[IJtoGroupNr(i,j)];
end;
|
var
Pallow : array[1..9] of word; //for hint reduction
Psum : array[1..9] of word;
Xvalue : array[1..9] of word;
Pmask : array[1..9] of word;
|
//-------hint reduction by row/column
procedure LoadPfromRow(row : byte);
var i : byte;
begin
for i := 1 to 9 do
begin
xvalue[i] := Xboard[i,row];
Psum[i] := 0;
end;
end;
procedure LoadPfromColumn(col : byte);
var j : byte;
begin
for j := 1 to 9 do
begin
xvalue[j] := Xboard[col,j];
Psum[j] := 0;
end;
end;
procedure loadPfromGroup(gr : byte);
var i,j,n,x,y : byte;
begin
x := ((gr-1) mod 3)*3 + 1; //[x,y] is left top of group
y := ((gr-1) div 3)*3 + 1;
for n:= 1 to 9 do
begin
i := x+((n-1) mod 3); //[i,j] is field
j := y+((n-1) div 3);
Xvalue[n] := xboard[i,j];
Psum[n] := 0;
end;
end;
procedure UpdatePsums;
//or masks into Psum
var n : byte;
begin
for n := 1 to 9 do PSum[n] := Psum[n] or Pmask[n];
end;
function PC(action : byte) : boolean;
//action-0 : reset, 1: increment
//on exit :
//true: digit 9 incremented properly
//false: digit 1 overflow
var xxx : word;
digit : byte; //counter digit
label PCreset,PCincr;
begin
if action = 0 then digit := 1 else begin
digit := 9; goto PCincr;
end;
Pallow[1] := $3fe;
PCreset :
Pmask[digit] := 1;
if digit > 1 then Pallow[digit] :=
Pallow[digit-1] and (Pmask[digit-1] xor $3fe);
PCincr :
xxx := Pallow[digit] and xvalue[digit];
repeat
Pmask[digit] := Pmask[digit] shl 1; //find next mask
until (Pmask[digit] = $400) or ((Pmask[digit] and xxx) <> 0);
if Pmask[digit] = $400 then //not found
begin
Pmask[digit] := 0;
if digit = 1 then
begin
result := false; exit; //exit if digit 1
end
else begin
dec(digit); goto PCIncr;//no mask, digit > 1 = inc previous
end;
end //if mask...
else //good mask found
if digit < 9 then
begin
inc(digit); goto PCreset; //new mask found, reset next
end
else result := true;
end;
procedure HintReduction;
//use Xboard values and reduce per row,column
var i,j,n,gf,x,y : byte;
s : string;
begin
s := 'please wait';
msg(msgInfo,s);
for n := 1 to 9 do //rows
begin
loadPfromRow(n); //if reset OK
if PC(0) then
begin
UpdatePsums;
while PC(1) do UpdatePsums; //if incr OK
end;
for i := 1 to 9 do xboard[i,n] := Psum[i];//store results
end;//for n
//
for n := 1 to 9 do //columns
begin
loadPfromcolumn(n);
if PC(0) then
begin
UpdatePsums;
while PC(1) do UpdatePsums; //if incr OK
end;
for i := 1 to 9 do xboard[n,i] := Psum[i];//store results
end;//for
for n := 1 to 9 do //groups
begin
loadPfromgroup(n);
if PC(0) then //if reset OK
begin
UpdatePsums;
while PC(1) do UpdatePsums; //if incr OK
end;
x := ((n-1) mod 3)*3 + 1;
y := ((n-1) div 3)*3 + 1; //[I,J] of field
for gf:= 1 to 9 do
begin //for group fields 1..9
i := x+((gf-1) mod 3);
j := y+((gf-1) div 3);
xboard[i,j] := Psum[gf];
end;
end;//for n
//
s := '';
msg(msgInfo,s);
//
showHintFields;
if hintflag then
begin
AnalyzeHints;
ReportHintData;
end;
end;
|
type TentryType = (etOrg,etAuto,etManual);//way number was added
TNumber3 = record
nr : byte;
et : TentryType;
end;
Tsudoku3 = array[1..9,1..9] of Tnumber3;//puzzle board
var board : TSudoku3;
triple : array[1..3,1..9] of word; //for hintreduction2
|
//------------hint reduction2
procedure loadTriplesHor;
//i:column j:row sum: or of 3 cons. fields in row
var i,j,x,n : byte;
sum : word;
begin
for j := 1 to 9 do //all columns
for i := 1 to 3 do //all 3 triples
begin
x := (i-1)*3 + 1;
sum := 0;
for n := 0 to 2 do sum := sum or Xboard[x+n,j];
triple[i,j] := sum;
end;
end;
procedure loadtriplesvert;
//reflect row/column to use same chech later
var i,j,y,n : byte;
sum : word;
begin
for i := 1 to 9 do
for j := 1 to 3 do
begin
y := (j-1)*3 + 1;
sum := 0;
for n := 0 to 2 do sum := sum or Xboard[i,y+n];
triple[j,i] := sum;
end;
end;
procedure CheckTriples;
var block, i,j,y,n : byte;
a,b,c : word;
begin
for block := 1 to 3 do
begin
y := (block-1)*3 + 1;
for j := 1 to 3 do
for i := 1 to 3 do
begin
a := 0; b := 0;
for n := 1 to 3 do
begin
if n <> i then a := a or triple[n,y+j-1];
if n <> j then b := b or triple[i,y+n-1];
end;
c := a and b;
for n := 1 to 3 do
begin
if n <> i then triple[n,y+j-1] := triple[n,y+j-1] and c;
if n <> j then triple[i,y+n-1] := triple[i,y+n-1] and c;
end;
end;
end;
end;
procedure reduceRowsbyTriples;
var i,j,x : byte;
begin
for j := 1 to 9 do
for i := 1 to 9 do
begin
x := (i-1) div 3 + 1;
Xboard[i,j] := Xboard[i,j] and triple[x,j]
end;
end;
procedure reduceColumnsbyTriples;
var i,j,x : byte;
begin
for j := 1 to 9 do
begin
x := (j-1) div 3 + 1;
for i := 1 to 9 do Xboard[i,j] := Xboard[i,j] and triple[x,i];
end;
end;
procedure Hintreduction2;
//sum options in triples, hor. vert.
//compare groups vs row, column
//select triple in group:
//options not present in row outside group,
//are cancelled in other triples in group
var s : string;
begin
loadTriplesHor;
CheckTriples;
reduceRowsbyTriples;
loadtriplesvert;
CheckTriples;
reduceColumnsbyTriples;
end;
|
