**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[0] := missing[0] + 1;
**//record the last missing digit
** missing[10] := 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[0] <= lowestcount) **then
begin
** lowestcount := missing[0];
lowestcell := i;
lowestfoundgrid := missing;
**end**;
**//if the count of missing numbers is 1, then this cell is solvable
****if **(missing[0] = 1) **then
** grid[i] := missing[10];
**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[0] := 1;
**end**;
100: **begin ****//all cells are solved, drop down 1 level
**grid[0] := 0;
**end
else
begin ****//we need to try multiple values in a cell
**grid[0] := 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
****//if this digit is not found
****begin
****//try the digit in this cell
** grid[lowestcell] := i;
**//call the solver module with this trial grid
** newgrid := Solvepuzzle(grid);
**if **(newgrid[0] = 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**.