Code:
Type
TCoord=array[1..2] of smallint; //There are lots of way I use this in the program
TBox=array[1..3,1..3] of TCoord;
TCell=array[1..4] of smallint;
{The first element of the array stores the row number of the cell. The second, the column number.
The third and the fourth are the two possible candidates in that cell }
TArr=array[1..6] of smallint;
TPointCell=^TCell;
TPossibles=array[1..81] of TCell;
Cell=Record
Solved:boolean;
Candidates:array[1..9] of smallint;
Num_of_Candidates:smallint;
end;
Var
Grid:array[1..9,1..9] of Cell;
Finished:integer;
{Why is this integer? I was getting unexplainable and weird errors when the function was boolean.
It stored weird stuff like "0x4ecwhatever" instead of "true" or "false" and somehow it works with integer... weird }
Have_Result:Boolean;
Function GetBox(x,y:smallint):TBox;
{What this function does is it returns a 3x3 size Box for every x,y coordinate, or if y is set to 0, then box #x.
Boxes are numbered 1-9 from left to right, up to bottom like this:
1 2 3
4 5 6
7 8 9 }
var
i,j:smallint;
Begin
if y<>0 then
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
if x<=3 then GetBox[i,j][1]:=i
else
if x>6 then GetBox[i,j][1]:=i+6
else
GetBox[i,j][1]:=i+3;
if y<=3 then GetBox[i,j][2]:=j
else
if y>6 then GetBox[i,j][2]:=j+6
else
GetBox[i,j][2]:=j+3;
end;
end;
end
else
begin
if x=1 then
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
GetBox[i,j][1]:=i;
GetBox[i,j][2]:=j;
end;
end;
end
else
if x=2 then
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
GetBox[i,j][1]:=i;
GetBox[i,j][2]:=j+3;
end;
end;
end
else
if x=3 then
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
GetBox[i,j][1]:=i;
GetBox[i,j][2]:=j+6;
end;
end;
end
else
if x=4 then
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
GetBox[i,j][1]:=i+3;
GetBox[i,j][2]:=j;
end;
end;
end
else
if x=5 then
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
GetBox[i,j][1]:=i+3;
GetBox[i,j][2]:=j+3;
end;
end;
end
else
if x=6 then
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
GetBox[i,j][1]:=i+3;
GetBox[i,j][2]:=j+6;
end;
end;
end
else
if x=7 then
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
GetBox[i,j][1]:=i+6;
GetBox[i,j][2]:=j;
end;
end;
end
else
if x=8 then
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
GetBox[i,j][1]:=i+6;
GetBox[i,j][2]:=j+3;
end;
end;
end
else
begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
begin
GetBox[i,j][1]:=i+6;
GetBox[i,j][2]:=j+6;
end;
end;
end;
end;
End;
Function BoxCalc(x,y:smallint):smallint;
{This was written early as a quick comparison. I could use the above function too, but I have written this before I realized the above would be necessary later, and I've already had a bunch of procedures using this one, so I've decided to keep it}
Begin
if (x<=3) and (y<=3) then BoxCalc:=1;
if (x>3) and (x<=6) and (y<=3) then BoxCalc:=2;
if (x>6) and (y<=3) then BoxCalc:=3;
if (x<=3) and (y>3) and (y<=6) then BoxCalc:=4;
if (x>3) and (x<=6) and (y>3) and (y<=6) then BoxCalc:=5;
if (x>6) and (y>3) and (y<=6) then BoxCalc:=6;
if (x<=3) and (y>6) then BoxCalc:=7;
if (x>3) and (x<=6) and (y>6) then BoxCalc:=8;
if (x>6) and (y>6) then BoxCalc:=9;
end;
Function Candidate_Exists(x,y,cand:smallint):boolean;
{This is simple, it checks if a candidate is possible on an unsolved cell. It's very useful and pretty much necessary}
var
i,j:smallint;
check:boolean;
Begin
check:=false;
for i:=1 to Grid[x,y].Num_of_Candidates do
begin
if Grid[x,y].Candidates[i]=cand then check:=true;
end;
Candidate_Exists:=check;
End;
Function Cells_Collide(x1,y1,x2,y2:smallint):string;
{A key function for the XY-wing. This checks if two cells can see each other and what house they share.
This latter is not too important XY-wing wise, but I do use it in other procedures too.}
Begin
if (x1=x2) and (y1=y2) then Cells_Collide:='null'
else
if x1=x2 then Cells_Collide:='row'
else
if y1=y2 then Cells_Collide:='column'
else
if BoxCalc(x1,y1)=BoxCalc(x2,y2) then Cells_Collide:='box'
else
Cells_Collide:='null';
End;
Procedure Eliminate(x,y,cand:smallint);
{This is just a simple procedure to save me some typing}
var
i,j:smallint;
Begin
if Candidate_Exists(x,y,cand) then
begin
for i:=1 to Grid[x,y].Num_of_Candidates do
begin
if Grid[x,y].Candidates[i]=cand then
begin
Grid[x,y].Candidates[i]:=Grid[x,y].Candidates[Grid[x,y].Num_of_Candidates];
Grid[x,y].Candidates[Grid[x,y].Num_of_Candidates]:=0;
Grid[x,y].Num_of_Candidates:=Grid[x,y].Num_of_Candidates-1;
Have_Result:=True;
end;
end;
end;
End;
Function Num_of_Cands(arr:TArr;Cand:smallint):smallint;
{This is also very simple and specific. If three cells all have 2 candidates and I read ALL candidates into an array,
and each candidate only has an incidence of two,
then they can not be other than (a,b) (b,c) and (a,c) since one candidate can not reside twice in any of the cells.
An XY-wing works with cells like this, so this is to check that}
var
i:smallint;
base:smallint;
Begin
base:=0;
for i:=1 to 6 do
begin
if arr[i]=Cand then base:=base+1;
end;
Num_of_Cands:=base;
End;
Function ValidCandidates(Square1,Square2,Square3:TCell):Boolean;
{This uses the above method to check for possibly valid XY-wings }
var
i:smallint;
base:boolean;
Candidates:array[1..6] of smallint;
Begin
base:=false;
Candidates[1]:=Square1[3];
Candidates[2]:=Square1[4];
Candidates[3]:=Square2[3];
Candidates[4]:=Square2[4];
Candidates[5]:=Square3[3];
Candidates[6]:=Square3[4];
if ( Num_of_Cands(Candidates,Square1[3])=2 ) and (Num_of_Cands(Candidates,Square1[4])=2 ) then
if ( Num_of_Cands(Candidates,Square2[3])=2 ) and (Num_of_Cands(Candidates,Square2[4])=2 ) then
if ( Num_of_Cands(Candidates,Square3[3])=2 ) and (Num_of_Cands(Candidates,Square3[4])=2 ) then
base:=true;
ValidCandidates:=base;
End;
Function ValidPosition(Square1,Square2,Square3:TCell):smallint;
{This function checks if the position of the cells are good to form an XY-wing.
If it is valid, it also returns which one will be the Hinge, and which two the Wings.
Which wing will be wing 1 or wing 2 is fortunately irrelevant so I don't really have to deal with that.
If it is not valid, it returns a 0}
Var
base:smallint;
x1,x2,x3:smallint;
y1,y2,y3:smallint;
Begin
base:=0;
x1:=Square1[1];
y1:=Square1[2];
x2:=Square2[1];
y2:=Square2[2];
x3:=Square3[1];
y3:=Square3[2];
if (Cells_Collide(x1,y1,x2,y2)<>'null') and (Cells_Collide(x1,y1,x3,y3)<>'null') and (Cells_Collide(x2,y2,x3,y3)='null')
then base:=1
else
if (Cells_Collide(x1,y1,x2,y2)<>'null') and (Cells_Collide(x1,y1,x3,y3)='null') and (Cells_Collide(x2,y2,x3,y3)<>'null')
then base:=2
else
if (Cells_Collide(x1,y1,x2,y2)='null') and (Cells_Collide(x1,y1,x3,y3)<>'null') and (Cells_Collide(x2,y2,x3,y3)<>'null')
then base:=3
else
base:=0;
ValidPosition:=base;
End;
Function Common_Candidate(Square1,Square2:TCell):smallint;
{This function will be called when a valid XY-wing is found to determine which candidate should be removed from particular cells
Obviously, it's going to be the one that the two Wings share.}
var
i:smallint;
base:smallint;
arr:TArr;
Begin
arr[1]:=Square1[3];
arr[2]:=Square1[4];
arr[3]:=Square2[3];
arr[4]:=Square2[4];
arr[5]:=0;
arr[6]:=0;
for i:=1 to 2 do
begin
if Num_of_Cands(arr,arr[i])=2 then base:=arr[i];
end;
Common_Candidate:=base;
End;
{And finally, here's the actual procedure}
Procedure Find_XY_Wing;
Var
i,j:smallint;
count:integer;
tries1,tries2,tries3:integer;
remove:smallint;
Point1: TPointCell;
Point2: TPointCell;
Point3: TPointCell;
Cell1: TCell;
Cell2: TCell;
Cell3: TCell;
Hinge: TCell;
Wing1: TCell;
Wing2: TCell;
Possibles:TPossibles;
Begin
// Nullify everything and set pointers
Have_Result:=false;
for i:=1 to 4 do
begin
Cell1[i]:=0;
Cell2[i]:=0;
Cell3[i]:=0;
Hinge[i]:=0;
Wing1[i]:=0;
Wing2[i]:=0;
Point1:=@Cell1;
Point2:=@Cell2;
Point3:=@Cell3;
end;
//Fill in Possibles and determine number of pairs;
count:=1;
for i:=1 to 9 do
begin
for j:=1 to 9 do
begin
if Grid[i,j].Num_of_Candidates=2 then
begin
Possibles[count][1]:=i;
Possibles[count][2]:=j;
Possibles[count][3]:=Grid[i,j].Candidates[1];
Possibles[count][4]:=Grid[i,j].Candidates[2];
count :=count+1;
end;
end;
end;
//Check for all possible combination of the pairs on the Grid whether they're valid XY-wings or not. This is loop land...
for tries1:=1 to count do
begin
Point1^:=Possibles[tries1];
for tries2:=1 to count do
begin
if tries2<>tries1 then
begin
Point2^:=Possibles[tries2];
for tries3:=1 to count do
begin
if (tries3<>tries1) and (tries3<>tries2) then
begin
Point3^:=Possibles[tries3];
//Now all pairs have a unique pointer
//Check if they form an XY-Wing based on Candidates and Position
if (ValidCandidates(Point1^,Point2^,Point3^)) and (ValidPosition(Point1^,Point2^,Point3^)<>0) then
begin
if ValidPosition(Point1^,Point2^,Point3^)=1 then
begin
Hinge:=Point1^;
Wing1:=Point2^;
Wing2:=Point3^;
end
else
if ValidPosition(Point1^,Point2^,Point3^)=2 then
begin
Hinge:=Point2^;
Wing1:=Point1^;
Wing2:=Point3^;
end
else
begin
Hinge:=Point3^;
Wing1:=Point1^;
Wing2:=Point2^;
end;
//The XY-Wing is set if found
remove:=Common_Candidate(Wing1,Wing2); //This Candidate will be eliminated
//Go through the grid and find cells from which the candidate should be eliminated
for i:=1 to 9 do
begin
for j:=1 to 9 do
begin
If ( Cells_Collide(i,j,Wing1[1],Wing1[2])<>'null' ) and (Cells_Collide(i,j,Wing2[1],Wing2[2])<>'null' ) then
begin
//Elimination
Eliminate(i,j,remove);
end;
end;
end;
//End of Grid Check
end;
//End of XY-Wing Check
end;
end;
end;
end;
end;
//End of try loop
Point1:=nil;
Point2:=nil;
Point3:=nil;
//Clearing pointers
End; //End of Procedure
Now belive it or not, this mess does work very well, and I didn't even have to debug it too much, there were some minor issues with the basic functions, but not the main procedure. 
Originally Posted by SilverWarior
Making program to solve Sudoku like a human is far from being easy. So if you are novice programmer this might be a bit to much for you now. Now I don't say tht you can't do it but only that it won't be eazy. And if you are not stubbern enough I'm afraid that you might quit in the middle. Belive me I know becouse I was in your position about 5 years ago becouse I was trying to do something that was way beyond my knowledge at that time.
Reply With Quote
Bookmarks