Судоку на Делфи

[Killerkod]

В общем суть такова, получил задание, написать программу, которая будет решать судоку. Просто тупо программу с 81 клеткой, и при нажатии кнопки чтоб все клетки правильно заполнялись.
Вроде написал...
Исходник приложил.
Вроде заполняет, все правильно.. но остаются нули, которые она заполнить не может, т.к. уже будет неверно... Т.е. расположение цифр идет неверное... Гланьте сорс, помогите решить... Желательно с пояснениями)))
П.С. прошу не предлагать чужие сорсы, мне самому охото написать... чтоб полностью понять это...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  CEdits:array[1..9,1..9] of TEdit;
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);  
var  
  i1,i2:integer;
begin
  for i2:=1 to 9 do
    for i1:=1 to 9 do begin
      CEdits[i1,i2]:=TEdit.Create(self);
      with CEdits[i1,i2] do begin
        Parent:=self;  
        Left:= (i1 - 1) * 25 + 5;
        Top:= (i2 - 1) * 25 + 5;
        Width:= 20;
        Text:='0';
      end;
    end;
end;

function sudInSq(x,y,ch:integer):boolean;
var  
  ix,iy:0..8;  
  lx,ly:0..8;
begin  
  lx:=0; ly:=0;  
  if x in [1,2,3] then lx:=1;
  if x in [4,5,6] then lx:=4;
  if x in [7,8,9] then lx:=7;
  lx:=lx-1;  
  if y in [1,2,3] then ly:=1;
  if y in [4,5,6] then ly:=4;
  if 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 (x<>lx+ix) and (y<>ly+iy) then
        if Cedits[lx+ix,ly+iy].text=IntToStr(ch) then Exit;
  Result:=False;  
end;


function prov_lin(x, ch:integer):boolean;
var
  i:integer;
begin
for i:=1 to 9 do     //1
begin
  if Cedits[x,i].text= IntToStr(ch) then  //2
  begin
  Result:=true;
  Exit;
  end;   //2
end;//1
Result:=false;
end;

function prov_st(ch, y:integer):boolean;
var
  i:integer;
begin
for i:=1 to 9 do     //1
begin
  if Cedits[i,y].text= IntToStr(ch) then  //2
  begin
  Result:=true;
  Exit;
  end;   //2
end;//1
Result:=false;
end;

function prov_all(ch,x,y:integer):boolean;
begin
result:= prov_lin(x,ch) or  prov_st(ch, y) or sudInSq(x,y,ch);
end;

procedure zapis(x,y:integer);
var
i:integer;
begin
       for i:=1 to 9 do begin
       if not prov_all(i,x,y) then
       Cedits[x,y].Text:=IntToStr(i);
       end;
end;

procedure poisk;
var
 x,y,i:integer;
begin
for x:=1 to 9 do
  for y:=1 to 9 do
    if cedits[x,y].Text='0' then
    zapis(x,y);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
poisk;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Pen.Width:=3;
  Canvas.MoveTo(1,1);
  Canvas.LineTo(228,1);
  Canvas.LineTo(228,230);
  Canvas.LineTo(1,230);
  Canvas.LineTo(1,1);
  Canvas.Pen.Width:=2;
  Canvas.MoveTo(1,75+2);
  Canvas.LineTo(228,75+2);
  Canvas.MoveTo(2,75*2+2);
  Canvas.LineTo(228,75*2+2);
  Canvas.MoveTo(75+2,1);
  Canvas.LineTo(75+2,230);
  Canvas.MoveTo(75*2+2,2);
  Canvas.LineTo(75*2+2,230);

end;

end.

[Serge_Bliznykov]

1) замечание не по существу. Гораздо нагляднее, если незаполенные ячейку будут заполнены не нулями, а пустой строкой.
Для этого в процедуре на onCreate:

      with CEdits[i1, i2] do begin
        Parent := self;
        Left := (i1 - 1) * 25 + 5;
        Top := (i2 - 1) * 25 + 5;
        Width := 20;
        Text := '';
      end;

а в процедуре poisk:

      if (cedits[x, y].Text = '0')
        or (cedits[x, y].Text = '') then
        zapis(x, y);

НО! Это всё "красивости".
Проблему это не решает.
А проблема в том, что у Вас не заполненными остаются ячейки, которые заполнить НЕВОЗМОЖНО. (попробуйте придумать, какое число должно быть вписано и убедитесь, что это число пересекается с таким же числом по горизонтали или вертикали)...
К сожалению, менять нужно алгоритм заполнения.
Поищите в сети, думаю, что здесь должны быть алгоритмы с возвратом (может быть, даже рекурсивные)... т.е. если пришли к тупиковой ситауции, значит нужно возвращаться на предыдущий шаг - такая расстановка недопустима, пробовать другой вариант.. Если на текущем шаге все варианты перебраны и все не приводят к решению, значит надо возвращаться на предыдущий шаг - такая расстановка недопустима, надо пробовать следущий вариант расстановки и т.д... вплоть до первого шага (это значит, что предложенное начальное заполнение поля НЕ ИМЕЕТ решения!)

[Killerkod]

насчет ноликов, просто так удобнее было мне... не знаю почему))
я понимаю, что если не заполняется, значит нет решения...
а с возвратом не понимаю если чесно... не делал такого...

[Serge_Bliznykov]

два вопроса Вам.
1) А Вы самостоятельно писали код формировани поля Судоку? почему спрашиваю - поиск алгоритма решения сразу дал статейку, в которой используется данный способ. Более того, названия массивов совпадают..
Так что, корни 100% из одного места растут...

2) в этой статье есть и алгоритм решения.
Не пробовали разобраться?..

вот, собственно, вышеупомянутая статья:
Алгоритм решения судоку на delphi Delphi блог Димаса

[Alex Cones]

Алгоритм таков:
Первая волна - заполняются ячейки, которые 100% имеют 1 вариант.
Вторая волна - проходим еще раз точно так же (поле изменилось)
Третья .. нная волны - аналогично, пока не наткнемся на ситуацию, когда будут варианты для всех ячеек.
Тогда берем поле, копируем в память несколько копий по количеству вариантов. Берем первую вариантную ячейку и в каждой копии ставим разную цифру. Затем пытаемся заполнить поле стандартным методом. Если противоречия идут - копия удаляется. Аналогично идем дальше, пока не останется только одна копия и поле не будет заполнено.

[Killerkod]

Сообщение от Serge_Bliznykov

два вопроса Вам.
1) А Вы самостоятельно писали код формировани поля Судоку? почему спрашиваю - поиск алгоритма решения сразу дал статейку, в которой используется данный способ. Более того, названия массивов совпадают..
Так что, корни 100% из одного места растут...

2) в этой статье есть и алгоритм решения.
Не пробовали разобраться?..

вот, собственно, вышеупомянутая статья:
Алгоритм решения судоку на delphi Delphi блог Димаса

Да, пару функций взято оттуда... Но код тяжеловат для меня там если чесно))) Так что вот пытаюсь его разобрать, но не очень получается))
Я сделал поиск попроще, ну и запись... без всего лишнего...

[FILA]

А как можно сделать, чтобы в Edit выводились случайные числа и можно было бы сделать так: Тяжелый уровень, Среднии и Легкии...подскажите ожалуйста.

[evg_m]

смотри тут