ICQ - форум. Всё про ICQ.  

Вернуться   ICQ - форум. Всё про ICQ. > Мастерская > Программирование > Статьи

 
 
Опции темы Оценить тему
Старый 31.03.2009, 12:33   #1
Участник
 
Аватар для crystalbit
 
Регистрация: 28.05.2008
Сообщений: 81

ICQ: 224116

Репутация: 100
По умолчанию [delphi] решаем судоку

Решаем судоку на delphi.

Статья в оригинале - Алгоритм решения судоку на delphi
Скачать готовую программу - sudoku.exe.rar - 174 KiB
Скачать исходники - sudoku.rar - 9.9 KiB
Последнее редактирование - 1.06.2009, в связи с установкой пары модулей на блог и изменением ссылок.


Задался я как-то целью написать одну программу... В общем, чтоб решала головоломки судоку. Кто не знает что это такое, в поиске картинок вводим это слово и видим квадрат 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, 16.03.2009, parsers.INFO
__________________
Мой скромный delphi блог

Последний раз редактировалось crystalbit; 01.06.2009 в 17:01.
crystalbit вне форума  
Старый 31.03.2009, 18:45   #2
Участник заблокирован
 
Регистрация: 24.11.2007
Сообщений: 156

ICQ: 5010829

Репутация: 672
По умолчанию

потом почитаю, но походу это реально круто
Bosser вне форума  
Старый 31.03.2009, 18:52   #3
Участник
 
Аватар для [Alien]
 
Регистрация: 21.03.2009
Сообщений: 72

ICQ: 346347

Репутация: 475
По умолчанию

Цитата:
Сообщение от Bosser Посмотреть сообщение
потом почитаю
А нафиг тогда отписываешся если не читал?

Последний раз редактировалось [Alien]; 31.03.2009 в 21:59.
[Alien] вне форума  
Старый 31.03.2009, 19:23   #4
Участник заблокирован
 
Регистрация: 11.12.2007
Сообщений: 935

Репутация: 1508
По умолчанию

Меня тоже как-то просили сделать программку для решения судоку. Делал на C++ алгоритм практически тот же.

Последний раз редактировалось Capcha; 31.03.2009 в 19:28.
Capcha вне форума  
Старый 31.03.2009, 19:27   #5
Модератор
 
Аватар для [rod-on]
 
Регистрация: 16.02.2008
Сообщений: 259

ICQ: 844942

Репутация: 1208
По умолчанию

Цитата:
Сообщение от crystalbit Посмотреть сообщение
создадим при старте 81 поле ввода,
не ок. Для работы со всякими матрицами и прочим - TStringGrid, юзать лучше

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

Последний раз редактировалось [rod-on]; 31.03.2009 в 19:37.
[rod-on] вне форума  
Старый 01.04.2009, 02:53   #6
Участник
 
Аватар для life96
 
Регистрация: 16.03.2008
Сообщений: 144

ICQ: 699006

Репутация: 242
По умолчанию

[rod-on], суть то была не в этом вобщем то (не в TEdit) :)
хотя конечно да, метод не самый экономный, но с другой стороны сейчас такие компьютеры, что там экономить на 81 окошке? ))

саму программу я тестил еще "16.03.2009", работает и решает на ура, причем очень быстро
life96 вне форума  
Старый 01.04.2009, 11:45   #7
Модератор
 
Аватар для [rod-on]
 
Регистрация: 16.02.2008
Сообщений: 259

ICQ: 844942

Репутация: 1208
По умолчанию

life96, я понимаю, что не в этом. Просто, это сказанно, чтобы автор в будушем и те кто из этой статьи, что нить подчерпнут, знали (и не забывали как Дима), о TStringGrid. Очень хорошой комопнент для всяческих матриц. Зачем создавать велосипед)))
[rod-on] вне форума  
 

Опции темы
Оценка этой теме
Оценка этой теме:

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход


Часовой пояс GMT +3, время: 21:06.


Перевод: zCarot
Форум Асечников © Asechka.RU

Новости Сочи