Проверка подстановки чисел в ячейки

function sudInLine(s: TSudoku; p: TPoint; v: integer): boolean; //проверяем можно ли цифру подставить на данное место

var

i: 1..9;

begin

Result: =True;

for i: =1 to 9 do

if p.y< > i then //есть ли данное значение в строке

if s[p.X, i]=v then Exit;

Result: =False;

end;

function sudInRow(s: TSudoku; p: TPoint; v: integer): boolean;

var

i: 1..9;

begin

Result: =True;

for i: =1 to 9 do

if p.x< > i then //есть ли данное значение в столбце

if s[i, p.Y]=v then Exit;

Result: =False;

end;

function sudInSq(s: TSudoku; p: TPoint; v: integer): boolean;

var

ix, iy: 0..8;

lx, ly: 0..8;

begin

lx: =0; ly: =0;

if p.x in [1, 2, 3] then lx: =1; //есть ли данное значение в квадрате

if p.x in [4, 5, 6] then lx: =4;

if p.x in [7, 8, 9] then lx: =7;

lx: =lx-1;

if p.y in [1, 2, 3] then ly: =1;

if p.y in [4, 5, 6] then ly: =4;

if p.y in [7, 8, 9] then ly: =7;

ly: =ly-1;

Result: =True;

for ix: =1 to 3 do

for iy: =1 to 3 do

if (p.x< > lx+ix) and (p.y< > ly+iy) then

if s[lx+ix, ly+iy]=v then Exit;

Result: =False;

end;

function sudInAny(s: TSudoku; p: TPoint; v: integer): boolean; //если цифра есть в линии, столбце или квадрате то мы ее исключаем

begin

Result: =sudInLine(s, p, v) or sudInRow(s, p, v) or sudInSq(s, p, v);

end;

Поиск пустой ячейки

function IsNextUnknown(s: TSudoku; var p: TPoint): boolean; //ищем пустую ячейку

var

ix, iy: 1..9;

begin

Result: =False;

for ix: =1 to 9 do //идем по всем клеткам

for iy: =1 to 9 do

if s[ix, iy]=0 then begin //если значение равно нулю

Result: =True; //то возвращаем координату и выходим с положительный исходом, иначе функция возвращает false

p.X: =ix;

p.Y: =iy;

Exit;

end;

end;

Передача функции судоку координаты указывающей на место где необходимо заменить цифру и значение

function sudMod(s: TSudoku; p: TPoint; v: integer): TSudoku; //передаем функции судоку координату указывающую на место где нужно заменить цифру и значение

var

st: TSudoku;

begin

st: =s;

st[p.x, p.y]: =v;

Result: =st;

end;

Процедура добавления ответа

procedure sudAddAns(s: TSudoku); //добавление ответа

var

l: integer;

begin

l: =Length(ans); //удлинняем массив ответов на один и добавляем судоку из параметра

SetLength(ans, l+1);

ans[l]: =s;

end;

Рекурсия

function DoRec(s: TSudoku): boolean; //рекурсия

var

i: integer;

p: TPoint;

begin

Result: =True;

if IsNextUnknown(s, p) then begin // запуск рекурсий

for i: =1 to 9 do

if not sudInAny(s, p, i) then

if DoRec(sudMod(s, p, i)) then

Exit;

end else begin // сохранение результата

sudAddAns(s);

end;

if Length(ans)< mlen then // не хватает результатов

Result: =False;

end;

Процедура ввода значений в массив

procedure TForm1.ReadInSud; //ввод в массив

var

ix, iy: integer;

CEdit: TEdit;

begin

for iy: =1 to 9 do

for ix: =1 to 9 do begin

CEdit: =CEdits[ix, iy];

if CEdit.Text = '' then

Sud[ix, iy]: = 0

else

Sud[ix, iy]: =StrToInt(CEdit.Text);

end;

end;