``````unit solver;

{This is the solving engine unit of the Sudoku Solver program by Dave Glover.
}

{\$mode objfpc}{\$H+}

interface

uses
Classes, SysUtils, Dialogs;

type puzzlearray = array [0..81] of integer;
missingarray = array [0..10] of integer;
//an array used to check each cell for solvability
//element zero is a count of how many of the numbers 1-9 are missing
//for this cell, element 10 is the last missing digit in the list
//and elements 1 to 9 are flags showing which digits are present.

var
levelcount, highestlevelcount, recursioncount: integer;

function solvepuzzle (grid: puzzlearray): puzzlearray;
Function checkrow(missing : missingarray; grid : puzzlearray; py: integer): missingarray ;
Function checkcol(missing : missingarray; grid : puzzlearray; px: integer): missingarray;
Function checksquare(missing : missingarray; grid : puzzlearray; py, px: integer): missingarray;
Function checkcell(grid: puzzlearray; y, x: integer): missingarray;

implementation

Function checkrow(missing : missingarray; grid : puzzlearray; py: integer): missingarray ;
//called from checkcell, flags any digits from 1-9 that are found in the row
var
i: integer;
begin
for i := ((py-1) * 9) + 1 to ((py-1) * 9) + 9 do
if (grid[i] > 0) then missing[grid[i]] := 1;
result := missing;
end;

Function checkcol(missing : missingarray; grid : puzzlearray; px: integer): missingarray;
//called from checkcell, flags any digits from 1-9 that are found in the column
var
i: integer;
begin
i := px;
while i <= px + 72 do
begin
if (grid[i] > 0) then missing[grid[i]] := 1;
i := i + 9;
end;
result := (missing);
end;
Function checksquare(missing : missingarray; grid : puzzlearray; py, px: integer): missingarray;
//called from checkcell, flags any digits from 1-9 that are found in the 3x3 square

var
sx, sy, y, x, i: integer;
begin
sy := (((py - 1) div 3) * 3) + 1;
sx := (((px - 1) div 3) * 3) + 1;
for y := sy to sy+2 do
for x := sx to sx+2 do
begin
i := ((y-1) * 9) + x;
if (grid[i] > 0) then missing[grid[i]] := 1;
end;
result := (missing);
end;

Function checkcell(grid: puzzlearray; y, x: integer): missingarray;
//checkcell checks a cell for whether it can be solved, keeps a record
//of which digits are missing
//called from solvepuzzle for each unsolved cell
var
missing : missingarray;
j: integer;
//initialsie array
begin
for j:= 0 to 10 do
missing[j] := 0;
//check the row for which digits are present
missing := checkrow(missing, grid, y);
//check the column for which digits are present
missing := checkcol(missing, grid, x);
//check the 3x3 square for which digits are present
missing := checksquare(missing, grid, y, x);

for j := 1 to 9 do
//loop through found digits
begin
if (missing[j] <> 1) then
//if a digit is not present
begin
//keep a count of missing digits
missing := missing + 1;
//record the last missing digit
missing := j;
end;
end;
result := missing;
end;
function solvepuzzle (grid: puzzlearray): puzzlearray;

//main module, called from sudoku.pas, and also recursively from with itself
var
lowestcount, lowestcell, x, y, i: integer;
lowestfoundgrid : missingarray;
missing : missingarray;
newgrid : puzzlearray;
begin
levelcount := levelcount+1;
if levelcount > highestlevelcount then highestlevelcount := levelcount;
recursioncount := recursioncount + 1;
repeat
//loop through whole grid repeatedly until no cell is solved
lowestcount := 100; // set the lowest count to a high number
lowestcell := 0;    //clear the lowest cell found to date
//loop through each cell in the grid looking for a solution to each cell
for y := 1 to 9 do
for x := 1 to 9 do
begin
i := ((y-1) * 9) + x;  //calculate the grid number based on the x and y co-ords
if grid[i] = 0 then
//if the value of the cell is zero, it hasn't been solved yet
begin
//call the module that checks each cell for a solution
missing := checkcell(grid, y, x);
//if the count of missing numbers for this cell is the lowest
//so far, record its details
if (missing <= lowestcount) then
begin
lowestcount := missing;
lowestcell := i;
lowestfoundgrid := missing;
end;
//if the count of missing numbers is 1, then this cell is solvable
if (missing = 1) then
grid[i] := missing;
end;
end
until lowestcount <> 1;

//when no solveable cells are found
case lowestcount of
0: begin //invalid choice, all digits already used when trying to solve cell
//drop back one level to try next number
grid := 1;
end;
100: begin //all cells are solved, drop down 1 level
grid := 0;
end
else
begin //we need to try multiple values in a cell
grid := 1;
for i :=1 to 9 do
//loop through the missing numbers for the last cell with the lowest
//number of choices
if (lowestfoundgrid[i] <> 1) then
begin
//try the digit in this cell
grid[lowestcell] := i;
//call the solver module with this trial grid
newgrid := Solvepuzzle(grid);
if (newgrid = 0) then
//if all solvable cells are solved, keep this grid
//and drop down a level
begin
grid := newgrid;
break;
end;
//otherwise, go back to try  the next number
end;
end;
end;
//drop down to last recursion.
levelcount := levelcount - 1;
result := grid;
end;
end.

``````