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.