Решаем судоку на delphi
Решаем судоку на delphi.
Готовая программа и исходники:
скачать
скачать
другие исходники (целый каталог)
Задался я как-то целью написать одну программу… В общем, чтоб решала головоломки судоку. Кто не знает что это такое, в поиске картинок вводим это слово и видим квадрат 9 на 9 клеток, в некоторых стоят цифры 1, 2, 3, … или 9. Сам принцип найдете в гугле, описывать подробно не буду.
Итак, пишем на delphi. Я использую седьмую версию. С чего же начать?
1. Приготовления.
1.1. Глобальные типы и переменные.
Теперь условимся так: само судоку будем располагать в двумерном массиве 9 на 9. Каждый элемент массива будет содержать соотвествующую цифру, или 0, если нам неизвестно, что же за таинственная цифра там скрывается…
Да,
type TSudoku = array[1..9,1..9] of 0..9; var Sud:TSudoku; Ans:array of TSudoku; CEdits:array[1..9,1..9] of TEdit;
В Sud будем вносить введенное пользователем судоку, об этом чуть позже.
Про CEdits тоже чуть позже.
Ans — динамический массив элементов типа TSudoku, сюда будем заносить ответы (решение не всегда одно).
1.2. Ввод.
Как же пользователь будет вводить элементы? Можно, конечно, заставить вводить по очереди каждый элемент, но разве это правое дело? Неа. Можно расставить 81 TEdit на форме, тож тупо.
Мы же создадим при старте 81 поле ввода, для этого нам и нужен описанный выше массив CEdits.
По моей задумке, при вводе цифры в одно поле, фокус должен перескакивать на следующее, для этого к каждому из TEdit надо присвоить событие. Ставим на форму TEdit, называем просто Edit, создаем к нему событие OnKeyPress, в функции ставим комментарий, чтобы компилятор её не удалил. Теперь смело удаляем Edit. Да, это извращение, но так удобней. Код на событии напишем чуть позже.
Теперь наша задача — создать все 81 TEdit, на этом углубляться не буду, вот то, что пишем на OnCreate формы:
procedure TForm1.FormCreate(Sender: TObject); var ix,iy:integer; begin for iy:=1 to 9 do for ix:=1 to 9 do begin CEdits[ix,iy]:=TEdit.Create(self); with CEdits[ix,iy] do begin Parent:=self; Left:= (ix - 1) * 30 + 5; Top:= (iy - 1) * 30 + 5; Width:= 25; Color:= self.Color; MaxLength:= 1; Ctl3D:= False; OnKeyPress:=EditKeyPress; end; // with end; // for, ix end;
Думаю, что всё предельно ясно.
Далее… Создадим TComboBox по имени cmbMode, стиль csDropDownList, в Items добавляем «исходное», ItemIndex — 0.
Создаем кнопку с надписью Решить, вот в чем соль) Забыл добавить, оба объекта на высоте 272.
Ну и TRadioGroup grpAns с двумя элементами «одно» и «до тысячи». То есть мы будем задавать программе, искать одно решение или все, но не больше тысячи. Если пользователь введет мало цифр, и решений окажется ну очень много, программа просто не будет отвечать очень долго и пользователь не дождется своих 2^50 решений.
Ах да,
procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char); var ci:integer; ix,iy:integer; CEdit:TEdit; begin for iy:=1 to 9 do for ix:=1 to 9 do if Sender is TEdit then if (Sender as TEdit)=CEdits[ix,iy] then CEdit:=CEdits[ix,iy]; if (Sender as TEdit)=CEdits[9,9] then Exit; if Pos(Key,'0123456789'#8) = 0 then // фильтруем Key:= #0; if Key <> #8 then begin ci:=CEdit.ComponentIndex; (self.Components[ci+1] as TEdit).SetFocus; end; // if end;
Тут мы определяем у какого элемента произошло событие, переходим на следующий, если он не был последним, конечно.
Далее если пользователь ввел не цифру и не backspace, не пропускаем. А если ввел не backspace (что угодно), то переходим на следующий. Вот так вот, да.
Что-то я больно заболтался и углубился во всякие мелочи. Итак, ввод в массив:
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; // for end;
и не забываем
type TForm1 = class(TForm) ... procedure ReadInSud; ... end;
Вывод из массива на поле:
procedure TForm1.sudFill(s:TSudoku); var ix,iy:integer; begin for iy:=1 to 9 do for ix:=1 to 9 do CEdits[ix,iy].Text:=IntToStr(S[ix,iy]); end;
1.3. Работа с массивом.
Приведу функции для работы с массивом TSudoku. Каждая выполняет одно, очень простое действие, но незаменима в дальнейшем.
Добавление ответа:
procedure sudAddAns(s:TSudoku); var l:integer; begin l:=Length(ans); SetLength(ans,l+1); ans[l]:=s; 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;
Передаем функции судоку, координату, указывающее на то, на каком месте цифру надо заменить, и значение. TPoint, как известно, это сложный тип, содержащий целочисленные значения x и y. Ну и сама функция тоже возвращает судоку, только с уже измененным значением.
Ищем пустую клетку:
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; p.X:=ix; p.Y:=iy; Exit; end; // if end;
Т.е. идем по всем клеткам, если значение равно нулю, возвращаем координату и выходим с положительным исходом, иначе этого не происходит и функция возвращает false.
Проверяем, можно ли цифру подставить на данное место:
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;
Первые три функции проверяют, есть ли данное значение в строке, столбце, или квадрате. Да, где я проверял относительно квадрата, вместо трех if лучше использовать div, чем ты, дорогой читатель, сейчас и займешься, надо же попрактиковаться, мне было влом думать, писать -1, +1 или +3.
Функция sudInAny является обобщением, если цифра есть в линии, столбце или квадрате, то она нам не подходит.
Да, значение в ячейке, на которую указывает структура p, не принимается во внимание, чтобы не находить себя.
И последнее в этом пункте,
function IsValidSudoku(s:TSudoku):boolean; var ix,iy:integer; p:TPoint; begin for ix:=1 to 9 do for iy:=1 to 9 do begin p.X:=ix; p.Y:=iy; if s[ix,iy] <> 0 then if sudInAny(s,p,s[ix,iy]) then begin Result:=False; Exit; end; // if end; // for Result:=True; end;
Проверяем судоку на валидность, используем только для введенного пользователем.
2. Решаем ; )
Че-то я заболтался, вечерами такое бывает, как начну говорить про ерунду всякую, так и потянет… Как же будем решать? Вот в чем вопрос. Если ты дочитал до сюда, переварив всё то, что я понаписал, то ты очень крут. О чем я? Да, будем использовать рекурсию. Всё для неё мы уже подготовили.
Но для начала начнем писать код для кнопки «Решить».
Значит так, обнуляем массив решений: ans:=nil;
Читаем, что ввёл пользователь: ReadInSud;
Если это нам не годится, то есть присутствует повтор, сообщаем об этом и выходим
if not IsValidSudoku(sud) then begin ShowMessage('повторение в исходном'); Exit; end; // if
Задаём количество нужных решений, беря значение из grpAns и записывая в mlen, заранее объявленную глобально (integer):
if grpAns.ItemIndex = 0 then mlen:=1 else mlen:=1000;
Вызываем рекурсивную функцию, которая будет решать судоку и заполнять массив ответов. Её мы напишем позднее.
DoRec(sud);
И всё прочее:
l:=length(ans); showmessage('решений: '+IntToStr(l)); cmbMode.Clear; cmbMode.Items.Add('исходное'); for i:=1 to l do cmbMode.Items.Add('решение '+IntToStr(i)); cmbMode.ItemIndex:=0;
В cmbMode будет список: исходное, решение 1, решение 2, …
Ах да, совсем забыл:
procedure TForm1.cmbModeChange(Sender: TObject); begin if cmbMode.ItemIndex = 0 then SudFill(sud) else SudFill(ans[cmbMode.ItemIndex-1]); end;
Дошли наконец до рекурсии)
Раз:
function DoRec(s:TSudoku):boolean; var i:integer; p:TPoint; begin Result:=True;
— начинаем.
Что же будем возвращать? Если все решения найдены, вернем False, если нет, то 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;
Если есть следующий неизвестный, по циклу для каждый цифры, при возможности подстановки таковой, подставляем её и запускаем себя с новым вариантом, и если он возвращает False (все решения найдены), выходим. Понятно в общем. Мне по крайней мере.
end else begin // сохранение результата sudAddAns(s); end;
— а если нет следующего неизвестного, то есть в наличии готовое судоку с правильно расставленными цифрами, заносим его в ответ.
Всё! За исключением
if Length(ans)<mlen then // не хватает результатов Result:=False; end; // DoRec
3. Итог.
Ну в общем и вот) Если что и забыл, найдется в исходнике, что прилагается. Да, дизом я совсем не занимался, но не в этом же соль)
(c) crystalbit, 2009
http://parsers.info
спасибо, что дали выговориться, накипело. Ща дам кому-нибудь почитать и выложу если одобрит, а я прощаюсь с вами
Пост весьма интересен, но было бы еще приятнее читать если бы ты оформил код, поставь плагин со спец тегами для языков программирования, подсветкой синтаксиса… А сейчас читаемость статьи из-за того что все вперемешку снижается.
спасибо за совет)
поставил
Ну вот, теперь намного лучше, так держать!
Дякую, ти крутий мужик!
Спасибо большое за пост, я делаю курсач на тему судоку, но я программирую на Паскале! я хотел бы задать вопросец, мог бы ты словами описать чуть чуть подробнее алгоритм самого решения (а в особенности рекурсии)(т е как рабтает программа, как я понял мы смотрим что можно подставить а что нельзя и поскакали, но можно ли подробнее?)! спасибо большое за помощ!!!
Мы идём как бы по веткам дерева, подставляем всё по очереди, что можно. Пробуем подставлять каждый возможный вариант и решать это как отдельное судоку. Если зашли в тупик, ветка кончается, если дошли до конца и нет ни одной неверной цифры, то это решение (одно из решений).
Стукни в аську, можем обсудить, если какие-нибудь аспекты не очень понятны, только не сегодня, меня не будет
Я понял! А можно еще чуть чуть подробнее о рекурсии, кто куда и какие данные рекурсируются?? А можеш пожалуста скинуть свой контакт в контакте, потому что у меня нет аськи!!! Еще хочу пару вопросов спросить!! Спасибо большое!
id5660451
спасибо большое! у меня вот остался небольшой вопрос, я просто программирую в паскале, чтоб разобраться что куда… Что такое эта переменная типа p и что что за TPoint, как оно работает и что за значение принимает, тоесть все о ней если можно! спасибо большое)
TPoint — сложная переменная (record), состоящая из X и Y, если так можно выразиться.
Если её нет в паскале, попробуй объявить в типах:
То есть мы можем отдельно присвоить X, отдельно Y, пример из кода выше:
Спасибо!
Вот вчера уже собрался реализовать все в Паскале, засунуть хочу этот код в модуль!
Хочу спросить:
1. Основная функция (рекурсия) заносит какоето s в масив ответов! я так полагаю, что это s это уже и есть готовый решенный судоку! тоесть масив ans будет состоять из правильных решений???
2. Как вы знаете, в паскале есть разница если писать
function aa ( s:sud);
и
function aa (var s:sud);
(простите за неамотность, но я не знаю есть ли эта разница в Delphi)
(разница в том что в 1 эта переменная вноситься в процедуру, но возвращает саму переменную нетронутую, а там где с варом, то оно по ходу процедуры меняет нашу s и выходящее s будет уже модифицированно)
Тогда у меня напрашивается вопрос, в наших процедурах там где мы меняем, рекурсию вызываем, масивы ответов удлиняем, добавляем, там тоже писать везде с var-ом???
Буду очень признателен если поможете или разьясните!
Спасибо!
1. Точно
2. В дельфи это есть, в паскале тоже по идее должно быть
и еще вот вопросик, я использую вот эту програмку как модуль!
тогда что мне стоит делать в основной проге, чтоб получить массив ответов?
тоесть, как я понял мы должны сделать dorec (s) где s это наша входящая судоку, а потом что?? и в implementation части модуля нам нужна только одна процедурка dorec и все?
иди еще что-то нужно??
Спасибо большое за помощ!!
Тип TSudoku и массив Ans не должны остаться спрятанными от программы :)
Спасибо за столь подробные объяснения, только я хотела спросить для чего нужна переменная v и где она изначально задается ?
Буду очень благодарна за объяснение :)
Надя, а где там переменная v?
от души благодарю. Хорошо помог твой пост) у мну курсач как раз по этой теме =)
Удачи!
Здраствуйте, некоторое время назад я пытался реализовать подобное, переписав немного ваши исходники(кстати, в ваших тоже подобное наблюдается…) и столкнулся с проблемой.
Конкретно: программы выводит «Лишние» результаты, т.е. у судоку единственное решения, вывестись может 3-4. Причем видно, что они неверны. Но, похоже, что процедуры проверки валидности судоку верны. Проверьте, пожалуйста.
Если надо пришлю свои исходники.
Странно. Лучше пример задания и неверных судоку, гляну. А если и у меня такие проблемы, то суть в них одна)