Решаем Чудо-судоку на Prolog

Если вы ещё не видели это видео канала CrackingTheCryptic, где профессиональный решатель судоку разбирает головоломку Чудо-судоку — вы многое упустили. Обязательно посмотрите

Автор статьи - Ben Congdon, ссылка на оригинал: Solving the "Miracle Sudoku" in Prolog. Перевод опубликован с разрешения автора.

Если вы ещё не видели это видео канала CrackingTheCryptic, где профессиональный решатель судоку разбирает головоломку «Чудо-судоку» — вы многое упустили. Обязательно посмотрите:

https://www.youtube.com/embed/yKf9aUIxdb4

Просматривая ролик, я вспомнил курс по языкам программирования, где мы писали простой решатель судоку на Prolog. Поскольку Prolog — декларативный язык, написать такой решатель на удивление компактно. По сути, программисту достаточно описать ограничения задачи, а Prolog сам найдёт решения:

:- use_module(library(clpfd)).

sudoku(Rows) :-
    length(Rows, 9), maplist(same_length(Rows), Rows),
    append(Rows, Vs), Vs ins 1..9,
    maplist(all_different, Rows),
    transpose(Rows, Columns),
    maplist(all_different, Columns),
    Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
    blocks(As, Bs, Cs),
    blocks(Ds, Es, Fs),
    blocks(Gs, Hs, Is).

blocks([], [], []).
blocks([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) :-
        all_different([N1,N2,N3,N4,N5,N6,N7,N8,N9]),
        blocks(Ns1, Ns2, Ns3).

Код выше взят из документации SWI Prolog и использует расширение для логического программирования с ограничениями. Поиграть с ним можно в онлайн-среде SWISH.

Примечательно, что этот код работает и как решатель, и как генератор судоку. Ему можно передать частично заполненное поле — и он найдёт все допустимые решения. Можно передать и пустое поле, тогда Prolog сгенерирует все возможные варианты судоку (правда, это займёт немало времени.

Оговорюсь сразу: Prolog я знаю не очень хорошо, лишь немного баловался с ним, так что мой код наверняка далёк от оптимального. Тем не менее рабочий решатель для Чудо-судоку написать удалось. 😄

Решатель Чудо-судоку

Чтобы написать решатель для этой головоломки, нужно закодировать следующие правила:

  • Обычные правила судоку:
    • Все строки и столбцы должны содержать цифры 1–9 ровно по одному разу.
    • Каждый блок 3×3 должен содержать цифры 1–9 ровно по одному разу.
  • Две клетки, расположенные на расстоянии хода коня или короля друг от друга, не могут содержать одну и ту же цифру.
  • Две клетки, имеющие общую сторону (ортогонально смежные), не могут содержать последовательные цифры.

Ограничение ортогональной смежности — самое простое. Для каждого блока 3×3 нужно убедиться, что угловые клетки отличаются от своих соседей хотя бы на единицу. (Мы проверяем именно углы, а не центр, чтобы корректно обрабатывать граничные случаи на краях поля.)

%- [[N1, N2, N3],
%-  [N4, N5, N6],
%-  [N7, N8, N9]]
ortho_adjacent([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) :-
    abs(N1 - N2) #> 1, abs(N1 - N4) #> 1,
    abs(N3 - N2) #> 1, abs(N3 - N6) #> 1,
    abs(N7 - N4) #> 1, abs(N7 - N8) #> 1,
    abs(N9 - N8) #> 1, abs(N9 - N6) #> 1,
    append([N2, N3], Ns1, Z1),
    append([N5, N6], Ns2, Z2),
    append([N8, N9], Ns3, Z3),
    ortho_adjacent(Z1, Z2, Z3).
ortho_adjacent([_,_], [_,_], [_,_]). %- Base case

Следующее — ограничение хода короля, столь же лаконичное. Я использовал all_different как удобный способ выразить неравенство. Можно было применить оператор #\= к соседям клетки N5, однако для корректной обработки граничных случаев всё равно пришлось бы добавить ограничения на угловые клетки — N1, N3, N7 и N9. Из-за этого часть ограничений дублируется.

%- [[N1, N2, N3],
%-  [N4, N5, N6],
%-  [N7, N8, N9]]
kings_move([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) :-
        all_different([N1, N2, N4]), all_different([N4, N7, N8]),
        all_different([N2, N3, N6]), all_different([N8, N9, N6]),
        all_different([N5, N4, N2]), all_different([N2, N5, N6]),
        all_different([N5, N6, N7]), all_different([N4, N5, N8]),
        append([N2, N3], Ns1, Z1),
        append([N5, N6], Ns2, Z2),
        append([N8, N9], Ns3, Z3),
        kings_move(Z1, Z2, Z3).
kings_move([_,_], [_,_], [_,_]).

Поначалу я думал, что ограничение хода коня окажется сложнее, но оно укладывается в ту же схему: все «Г-образные» ходы коня также умещаются в блок 3×3.

%- [[N1, N2, N3],
%-  [N4, N5, N6],
%-  [N7, N8, N9]]
knights_move([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) :-
    N1 #\= N6, N1 #\= N8,
    N3 #\= N8, N3 #\= N4,
    N7 #\= N2, N7 #\= N6,
    N9 #\= N4, N9 #\= N2,
    append([N2, N3], Ns1, Z1),
    append([N5, N6], Ns2, Z2),
    append([N8, N9], Ns3, Z3),
    knights_move(Z1, Z2, Z3).
knights_move([_,_], [_,_], [_,_]).

Теперь, когда все отношения для правил Чудо-судоку написаны, нужно добавить их в основную функцию sudoku. Каждая функция принимает по три строки и должна применяться ко всем «окнам» из трёх соседних строк поля. Один из вариантов — расписать это явно:

sudoku(Rows) :-
    ...
    Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
    ...
    ortho_adjacent(As, Bs, Cs),
    ortho_adjacent(Bs, Cs, Ds),
    ortho_adjacent(Cs, Ds, Es),
    ortho_adjacent(Ds, Es, Fs),
    ortho_adjacent(Es, Fs, Gs),
    ortho_adjacent(Fs, Gs, Hs),
    ortho_adjacent(Gs, Hs, Is),
    ...

Здесь мы применяем ortho_adjacent к строкам (A, B, C), затем к (B, C, D) и так далее. С помощью maplist это можно записать компактнее:

sudoku(Rows) :-
    ...
    Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
    ...
    append(Chunk1,       [_, _], Rows),
    append([_|Chunk2],   [_],    Rows),
    append([_,_|Chunk3], [],     Rows),
    maplist(ortho_adjacent, Chunk1, Chunk2, Chunk3),
    maplist(knights_move,   Chunk1, Chunk2, Chunk3),
    maplist(kings_move,     Chunk1, Chunk2, Chunk3).

Пояснение: с помощью append мы формируем три «чанка» строк. Chunk1 соответствует [As,Bs,Cs,Ds,Es,Fs,Gs], Chunk2[Bs,Cs,Ds,Es,Fs,Gs,Hs], а Chunk3[Cs,Ds,Es,Fs,Gs,Hs,Is]. Затем maplist применяет эти чанки к нашим отношениям. Когда в maplist передаётся несколько списков, он вызывает указанное отношение, передавая ему i-й элемент j-го списка в качестве аргумента.

Это поведение описано в документации maplist:

maplist(P, [X11,...,X1n], ..., [Xm1,...,Xmn]) :-
    P(X11, ..., Xm1),
    ...
    P(X1n, ..., Xmn).

Итоговый решатель Чудо-судоку выглядит так:

sudoku(Rows) :-
    length(Rows, 9), maplist(same_length(Rows), Rows),
    append(Rows, Vs), Vs ins 1..9,
    maplist(all_different, Rows),
    transpose(Rows, Columns),
    maplist(all_different, Columns),
    Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
    blocks(As, Bs, Cs),
    blocks(Ds, Es, Fs),
    blocks(Gs, Hs, Is),
    append(Chunk1,       [_, _], Rows),
    append([_|Chunk2],   [_],    Rows),
    append([_,_|Chunk3], [],     Rows),
    maplist(ortho_adjacent, Chunk1, Chunk2, Chunk3),
    maplist(knights_move,   Chunk1, Chunk2, Chunk3),
    maplist(kings_move,     Chunk1, Chunk2, Chunk3).

Работает ли это?

Оригинальное Чудо-судоку из видео задаётся такой подсказкой:

Problem1 hu92ca89aefadaea462b4f3470e33f2e01 2040 0x442 resize lanczos 3

Кодируем задачу: создаём поле 9×9 и проставляем две цифры-подсказки. Остальные клетки заполняем '_' — Prolog воспримет их как свободные переменные. Решатель сохранит 1 и 2 на своих местах, а для остальных клеток подберёт значения, удовлетворяющие всем ограничениям.

problem(1, [[_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,1,_,_,_,_,_,_],
            [_,_,_,_,_,_,2,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_]]).

Запрашиваем решение:

problem(1, Rows), sudoku(Rows), maplist(label, Rows), maplist(portray_clause, Rows).

Что здесь происходит:

  • problem(1, Rows) утверждает, что Rows должен совпадать с подсказкой.
  • sudoku(Rows) утверждает, что решение должно удовлетворять правилам Чудо-судоку.
  • maplist(label, Rows) указывает Prolog найти конкретные значения для каждой свободной переменной в Rows (без этого мы получим лишь список ограничений на переменные).
  • maplist(portray_clause, Rows) выводит решение в удобочитаемом виде.

Результат:

?- problem(1, Rows), sudoku(Rows), maplist(labeling([ffc, enum]), Rows), maplist(portray_clause, Rows).

[4, 8, 3, 7, 2, 6, 1, 5, 9].
[7, 2, 6, 1, 5, 9, 4, 8, 3].
[1, 5, 9, 4, 8, 3, 7, 2, 6].
[8, 3, 7, 2, 6, 1, 5, 9, 4].
[2, 6, 1, 5, 9, 4, 8, 3, 7].
[5, 9, 4, 8, 3, 7, 2, 6, 1].
[3, 7, 2, 6, 1, 5, 9, 4, 8].
[6, 1, 5, 9, 4, 8, 3, 7, 2].
[9, 4, 8, 3, 7, 2, 6, 1, 5].

Работает! Чтобы убедиться, что это не просто удача, хорошо бы проверить на другом экземпляре головоломки. К счастью, канал CrackingTheCryptic позже выложил продолжение со второй задачей:

Problem2 hube14d45dbb772c4f21a076cd727e9599 2234 0x444 resize lanczos 3

Подставляем её в решатель — и результат находится быстро:

problem(2, [[_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,4,_,_,_,_],
            [_,_,3,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_]]).
problem(2, Rows), sudoku(Rows), maplist(label, Rows), maplist(portray_clause, Rows).

[9, 4, 8, 3, 7, 2, 6, 1, 5].
[3, 7, 2, 6, 1, 5, 9, 4, 8].
[6, 1, 5, 9, 4, 8, 3, 7, 2].
[4, 8, 3, 7, 2, 6, 1, 5, 9].
[7, 2, 6, 1, 5, 9, 4, 8, 3].
[1, 5, 9, 4, 8, 3, 7, 2, 6].
[8, 3, 7, 2, 6, 1, 5, 9, 4].
[2, 6, 1, 5, 9, 4, 8, 3, 7].
[5, 9, 4, 8, 3, 7, 2, 6, 1].

И снова верно! Полезная особенность Prolog-решателя — он умеет находить все допустимые решения для любой данной подсказки. В интерактивной оболочке Prolog после нахождения одного решения достаточно нажать ;, чтобы перейти к следующему. В обоих случаях выше подсказка допускает ровно одно решение. Это правильно: по определению, задача судоку должна иметь единственное решение.

Генерация головоломок

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

problem(3, [[_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,_,_,_,_]]).
problem(3, Rows), sudoku(Rows), maplist(label, Rows), maplist(portray_clause, Rows).

Результат? Ничего. Только нарастающий гул кулеров ноутбука. Думаю, моя стратегия поиска слишком наивна: maplist(label, Rows) перебирает всё пространство состояний по принципу «угадал — проверил», и без ограничивающей подсказки это катастрофически медленно.

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

Отступление: Picat

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

Решатель Хакана работает несравнимо быстрее моего: за то время, пока мой перебирает одну задачу, его успевает найти все допустимые заполнения Чудо-судоку целиком. Как выясняется, таких заполнений всего 72[^2]. Поскольку в Picat я разбираюсь ещё хуже, чем в Prolog, не берусь объяснить, в чём секрет такого быстродействия.

Рекомендую почитать исходный код решателя на Picat. Благодаря своей скорости он позволяет обнаружить несколько интересных свойств Чудо-судоку:

  • Минимальное количество подсказок, однозначно определяющих решение, равно 2.
  • Задачи с единственной подсказкой всегда имеют ровно 8 решений — независимо от того, какая цифра и на какой позиции стоит.
  • Допустимых двухцифровых подсказок очень много: например, существует 2320 способов расставить 1 и 2 так, чтобы получить единственное решение. Поскольку уникальных заполнений всего 72, интересные решения закончатся раньше, чем допустимые подсказки.

Заключение

В повседневной работе Prolog мне почти не нужен, но приятно иногда поработать с таким нишевым языком, когда задача под него идеально подходит. Взял на заметку и Picat — на сайте Хакана целая коллекция задач с решениями.

Ещё я понятия не имел, что существуют конструкторы головоломок, расширяющие классическое судоку: на странице Википедии перечислено более дюжины вариантов. На канале CrackingTheCryptic найдётся немало вариантов, для которых было бы интересно написать свои решатели.

Дополнительные материалы


Обновления

Согласно комментарию пользователя triska в обсуждении на Hacker News, скорость решателя можно заметно увеличить, изменив стратегию поиска:

problem(3, Rows),
    sudoku(Rows),
    append(Rows, Vs),
    labeling([ff], Vs),
    maplist(portray_clause, Rows).

До скорости Picat ему всё равно далеко, но такой подход к разметке уже позволяет генерировать новые поля! Подробнее о настройке стратегии поиска — в документации SWIPL по labeling.

Теперь можно проверить, совпадает ли наш подсчёт решений с данными решателя на Picat:

aggregate_all(count,
   (problem(3, Rows),
     sudoku(Rows),
     append(Rows, Vs),
     labeling([ff], Vs)),
   Count).

Результат: 72 — как и ожидалось. 😄

В первоначальной версии статьи использовался предикат all_distinct вместо all_different. По упомянутому совету triska замена позволяет улучшить эффективность поиска.

About MyGpsTools Editorial Team

MyGpsTools publishes practical guides about GPS apps, maps, navigation tools, EXIF photo metadata, satellite imagery, Android Auto, Apple CarPlay, ZIP code maps, and location-based technologies. We focus on clear instructions, practical checks, official documentation, and reader feedback.