Возможно ли написать программу для решения сложных судоку?

← →
AKE (2010-07-06 01:43) [0]

сабж...

← →
Германн © (2010-07-06 02:05) [1]

Чем "сложные судоку" сложнее шахмат?
Ничем. Даже наоборот. Никакие судоку не могут сравниться по сложности с шахматами!

← →
Smile (2010-07-06 07:47) [2]

Все уже давно написано:)
http://sources.codenet.ru/file/1599/Sudoku.rar
http://freesoft.ru/get.html?ident=14288&id=668784&file=sudoku.rar

← →
Дмитрий С © (2010-07-06 07:56) [3]

Тупо перебором :)

← →
AKE (2010-07-06 13:44) [4]

Германн © (06.07.10 02:05) [1]
Однако я пока не нашёл рабочих программ, а шахмат уже много...

Smile (06.07.10 07:47) [2]
Эти программы не справляются со сложными судоку, только что проверил...

Дмитрий С © (06.07.10 07:56) [3]
Я посчитал в одной судоку - получается 9, 5 триллионов вариантов. Так что врядли возможно...

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

← →
Dennis I. Komarov © (2010-07-06 13:48) [5]

> Я посчитал в одной судоку - получается 9, 5 триллионов вариантов.
> Так что врядли возможно...

Это каким же образом?

← →
12 © (2010-07-06 13:57) [6]

> 9, 5 триллионов вариантов

не правильно
решать надо исходя из правил - что известно - сразу вычеркивать, сокращать переборы
там останется то - тьфу.

Я писал, но недописал :)

Вообщем, в чем иногда судоку кажутся трудными - что ты не можешь удержать в голове, на всем поле, на какой клетке какой цифры уже быть не может .
Программа подсказывает, а в случае, единственности варианта - открывает.

После всех сокращений, проще самому помочь немного, предположить, что поставить - и тогда моя программа дальше исключала варианты.
Давольно легко щелкал любые судоку, пока не надоело.
Исходники если найду - положу, там и немного то, на 1 батонклике все лежало :)

← →
AKE (2010-07-06 14:00) [7]

Dennis I. Komarov © (06.07.10 13:48) [5]
Просто перемножил количества возможных цифр в каждой клетке.

← →
Kerk © (2010-07-06 14:01) [8]

> 12 © (06.07.10 13:57) [6]
>
> > 9, 5 триллионов вариантов
>
> не правильно
> решать надо исходя из правил - что известно - сразу вычеркивать,
> сокращать переборы

Если выбирать из вариантов, которые соответствуют правилам, то это будет выбор из правильных вариантов :)))
Вопрос-то в том, чтобы их найти сначала.

← →
12 © (2010-07-06 14:09) [9]

> Вопрос-то в том, чтобы их найти сначала.

на всем поле, на всех клетках мелко рисуем все 10 цифр в каждой клетке.
теперь по задаче, стоит, допустим, цифра 4 где то.
Сразу со всех клеток по вертикали и горизонтали исключаем ее.
и так для всех цифр
остаюттся поле, где мелко написаны на клеточках возможные варианты

Как только вариант единственный - пишем туда цифру, и Сразу со всех клеток по вертикали и горизонтали исключаем ее.
Если единственных нет - предлагаем юзеру предположить

предполагаем какую цифру - но на клеточке уже стоит подсказкой, каких тут точно не может быть, т.е. выбирать только из перечисленных
Выбираем, где меньше всего вариантов

и т.п.

Если что - откатываемся на шаг(два-три) назад.

← →
Amoeba_ (2010-07-06 14:17) [10]

http://www.biblprog.org.ua/pages_ru/pages_statti_ru/sudoku/candidates.html
http://www.sudokuessentials.com/sudoku-strategy.html

← →
Dennis I. Komarov © (2010-07-06 14:18) [11]

> Просто перемножил количества возможных цифр в каждой клетке.

Это не логично... Перебирать заведомо неверные варианты...

← →
Amoeba_ (2010-07-06 14:18) [12]

http://www.setbb.com/phpbb/?mforum=sudoku

← →
Amoeba_ (2010-07-06 14:21) [13]

http://www.sudokuessentials.com/sudoku_tips.html

← →
Юрий Зотов © (2010-07-06 15:08) [14]

Алгоритм отгадывания судоку не в том,чтобы искать правильные ходы, а в том, чтобы исключать неправильные. Работает железно.

Каждой клетке сопоставляем одномерный массив 1..9. Идем в двойном цикле по всем клеткам и в каждой свободной клетке заполняем этот массив цифрами, которых в этой клетке заведомо быть НЕ может. Если судоку составлен правильно, то после завершения прохода обязательно найдется свободная клетка, в которой этот массив заполнен 8-ю цифрами - значит, в этой клетке стоит оставшаяся 9-я цифра. Ставим ее и повторяем все сначала.

← →
Dennis I. Komarov © (2010-07-06 15:19) [15]

> Каждой клетке сопоставляем одномерный массив 1..9.

Хватит и простого целого размерностью > 9 bit :)

← →
Sha © (2010-07-06 15:23) [16]

> Юрий Зотов © (06.07.10 15:08) [14]

код давай :)

← →
12 © (2010-07-06 16:48) [17]

вот, нашел
на форму ложим stringgrid и 4ре кнопки
потом код ниже
запускаем

В сетке заполняем ячейки, вместо 123456789 - то что в задаче,
и жмем Step пока не перестанут изменятся

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
M:array of array[0..8,0..8] of string;
mk:integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i,j:integer;
begin
for i:=0 to stringgrid1.ColCount-1 do
for j:=0 to stringgrid1.RowCount-1 do
begin
stringgrid1.Cells[i,j]:="123456789";
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
i,j,k:integer;

procedure exVertHorizSqr(a,b:integer; c:char);
var
ii,jj:integer;
fr: TReplaceFlags;
begin
fr:=fr + [rfReplaceAll];
//horiz
for ii:=0 to stringgrid1.ColCount-1 do stringgrid1.Cells[ii,b]:=stringreplace(stringgrid1.Cells[ii,b],c,"",fr);
//vert
for ii:=0 to stringgrid1.RowCount-1 do stringgrid1.Cells[a,ii]:=stringreplace(stringgrid1.Cells[a,ii],c,"",fr);
if (b<3) then begin
if a<3 then
for ii:=0 to 2 do
for jj:=0 to 2 do stringgrid1.Cells[jj,ii]:=stringreplace(stringgrid1.Cells[jj,ii],c,"",fr);
if ((a>2)and(a<6)) then
for ii:=0 to 2 do
for jj:=3 to 5 do stringgrid1.Cells[jj,ii]:=stringreplace(stringgrid1.Cells[jj,ii],c,"",fr);
if (a>5) then
for ii:=0 to 2 do
for jj:=6 to 8 do stringgrid1.Cells[jj,ii]:=stringreplace(stringgrid1.Cells[jj,ii],c,"",fr);
end;
if ((b>2)and(b<6)) then begin
if a<3 then
for ii:=3 to 5 do
for jj:=0 to 2 do stringgrid1.Cells[jj,ii]:=stringreplace(stringgrid1.Cells[jj,ii],c,"",fr);
if ((a>2)and(a<6)) then
for ii:=3 to 5 do
for jj:=3 to 5 do stringgrid1.Cells[jj,ii]:=stringreplace(stringgrid1.Cells[jj,ii],c,"",fr);
if (a>5) then
for ii:=3 to 5 do
for jj:=6 to 8 do stringgrid1.Cells[jj,ii]:=stringreplace(stringgrid1.Cells[jj,ii],c,"",fr);
end;
if (b>5) then begin
if a<3 then
for ii:=6 to 8 do
for jj:=0 to 2 do stringgrid1.Cells[jj,ii]:=stringreplace(stringgrid1.Cells[jj,ii],c,"",fr);
if ((a>2)and(a<6)) then
for ii:=6 to 8 do
for jj:=3 to 5 do stringgrid1.Cells[jj,ii]:=stringreplace(stringgrid1.Cells[jj,ii],c,"",fr);
if (a>5) then
for ii:=6 to 8 do
for jj:=6 to 8 do stringgrid1.Cells[jj,ii]:=stringreplace(stringgrid1.Cells[jj,ii],c,"",fr);
end;

stringgrid1.Cells[a,b]:=c;
end;

function ExpVHS(a,b:integer;c:char):boolean;
var
ii,jj,bol2:integer;
bol:boolean;
begin
if length(stringgrid1.Cells[a,b])<2 then begin result:=false; exit; end;
bol:=false;
// horiz
for ii:=0 to a-1 do if pos(c,stringgrid1.Cells[ii,b])<>0 then bol:=bol or true;
for ii:=a+1 to stringgrid1.ColCount-1 do if pos(c,stringgrid1.Cells[ii,b])<>0 then bol:=bol or true;
if not(bol) then begin result:=not(bol); exit; end;
//vert
bol:=false;
for ii:=0 to b-1 do if pos(c,stringgrid1.Cells[a,ii])<>0 then bol:=bol or true;
for ii:=b+1 to stringgrid1.RowCount-1 do if pos(c,stringgrid1.Cells[a,ii])<>0 then bol:=bol or true;
if not(bol) then begin result:=not(bol); exit; end;

//sqr
bol2:=0;
if (b<3)
then begin
if a<3 then
for ii:=0 to 2 do
for jj:=0 to 2 do
if pos(c,stringgrid1.Cells[jj,ii])<>0 then inc(bol2);
if ((a>2)and(a<6)) then
for ii:=0 to 2 do
for jj:=3 to 5 do
if pos(c,stringgrid1.Cells[jj,ii])<>0 then inc(bol2);
if (a>5) then
for ii:=0 to 2 do
for jj:=6 to 8 do
if pos(c,stringgrid1.Cells[jj,ii])<>0 then inc(bol2);
end; //b<3
if ((b>2)and(b<6))
then begin
if a<3 then
for ii:=3 to 5 do
for jj:=0 to 2 do
if pos(c,stringgrid1.Cells[jj,ii])<>0 then inc(bol2);
if ((a>2)and(a<6)) then
for ii:=3 to 5 do
for jj:=3 to 5 do
if pos(c,stringgrid1.Cells[jj,ii])<>0 then inc(bol2);
if (a>5) then
for ii:=3 to 5 do
for jj:=6 to 8 do
if pos(c,stringgrid1.Cells[jj,ii])<>0 then inc(bol2);
end; //((b>2)and(b<6))
if (b>5)
then begin
if a<3 then
for ii:=6 to 8 do
for jj:=0 to 2 do
if pos(c,stringgrid1.Cells[jj,ii])<>0 then inc(bol2);
if ((a>2)and(a<6)) then
for ii:=6 to 8 do
for jj:=3 to 5 do
if pos(c,stringgrid1.Cells[jj,ii])<>0 then inc(bol2);
if (a>5) then
for ii:=6 to 8 do
for jj:=6 to 8 do
if pos(c,stringgrid1.Cells[jj,ii])<>0 then inc(bol2);
end; //b>5
if bol2>1 then result:=false
else result:=true;
end;

begin
//in memory
mk:=mk+1;
setlength(M,mk+1);
for i:=0 to stringgrid1.ColCount-1 do
for j:=0 to stringgrid1.RowCount-1 do M[mk][i,j]:=stringgrid1.Cells[i,j];

for i:=0 to stringgrid1.ColCount-1 do
for j:=0 to stringgrid1.RowCount-1 do
if length(stringgrid1.Cells[i,j])=1 then exVertHorizSqr(i,j,stringgrid1.Cells[i,j][1]);

for i:=0 to stringgrid1.ColCount-1 do
for j:=0 to stringgrid1.RowCount-1 do
for k:=1 to length(stringgrid1.Cells[i,j]) do
if ExpVHS(i,j,stringgrid1.Cells[i,j][k])
then begin
stringgrid1.Cells[i,j]:=stringgrid1.Cells[i,j][k];
break;
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
i,j:integer;
begin
stringgrid1.ColCount := 9;
stringgrid1.RowCount := 9;
stringgrid1.Options := [goEditing];
stringgrid1.DefaultColWidth := 60;
stringgrid1.DefaultRowHeight := 60;
button1.Caption := "New";
button2.Caption := "Step";
button3.Caption := "забыл зачем";
button4.Caption := "выход";

for i:=0 to stringgrid1.ColCount-1 do
for j:=0 to stringgrid1.RowCount-1 do
begin
stringgrid1.Cells[i,j]:="123456789";
end;
mk:=0;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
i,j:integer;
begin
mk:=mk-1;
setlength(M,mk+1);
for i:=0 to stringgrid1.ColCount-1 do
for j:=0 to stringgrid1.RowCount-1 do stringgrid1.Cells[i,j]:=M[mk][i,j];
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
close;
end;

← →
Dennis I. Komarov © (2010-07-06 17:30) [18]

> 12 © (06.07.10 16:48) [17]

ой, мама :)

← →
Dennis I. Komarov © (2010-07-06 17:45) [19]

← →
AKE (2010-07-06 17:53) [20]

unit SudokuU; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, Grids, ExtCtrls; type TForm1 = class(TForm) bb: TBitBtn; bbCancel: TBitBtn; Bevel1: TBevel; Bevel2: TBevel; Bevel3: TBevel; Bevel4: TBevel; Edit1: TEdit; BitBtn1: TBitBtn; procedure bbClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure bbCancelClick(Sender: TObject); procedure Edit1Enter(Sender: TObject); procedure BitBtn1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; type TItem = array[1..9] of Boolean; TSource = array[1..9, 1..9] of Integer; TArr = array[1..9, 1..9] of TItem; var Form1: TForm1; Arr : TArr; Source: TSource; Edits: array[1..9, 1..9] of TEdit; implementation {$R *.dfm} function iBlock(i: Integer): integer; begin Result := i div 3; if (i mod 3) <> 0 then Inc(Result); end; function jBlock(j: Integer): integer; begin Result := j div 3; if (j mod 3) <> 0 then Inc(Result); end; procedure ReadToArray; var p: integer; ib, jb: integer; i_, j_: integer; i,j: integer; begin for i := 1 to 9 do for j := 1 to 9 do begin if (Source[i,j] = 0) then begin //ñêàíèðóåì ñòîëáåö for p := 1 to 9 do begin if ((p <> i) and (Source[p,j] > 0)) then Arr[i,j][Source[p,j]] := False; end; //ñêàíèðóåì ñòðîêó for p := 1 to 9 do begin if ((p <> j) and (Source[i,p] > 0)) then Arr[i,j][Source[i,p]] := False; end; ib := iBlock(i); jb := jBlock(j); //ñêàíèðóåì áëîê for i_ := ib*3-2 to ib*3 do for j_ := jb*3-2 to jb*3 do begin if (((i<>i_) or (j<>j_)) and (Source[i_, j_] > 0)) then begin Arr[i,j][Source[i_, j_]] := False; end; end; end; end; end; function Equals(i1, i2: Titem): boolean; var i: integer; begin Result := True; for i := 1 to 9 do if i1[i] <> i2[i] then Result := False; end; function Size(it: TItem): integer; var i: integer; begin Result := 0; for i := 1 to 9 do begin if it[i] then Inc(Result); end; end; function Solved(var Source: TSource): Boolean; var i, j: integer; begin Result := True; for i := 1 to 9 do for j := 1 to 9 do begin if Source[i, j] = 0 then begin Result := False; Exit; end; end; end; function Correct(var Source: TSource): Boolean; var i, j, p: integer; i_, j_ : integer; k, d : integer; Item : integer; begin Result := True; for i := 1 to 9 do for j := 1 to 9 do begin if (Source[i, j]=0) then begin Result := False; exit; end; Item := Source[i, j]; for p := 1 to 9 do if (Source[i, p] = Item) and (p <> j) then begin Result := False; exit; end; end; for j := 1 to 9 do for i := 1 to 9 do begin Item := Source[i, j]; for p := 1 to 9 do if (Source[p, j] = Item) and (p <> i) then begin Result := False; exit; end; end; for i := 1 to 3 do for j := 1 to 3 do begin for i_ := i*3-2 to i*3 do for j_ := j*3-2 to j*3 do begin Item := Source[i_, j_]; for k := i*3-2 to i*3 do for d := j*3-2 to j*3 do begin if ((k<>i_) or (d<>j_)) and (Source[k, d] = Item) then begin Result := False; exit; end; end; end; end; end; function FindFirst(item: TItem):integer; begin for Result := 1 to 9 do if item[Result] then break; end;

← →
AKE (2010-07-06 17:53) [21]

function Work(Arr: TArr; Source: TSource): TSource; var i, j, p, r, last: integer; count: array[1..9] of integer; Arr2 : TArr; S2 : TSource; ib, jb: integer; i_, j_: integer; Item : TItem; C : integer; k, d : integer; begin //While not Solved(Source) do //begin for i := 1 to 9 do for j := 1 to 9 do begin r := 0; //count of uncoincidence for p := 1 to 9 do begin if (Arr[i, j][p]) then begin Inc(r); last := p; end; end; if (r = 1) then Source[i, j] := last; end; //Analyse1 //String scan for i := 1 to 9 do begin for p := 1 to 9 do begin Item := Arr[i, p]; C := 0; for j := 1 to 9 do begin if Equals(Item, Arr[i, j]) then Inc(C); end; if (C = Size(Item)) then for r := 1 to 9 do begin if (Item[r]) then for j := 1 to 9 do begin if not Equals(Item, Arr[i, j]) then Arr[i,j][r] := False; end; end; end; end; //Row scan for j := 1 to 9 do begin for p := 1 to 9 do begin Item := Arr[p, j]; C := 0; for i := 1 to 9 do begin if Equals(Item, Arr[i, j]) then Inc(C); end; if (C = Size(Item)) then for r := 1 to 9 do begin if (Item[r]) then for i := 1 to 9 do begin if not Equals(Item, Arr[i, j]) then Arr[i,j][r] := False; end; end; end; end; //Block scan for i := 1 to 3 do for j := 1 to 3 do begin //ñêàíèðóåì áëîê for i_ := i*3-2 to i*3 do for j_ := j*3-2 to j*3 do BEGIN Item := Arr[i_, j_]; C := 0; for k := i*3-2 to i*3 do for d := j*3-2 to j*3 do begin if Equals(Item, Arr[k, d]) then Inc(C); end; if (C = Size(Item)) then for r := 1 to 9 do begin if (Item[r]) then begin for k := i*3-2 to i*3 do for d := j*3-2 to j*3 do begin if not Equals(Item, Arr[k, d]) then Arr[k, d][r] := False; end; end; end; END; end; if Solved(Source) then begin Result := Source; exit; end; for i := 1 to 9 do for j := 1 to 9 do BEGIN r := Source[i, j]; if (r = 0) then begin if Size(Arr[i,j]) = 1 then begin Source[i, j] := FindFirst(Arr[i,j]); continue; end; k := 1; While (k < 10) do begin While not Arr[i,j][k] do Inc(k); S2 := Source; Arr2 := Arr; S2[i, j] := k; Arr2[i,j][k] := False; for p := 1 to 9 do Arr2[i, p][k] := False; for p := 1 to 9 do Arr2[p, j][k] := False; ib := iblock(i); jb := jblock(j); for p := ib*3-2 to ib*3 do for d := jb*3-2 to jb*3 do begin Arr2[p, d][k] := False; end; S2 := Work(Arr2, S2); If Correct(S2) then begin Result := S2; exit; end; Inc(k); end; end; END; // end; Result := Source; end; procedure TForm1.bbClick(Sender: TObject); var i, j, p, r, last: integer; count: array[1..9] of integer; ib, jb: integer; i_, j_: integer; Item : TItem; C : integer; k, d : integer; B : Boolean; begin for i := 1 to 9 do for j := 1 to 9 do begin if Trim(Edits[i, j].Text) = "" then begin Source[i,j] := 0; Edits[i,j].Font.Style := [fsBold]; Edits[i,j].Font.Color := clBlack; end else begin r := StrToInt(Trim(Edits[i, j].Text)); if not (r in [1..9]) then begin ShowMessage("Incorrect numbers."); exit; end; Source[i,j] := r; end; for p := 1 to 9 do Arr[i,j][p] := True; end; ReadToArray; Source := Work(Arr, Source); //print results for i := 1 to 9 do for j := 1 to 9 do begin Edits[i,j].Text := IntToStr(Source[i,j]); end; end; procedure TForm1.FormShow(Sender: TObject); var i, j: integer; begin for i := 1 to 9 do for j := 1 to 9 do begin Edits[i,j] := TEdit.Create(self); Edits[i,j].Width := 20; Edits[i,j].Height := 20; Edits[i,j].Left := 5 + j * 25; Edits[i,j].Top := 5 + i * 25; Edits[i,j].Name := "edit" + IntToStr(i) + IntToStr(j); Edits[i,j].Text := ""; Edits[i,j].OnEnter:= Edit1Enter; Edits[i,j].Font.Color := clGray; Edits[i,j].Parent := self; end; end; procedure TForm1.FormDestroy(Sender: TObject); var i, j: integer; begin for i := 1 to 9 do for j := 1 to 9 do begin Edits[i,j].Free(); end; end; procedure TForm1.bbCancelClick(Sender: TObject); begin Close; end; procedure TForm1.Edit1Enter(Sender: TObject); begin (Sender as TEdit).Font.Color := clGray; end; procedure TForm1.BitBtn1Click(Sender: TObject); var i, j: integer; begin for i := 1 to 9 do for j := 1 to 9 do begin Edits[i,j].Clear; end; end; end.

← →
AKE (2010-07-06 17:54) [22]

Это код моего решения, но не работает на сложных судоку...

← →
Mystic © (2010-07-06 17:59) [23]

> Если судоку составлен правильно, то после завершения прохода
> обязательно найдется свободная клетка, в которой этот массив
> заполнен 8-ю цифрами - значит, в этой клетке стоит оставшаяся
> 9-я цифра.

Вполне возможно, что решение у судоку единственное, но на определенном шаге нельзя сделать ни одного исключения. По крайней мере легко доказать это нельзя. Так что, по хорошему, надо в таких случаях перебирать варианты и делать откаты.

← →
Mystic © (2010-07-06 17:59) [24]

> Это код моего решения, но не работает на сложных судоку.
> ..

Сложные это какие?

← →
Dennis I. Komarov © (2010-07-06 18:01) [25]

А не будет он всегда работать, потому как кроме есть в столбце, есть в строке, есть в квадратике, есть еще более сложные условия. Если суметь их закодить, то будет счастье...

← →
AKE (2010-07-06 19:12) [26]

Сложные это какие?
Например:
000208000
029070680
040000090
100000005
080000040
600000007
010000030
095010260
000407000

← →
Плохиш © (2010-07-06 22:15) [27]

> AKE (06.07.10 19:12) [26]
>
> Сложные это какие?
> Например:

Хороший наборчик :-)
15 минут, сделал 6 предположений, одно было неправильным, пришлось шагов на 15 откатываться. Разгадывал на встроеной судоку в Neonode N2 с включёнными всеми подсказками.

PS. Осталось разработать алгоритм расчёта весов каждой цифры в каждой клетке для предположений, ну и запоминать шаг предположения для возможного отката.

> Юрий Зотов © (06.07.10 15:08) [14]

> Каждой клетке сопоставляем одномерный массив 1..9. Идем
> в двойном цикле по всем клеткам и в каждой свободной клетке
> заполняем этот массив цифрами, которых в этой клетке заведомо
> быть НЕ может. Если судоку составлен правильно, то после
> завершения прохода обязательно найдется свободная клетка,
> в которой этот массив заполнен 8-ю цифрами - значит, в
> этой клетке стоит оставшаяся 9-я цифра. Ставим ее и повторяем
> все сначала.

Мой neonode начиная со сложного уровня такие варианты очень редко прелагает :-)

← →
Sha © (2010-07-06 22:31) [28]

http://arild.madscience.dk/?p=50

Приблизительно так:
Запустили алгоритм перебора (АП1) по правилам строка, столбец, 3х3.
Как только проход по всем ячейкам не приносит никаких изменений
Ищем ячейку в которой есть минимальное количество возможных вариантов (к примеру пусть 2)
Далее запоминаем исходную матрицу и для каждого возможного варианта в этой ячейки запускаем АП1. Если в результате АП1 для какого то значение получаем, что в некой ячейке нет возможных вариантов, то следовательно наше предположение не верно и исключаем это число из сохраненной матрицы. Если такого варианта ни для одного из предполагаемых значений мы не получили, то ищем следующую ячейку с минмальным кол-вом вариантов и для нее тоже самое. и т.д.
После опять АП1...

Дайте не по-детски сложное судоку :)

Т.е. такое, которое вы не смогли решить,
не делая многочисленных предположений
относительно значений в разных ячейках.

[26] и http://rus.postimees.ee/081106/glavnaja/razvlechenija/7603_foto.php
не предлагать, Johnmen щелкает их как орехи.

"Супер сложные судоку"
http://sudokuprint.ru/archive/2010/extream/2/

> и http://rus.postimees.ee/081106/glavnaja/razvlechenija/7603_foto.
> php

Финский математик Арто Инкала заявил о создании самой сложной в мире головоломки судоку с миллиардом комбинаций, составление которой заняло три месяца работы.

Вот это приписки у финских математиков 8-O ажно 6 нулей с права :-))

>
"Супер сложные судоку"
http://sudokuprint.ru

сейчас, с помощью своей прожки, сегодняшнее самое сложное, решилось с помощью одного предположения.
второй ряд слева, самое верхнее - был выбор 1 или 5, предположил (блин, забыл чего предположил.. 1 или 5 :), не важно )
далее все разрулилось само.

Прошу критически оценить логику, ну и потестить немного

http://depositfiles.com/files/36ir1gvut

Вобщем реализация сабжа.
Инструкция: Загружаем *.sdc, жмем "X", "Y" до тех пор, пока или найдено решение или нет никаких изменений. Если 2-е жмем "B".
З.Ы. D2006

> Dennis I. Komarov © (10.07.10 11:17) [35]
> потестить немного

1. Не понял, как заполнить поле своими числами.

2. А почему программа не может сама нажимать "X", "Y", "B"?

> Прошу критически оценить логику

1. Логика, гарантированно дающая решение, может быть найдена в [28].
В конце статьи Pascal-исходник, который после минимальных изменений работает в Delphi7.

2. Если не нравятся танцующие звенья, то легко написать аналогичный "нативный" алгоритм, например:

function SolveTask: boolean; var CellNo, CellVal: integer; begin; Result:=false; CellNo:=NextCellNo; while CellNo>=0 do begin; CellVal:=1; while not SetCell(CellNo, CellVal) do begin; while CellVal>=Values[BoardSize-1] do begin; CellNo:=PrevCellNo(CellVal); if CellNo<0 then exit; end; CellVal:=CellVal+CellVal; end; CellNo:=NextCellNo; end; Result:=true; end; function NextCellNo: integer; function PrevCellNo(var PrevCellVal: integer): integer; function SetCell(CellNo, CellVal: integer): boolean;

← →
Dennis I. Komarov (htc) (2010-07-10 12:13) [37]

Цель была написать с нуля. Интересно проверить логику решения, а написать GUI, и научить нажиимать нужные кнопки - дело десятое...

← →
Dennis I. Komarov (htc) (2010-07-10 12:41) [38]

← →
Dennis I. Komarov (htc) (2010-07-10 13:51) [39]

← →
AKE (2010-07-11 18:39) [40]

Возможно ли написать программу для решения сложных судоку? Найти похожие ветки