Решение японских кроссвордов в Wolfram Mathematica



Японский кроссворд — это известная головоломка, ответом которой является рисунок. Что это такое и как это решать, можно почитать на Википедии. Я хочу показать, как можно написать программу, которая будет решать японский кроссворд в системе Wolfram Mathematica путем перебора.

Основные идеи


Идея решения методом перебора заключается в том, чтобы создать списки всевозможных расположений клеток для всех строк и столбцов. После этого с помощью полученных списков найти те клетки, информация о которых будет точно известна. Затем отсеять такие расположения, которые противоречат найденной информации. Интуитивно понятно, что если циклически повторять последние две процедуры, то можно найти информацию о любой клетке. Итак, задачу можно разбить на три подзадачи:
  1. Составление всех возможных расположений.
  2. Поиск закрашенных и незакрашенных клеток.
  3. Удаление противоречащих расположений.

Поскольку Wolfram Mathematica создана для работы со списками, то и расположения клеток будут храниться в программе как списки. Будем обозначать информацию о клетках следующим образом:
  • 1 — закрашенная клетка;
  • 0 — незакрашенная клетка;
  • * — клетка, о которой ничего не известно.

Например, снизу показаны эквивалентные список и расположение клеток:
image


Составление всех возможных расположений


Немного теории

Рассмотрим конкретный пример. Необходимо найти всевозможные расположения для таких данных:

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

Сделаем это следующим путем. Поставим в соответствие ключу (цифрам слева от поля) такие группы клеток: {{1,0}, {1,1,0}, {1,1,1}}. Теперь создадим список, который будет хранить места, куда мы будем расставлять эти группы по порядку. В местах, куда мы будем ставить эти группы, будем хранить нули. Таким образом, получим список мест {0,0,0,0,0}. Расставляя группы клеток по порядку всеми способами на полученные места, как несложно убедиться, получим все требуемые расстановки для данных из задачи. Если поставить группы по порядку на места с номерами 1, 3, 4, то получится расположение из примера выше. Таким образом, получается, что все расположения равносильны сочетаниям из количества мест по количеству групп. Выбирая каким-нибудь образом места, куда ставить группы, мы получаем одно из возможных расположений. Для данных из примера количество расположений равно десяти.

На вопросы «Почему в последней группе в конце нет нуля?» и «Почему мест именно пять?» сознательный читатель должен ответить сам.

Реализация

Понятно, что писать самому функцию, которая будет осуществлять перебор, особого желания нет, потому что в Mathematica существует встроенная функция Subsets[list, {n}], которая это сделает. Она принимает список list как множество элементов и число n в качестве параметров и возвращает список подмножеств множества list длины n. Для нашего примера ее использование для перебора всех мест будет выглядеть так:

In := Subsets[{1,2,3,4,5}, {3}]

Out = {{1,2,3}, {1,2,4}, {1,2,5}, {1,3,4}, {1,3,5}, {1,4,5}, {2,3,4}, {2,3,5}, {2,4,5}, {3,4,5}}


Теперь напишем свою функцию, которая будет принимать число (длину поля len, для данных примера — 10) и список (ключ clue, для данных примера — {1,2,3}) в качестве параметров и возвращать список всевозможных расположений. Будем все делать последовательно. Для начала создадим функцию, которая превращает число в список единиц. Для этого есть встроенная функция ConstantArray[c, n]; c — это элемент, которым заполняется список, а n — длина этого списка.

In := ConstantArray[1, 2]

Out = {1, 1}


Далее, нам нужно присоединить ноль в конец этого списка. Это делается при помощи Append[expr, elem]. Первый параметр — список, второй — то, что будем присоединять.

In := Append[{1, 1}, 0]

Out = {1, 1, 0}


Соберем эти две функции в одну используя такой объект, как чистая функция (pure function). Это можно сделать двумя способами: либо Function[arg, Append[ConstantArray[1, arg], 0], либо короче — Append[ConstantArray[1, #], 0]&.

Теперь осталось применить эту функцию к каждому элементу списка, который соответствует ключу. Для этого есть очень полезная функция Map[f, expr]. Она применяет функцию f к каждому элемента списка expr. У нее также есть короткий вариант: f /@ expr.

In := Append[ConstantArray[1, #], 0]& /@ {1, 2, 3}

Out = {{1,0}, {1,1,0}, {1,1,1,0}}


Осталось только удалить ноль из последней группы. Тут поможет функция Delete[expr, {i, j}]. Она удалит элемент из списка expr с индексом {i, j}. Не забываем, что последний элемент имеет индекс -1.

In := Delete[{{1,0}, {1,1,0}, {1,1,1,0}}, {-1, -1}]

Out = {{1,0}, {1,1,0}, {1,1,1}}


Собранное все вместе выглядит так:

In := groups = Delete[Append[ConstantArray[1, #], 0]& /@ clue, {-1, -1}]

Out = {{1,0}, {1,1,0}, {1,1,1}}


Со списком мест все понятно, но нам понадобится функция Total[list], которая суммирует элементы списка list.

In := positions = ConstantArray[0, len - Total[clue] + 1]

Out = {0,0,0,0,0}


Сейчас самое важное — это использование функции Subsets. Плюс нам понадобится функция Range[n], которая возвращает список {1, 2, ..., n} и Length[list], которая дает длину списка list.

In := sub = Subsets[Range[len - Total[clue] + 1], {Length[clue]}]

Out = {{1,2,3}, {1,2,4}, {1,2,5}, {1,3,4}, {1,3,5}, {1,4,5}, {2,3,4}, {2,3,5}, {2,4,5}, {3,4,5}}


Мы получили список мест, куда расставлять группы клеток. Теперь будем заниматься расстановкой. Для этого нам нужна функция ReplacePart[expr, i->new], она заменяет в списке expr элемент с номером i на элемент new. Но для начала получим список замен, чтобы потом удобнее записать код. Это нам поможет сделать функция MapThread[f, {a1, a2, ...}, {b1, b2, ...}]. Результат ее выполнения будет следующим: {f[a1, b1], f[a2, b2], ...}. Итак, создаем список замен:

In := rep = MapThread[Function[{x, y}, x->y], {#, groups}]& /@ sub

Out = {{1->{1,0}, 2->{1,1,0}, 3->{1,1,1}}, {1->{1,0}, 2->{1,1,0}, 4->{1,1,1}}, {1->{1,0}, 2->{1,1,0}, 5->{1,1,1}}, {1->{1,0}, 3->{1,1,0}, 4->{1,1,1}}, {1->{1,0}, 3->{1,1,0}, 5->{1,1,1}}, {1->{1,0}, 4->{1,1,0}, 5->{1,1,1}}, {2->{1,0}, 3->{1,1,0}, 4->{1,1,1}}, {2->{1,0}, 3->{1,1,0}, 5->{1,1,1}}, {2->{1,0}, 4->{1,1,0}, 5->{1,1,1}}, {3->{1,0}, 4->{1,1,0}, 5->{1,1,1}}}


Финал всей затеи — это расстановка на свои места. Тут делаем Flatten[list], который уберет лишние скобки:

In := all = Flatten[ReplacePart[positions, #]]& /@ rep

Out = {{1,0,1,1,0,1,1,1,0,0}, {1,0,1,1,0,0,1,1,1,0}, {1,0,1,1,0,0,0,1,1,1}, {1,0,0,1,1,0,1,1,1,0}, {1,0,0,1,1,0,0,1,1,1}, {1,0,0,0,1,1,0,1,1,1}, {0,1,0,1,1,0,1,1,1,0}, {0,1,0,1,1,0,0,1,1,1}, {0,1,0,0,1,1,0,1,1,1}, {0,0,1,0,1,1,0,1,1,1}}


Вот и все, все расстановки получены. Осталось это все объединить в один модуль для удобства и мы получим требуемую функцию.

allPositions[len_, clue_] :=

Module[{groups, positions, sub, rep, all},

groups = Delete[Append[ConstantArray[1, #], 0]& /@ clue, {-1, -1}];

positions = ConstantArray[0, len - Total[clue] + 1];

sub = Subsets[Range[len - Total[clue] + 1], {Length[clue]}];

rep = MapThread[Function[{x, y}, x->y], {#, groups}]& /@ sub;

all = Flatten[ReplacePart[positions, #]]& /@ rep;

Return[all];]


Поиск закрашенных и незакрашенных клеток


Теперь среди всего этого добра, что мы получим, используя нашу функцию, нужно извлечь информацию о клетках. Пусть мы имеем некоторый список расположений. Если найдется такое место, где во всех расположениях стоит 1 либо 0, то это дает нам право утверждать, что на этой позиции всегда будет закрашенная либо, соответственно, незакрашенная клетка. На мой взгляд, самая простая реализация функции, которая будет это делать, состоит в следующем: все расположения суммируются поэлементно и в полученном списке ищутся либо числа, равные количеству всех расположений, либо нули. В первом случае эти числа меняются на единицы, а во втором — нули остаются на своих местах. Все остальные элементы заменяются звездочками. Для реализации воспользуемся функцией ReplaceAll[list, rule]. Она заменит в списке list элементы в соответствии с правилами rule. Конструкция x_ /; x!=0 означает «элемент x, такой что x ≠ 0».

findInformation[list_] := ReplaceAll[Total[list], {x_ /; x!=0 && x!=Length[list] -> "*", x_ /; x==Length[list] -> 1}]

Для нашего примера работа функции выглядит так:

In := findInformation[allPositions[len, clue]]

Out = {*,*,*,*,*,*,*,1,*,*}


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

Удаление противоречащих расположений


Полученную информацию можно использовать для того, чтобы отсеивать расположения, которые ей противоречат. Функция DeleteCases[expr, pattern] будет нашим фильтром — она удаляет из списка expr все элементы, которые не удовлетворяют шаблону pattern. Также будет использоваться функция Except[c], которая выбирает все, кроме ее параметра.

deleteFromList[list_, test_] := DeleteCases[list, Except[ReplaceAll[test, "*"->_]]]


Вернемся к примеру, пусть мы получили, что расположение клеток должно удовлетворять такому шаблону: {*,*,0,0,*,1,0,*,*,*}. Запустив нашу функцию, получим:

In := deleteFromList[allPositions[len, clue], {"*","*",0,0,"*",1,0,"*","*","*"}]

Out = {{1,0,0,0,1,1,0,1,1,1}, {0,1,0,0,1,1,0,1,1,1}}


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

Собираем все воедино. Финальный этап


Мы шаг за шагом создали все необходимые для решения кроссворда функции. Теперь важно все красиво собрать, чтобы получить решение. В качестве примера я использую кроссворд, взятый из киевского журнала японских кроссвордов «Релакс». Его автором является А. Леута.

Кроссворд задается в программу в виде списка ключей для строк и для столбцов.

rows = {{1}, {2}, {4}, {3,1}, {4,1}, {12}, {9}, {4,1}, {1,1,1,1,1}, {1,1,1,1}, {1,3,1}, {2,1,1}, {9,1}, {4,5,1}, {3,4,1}, {3,5,3}, {3,1,5}, {5,1,2}, {7,3}, {4,10}, {4,3,3}, {4,2,3}, {5,2,2}, {5,3,2}, {4,1,1,2}, {3,2,2}, {2,2}, {7}, {10}, {2,6}};

cols = {{3}, {6}, {8}, {13}, {1,12,1}, {2,7,2,1}, {5,2,7,4}, {5,3,12}, {8,2,3,1,1,2}, {8,2,1,3}, {2,3,4,1,4}, {2,2,1,1,5,3,5}, {4,6,7,2}, {2,3,3,8,2}, {1,2,2,2}, {1,4,1}, {2}, {2}, {9}, {1}};


Вводить размеры сетки не нужно, потому что и так их можно определить:

rowlength = Length[cols]

collength = Length[rows]


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

pic = ConstantArray["*", {collength, rowlength}];


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

rowpos = allPositions[rowlength, #]& /@ rows;

colpos = allPositions[collength, #]& /@ cols;


Когда все расположения заполнены, то можно приступать к решению. Идея такая: производится поиск по всем строкам закрашенных клеток и эти клетки записываются в основную сетку. Затем из расположений для столбцов удаляются те, которые противоречат полученной информации и ведется поиск по столбцам и т. д. Поиск будет проходить до тех пор, пока в сетке будет хотя бы одна звездочка; думаю, что работу цикла While объяснять не нужно. MemberQ в приведенном коде возвращает True, если в сетке имеется звездочка и False в противоположном случае. Также используется транспонирование (Transpose) для того, чтобы можно было равноправно работать как со строками, так и со столбцами. Для вывода рисунка имеется встроенная функция ArrayPlot, которая закрашивает клетку черным, если в ней стоит 1 и белым, если 0 (звездочка закрашивается по умолчанию в коричневый цвет). Для того, чтобы видеть, как динамически меняется рисунок в процессе решения, используется Dynamic.

Dynamic[ArrayPlot[pic, Mesh->True]]

While[MemberQ[pic, "*", 2],

pic = findInformation /@ rowpos;

colpos = MapThread[deleteFromList, {colpos, Transpose[pic]}];

pic = Transpose[findInformation /@ colpos];

rowpos = MapThread[deleteFromList, {rowpos, pic}];]


В результате получается вот такой рисунок:

Возможно, кто-то заметил, что решение является весьма неоптимальным. Да, это так, но не в оптимальности дело. Цель статьи — показать, что средствами Wolfram Mathematica можно удобно и быстро решить такую задачу. Но если уже говорить об оптимальности, то для этой задачи есть много способов оптимизации алгоритма, например, проводить отсеивание и поиск информации только в тех столбцах и строках, информация о клетках которых добавилась на предыдущем шагу, в данной версии программы поиск осуществляется во всех столбцах и строках.
AdBlock has stolen the banner, but banners are not teeth — they will be back

More
Ads

Comments 36

    0
    В вузе изучаете эту программу?
      +3
      Нет, не изучаю. Просто задача довольно интересная.
      • UFO just landed and posted this here
          0
          • UFO just landed and posted this here
              +1
              Извините, забыл снять галочку.
              +2
              Мне кажется, лучше выложить на github и добавить ссылку в статью.
              • UFO just landed and posted this here
                  0
                  Там только информация об ячейках вид полтит. Остальное вполне читаемо. На githab нормально бы хранилось.
        +2
        Спасибо, отличная статья!

        Но как оно решит
          |1 1|
        --+---+
         1|   |
         1|   |
        --+---+
        

        вот в чём вопрос ,-) (по ссылке, в секции «Трудные сканворды», есть упоминание других типов сканвордов, которые, боюсь, ваша прога не решит, хотя однозначное решение есть)

        а вообще, решить задачу, — значит найти решение(-я) или доказать, что его нет.

        Успехов! Тема интересная.
          +2
          Вы правы, оно не решит этот кроссворд. Программа зациклится, потому что не найдет никакой информации.
          Эта программа решает кроссворды, которые являются в некотором смысле «хорошими» — кроссворды с единственным решением и там, где не нужно угадывать положение закрашенной (незакрашенной) клетки. В обратную сторону тоже верно: если программа решила кроссворд, а не зациклилась, то он является хорошим. Именно хорошие кроссворды, как правило, печатают в журналах. Я не ставил задачу исследовать типы кроссвордов, моя задача такова — решить журнальный кроссворд. Правда, не сильно большой, чтобы не переполнить память (количество всех расположений для заданной сетки можете легко подсчитать).
          Метод полного перебора соберет всю возможную информацию, какую только можно собрать для конкретного расположения.
            +2
            Вот с журналами вы ошибаетесь жестоко :-)
            И в журналах, и на сайтах размещают какие попало кроссворды. Их никто не проверяет и они очень часто не допускают однозначной разгадки. Бывает, что пол сканворда — «шашечки». Упомянутый ресурс — единственный, где кроссворды проверяются хоть как-то. Они все хорошие в вашем понимании. Хотя это упрощённая хорошесть. Существуют вполне разрешимые кроссворды, но в вашем (и этого сайта) понимании ­— они плохие.
              +1
              Я как раз и разгадывая в журналах наткнулся на кросворды в которых два решения. Очень удивился, но быстро понял что там обычная прога для генерации сканвордов, без всяких проверок. Ибо это конвеер.
              0
              По ссылке не понял в чём проблемы у «тёщи» со ртом: 3 дополнительных варианта противоречят условию по строке «4 5 4», странно как-то.
                0
                У «тещи» проблемы в самих данных. Если просуммировать все числа слева сетки (для строк), то получится 114, а если сверху (для столбцов) — 111.
                  0
                  А, тогда тем более. Сложно говорить про «неразрешимый» кроссворд, если он изначально некорректен, это как бы очевидно.
                  0
                  Но если аккуратно записать данные, без ошибок, то вот что дает программа:
                  Действительно, кроссворд «плохой».
                  0
                  Последний из примеров указанных по ссылке на самом деле однозначен — в 4-й снизу строке явно указано 4, 5, 4, поэтому перечисленные альтернативные варианты не подходят.

                  P.S. Прошу прощения, не заметил ответ Nikelandjelo
                  –5
                  А если совместить это с обработкой изображений… ;-)
                    +1
                    Что именно вы имеете в виду?
                      –4
                      Если научить программу понимать, что находится на картинке, то она может разгадывать все кроссворды и отправлять в спортлото редакцию ответы. Какой бизнес можно было бы поднять: покупаешь пачку журналов по 20 рублей, выигрываешь с каждого по 500. Через неделю повторяешь.
                        +1
                        Для такой схемы программе достаточно делать 90% рутинной работы, а оставшиеся 10 — додумывать по контексту человеку.
                        –2
                        В Математике есть функции для работы с камерой и распознования образов. Хорошая задача для ИИ — увидеть кроссворд и его решить.
                        • UFO just landed and posted this here
                            0
                            Есть что то общее между Google и Wolfram :-)
                      –1
                      Совсем некомфортно читать код Mathematica без подсветски синтаксиса.
                        +1
                        Согласен с Вами полностью, но Хабрахабр не поддерживает подсветку кода в Mathematica.
                        Вы мне можете сказать, что можно было бы и цветные картинки вставить с кодом, но, в таком случае, желающие не смогли бы скопировать код.
                          +1
                          Можно вставить картинку, и ниже под каждой — спойлер с кодом, как вариант. А вообще спасибо за статью. Знакомился с данным инструментом только в университете, интересно прочитать было.
                          +2
                          Да, круто, но для кроссворда из примера в решении на SQL пришлось бы попотеть. Как никак, переборов будет 2600 ≈ 4.1 × 10180.
                            +3
                            А нельзя ли на базе японских кроссвордов построить асимметричную криптографию? Закрытый и открытый ключ уже есть (причём открытый намного меньше закрытого), осталось придумать, как с их помощью шифровать или подписывать.
                              0
                              Далеко не каждый рисунок может быть зашифрован так, чтобы потом его можно было бы восстановить.
                                0
                                Одному открытому ключу будет соответствовать много закрытых. Это не проблема, если по открытому ключу нельзя восстановить ни один из подходящих закрытых. Пример: хеш-функции. Одному значению хеш-функции может соответствовать масса открытых текстов, но нельзя построить открытый текст по значению хеш-функции.

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

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

                                Для алгоритма шифрования нужно преобразовать открытый текст в соответствии с открытым ключом (условием кроссворда) так, чтобы только обладатель закрытого ключа (решения кроссворда) мог восстановить открытый текст. Так как одному открытому ключу в данном случае может соответствовать несколько закрытых, я не уверен, что шифрование возможно, по крайней мере с произвольным кроссвордом. Над алгоритмом подписи ещё стоит подумать.
                                0
                                Статья на смежную тему: «Cryptographic and Physical Zero-Knowledge Proof: From Sudoku to Nonogram».
                            0
                            Вообще-то подобные задачи решаются
                            с помощью SAT солверов.
                              0
                              Когда развлекал себя японскими кроссвордами, то пришел примерно к такому ходу решения:
                              — Для каждого столбца и строки ищем крайние возможные положения групп закрашенных клеток, если группа в обоих положениях пересекается с собой, то закрашиваем это пересечение. Это пересечение также может быть найдено с помощью вычислений.
                              — При поиске крайних положений также находим области где клетки вообще не закрашиваются — помечаем их как недоступные. Сюда же относятся 1 пустая клетка которая является границей групп в одноцветном кроссворде.
                              — Повторять пока в кроссворде проявляются изменения

                              Only users with full accounts can post comments. Log in, please.