Clojure

Clojure: Решаем японские кроссворды с помощью core.logic

Я никогда не был сторонником одной единственной парадигмы программирования. Мне всегда нравилось изучать новые идеи и учиться комбинировать их с изученными ранее. Сейчас я решил немного поэкспериментировать с логическим программированием (или программированием в ограничениях). В качестве задачки для эксперимента я возьмусь решать японские кроссворды (nonogram). А реализую я ее с помощью библиотеки core.logic для языка Clojure.

Приготовления

Для начала сгенерируем новый проект с помощью Leiningen:

1

$ lein new nonograms-solver

Опишем информацию о нашем проекте в файле project.clj:

1
2
3
4
5
6
7
8
9

(defproject nonograms-solver "0.1.0-SNAPSHOT"
  :description "Nonograms solver powered by clojure.core.logic"
  :url "https://github.com/sviridov/nonograms-solver"
  :license {:name "The MIT License"
            :url  "http://opensource.org/licenses/MIT"}
  :dependencies [[org.clojure/clojure "1.5.1"]
                 [org.clojure/core.logic "0.8.8"]]
  :aot :all
  :main nonograms-solver.main)

Добавим точку входа в приложение в файл main.clj:

1
2
3
4
5
6
7
8
9

(ns nonograms-solver.main
  (:use nonograms-solver.core
        nonograms-solver.io)
  (:gen-class))

(defn -main [& args]
  (if (== (count args) 1)
    (-> (first args) read-hints solve print-nonogram)
    (println "Usage: NonogramsSolver <filename>")))

Ввод-Вывод

Поместим операции ввода-вывода в файл io.clj:

1
2

(ns nonograms-solver.io
  (:use [clojure.java.io :only (reader)]))

Для хранения подсказок для кроссворда будем использовать обычную хэш-таблицу следующего формата:

1
2
3
4
5
6
7

;; XXXXX
;;  X  X
;;   X X
;;    XX
;;     X
{:vertical   [[1] [2] [1 1] [1 1] [5]]
 :horizontal [[5] [1 1] [1 1] [2] [1]]}

В связи с этим, реализация ввода данных тривиальна:

1
2
3

(defn read-hints [filename]
  (with-open [input (java.io.PushbackReader. (reader filename))]
    (read input)))

Форматом выходных данных будет последовательность строк, где строка – это последовательность нолей и единиц (0 – пусто, 1 – закрашено). Реализуем вывод данных:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

(defn- each [xs function]
  (when (seq xs)
    (function (first xs))
    (each (rest xs) function)))

(defn- print-nonogram-cell [cell]
  (if (zero? cell)
    (print " ")
    (print "X")))

(defn- print-nonogram-row [row]
  (each row print-nonogram-cell)
  (newline))

(defn print-nonogram [rows]
  (each rows print-nonogram-row)
  (flush))

Итак, к самому интересному!

Решение кроссворда

Сразу хочу отметить, что это не самая серьезная программа и я не ставлю здесь приоритет на производительность. Для меня важно решить эту задачу максимально лаканично.

Поместим логику решения кроссворда в файл core.clj:

1
2
3
4
5

(ns nonograms-solver.core
  (:refer-clojure :exclude [== < +])
  (:use  clojure.core.logic
        [clojure.core.logic.arithmetic :only (<)]
        [clojure.core.logic.fd :only (+ domain in)]))

Итак, как же мы будем искать решение нашего кроссворда? Никак! Главный вопрос в логическом программирование не в том “Как найти решение”, а в том “Что такое решение”. Дать ответ на этот вопрос мы можем с помощью ограничений, накладываемых на решение. Какие ограничения мы можем наложить на решение японского кроссворда?

  • Решение – это набор ячеек (клеток).
  • Ячейка может быть закрашена или пуста.
  • Все ячейки поделены на ряды и колонки.
    • Каждой линии (ряду или колонке) ставится в соответствие свой шаблон (подсказка).
    • Содержимое линии должно соответствовать своему шаблону согласно правилам японского кроссворда.

Определим функцию, в которой отобразим описанные выше правила:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

(defn solve [{vertical-hints :vertical horizontal-hints :horizontal}]
  (let [grid-width  (count vertical-hints)
        grid-height (count horizontal-hints)
        grid-size   (* grid-width grid-height)

        ;; Набор логических переменных
        ;; Каждая переменная это ячейка кроссворда
        cells   (repeatedly grid-size lvar)

        ;; Строки кроссворда (состоят из логических переменных)
        rows    (partition grid-width cells)

        ;; Столбцы кроссворда (состоят из логических переменных)
        columns (apply map vector rows)]

    (->> (run 1 [result] ; Запускаем поиск решения.
                         ; Ищем до тех пор, пока не найдем одно

           ;; Решение - это набор ячеек
           (== result cells)

           ;; Ячейка может быть закрашена (1) или пуста (0)
           (everyg #(in % (domain 0 1)) cells)

           ;; Каждой линии ставится в соответсвие свой шаблон
           (constrain-lines rows horizontal-hints)
           (constrain-lines columns vertical-hints))

         ;; run возвращает множество результатов, берем первый
         (first)

         ;; Возвращаем решение как последовательность рядов
         (partition grid-width))))

Ограничим линии подсказками:

1
2
3
4
5
6
7
8
9
10
11

(defn- constrain-lines [lines hints]
  (cond (and (seq lines) (seq hints)) ; Если остались линии и подсказки
        (all                          ; Ограничиваем первую линию первой подсказкой и рекурсивно повторяем
          (match-line-pattern (first lines) (first hints) false)
          (constrain-lines (rest lines) (rest hints)))

        ;; Если закончились линии и подсказки - все прошло хорошо
        (and (empty? lines) (empty? hints)) succeed

        ;; Иначе - что-то пошло не так...
        :else fail))

Итак, последнее что нам осталось сделать, это подобрать заполнение для линии соответственно ее шаблону. Для этого определим новое логическое правило match-line-pattern, которое будет перебирать различные варианты окраски клеток кроссворда с учетом уже существующих догадок (полученных от сопоставления других линий пересекающих текущую).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

(defne match-line-pattern [line pattern chain?]
  ;; line - последовательность логических переменных для сопоставления
  ;; pattern - подсказка, накладывающая ограничения на содержимое line
  ;; chain? - флаг, сигнализирующий, что предыдущая ячейка была закрашена

  ([[ ] [ ] _]) ; Если линия закончилась и подсказок
  ([[ ] [0] _]) ; не осталось, то цель выполнена успешно

  ;; Если предыдущая ячейка была закрашена и
  ;; текущая подсказка закончилась (0), значит
  ;; мы дошли до разрыва между закрашенными последовательностями
  ([[0 . line-tail] [0 . pattern-tail] true]
     (match-line-pattern line-tail pattern-tail false))

  ;; Если еще осталась подсказка, то пробуем закрасить ячейку
  ([[1 . line-tail] [counter . pattern-tail] _]
     (< 0 counter)
     (fresh [new-counter new-pattern]
       (+ new-counter 1 counter)
       (conso new-counter pattern-tail new-pattern)
       (match-line-pattern line-tail new-pattern true)))

  ;; Если предыдущая ячейка не была закрашена, то
  ;; пробуем оставить текущую пустой
  ([[0 . line-tail] _ false]
     (match-line-pattern line-tail pattern false)))

Ну что же, попробуем запустить:

1
2
3
4
5
6
7
8
9
10

;; {:vertical [[5] [1 3] [2 2] [1 1 1] [2 2] [1 3] [5]]
;;  :horizontal [[7] [1 1 1 1] [2 1 2] [3 3] [7]]}

nonograms-solver.main> (-main "test/nonograms/2.txt")

XXXXXXX
X X X X
XX X XX
XXX XXX
XXXXXXX

Отлично!

P.S. Оптимизация

Безусловно, в текущем варианте (полный перебор!) это чудо работает очень медленно. Для оптимизации я провел два очень простых трюка:

  • Так как перебор внутри линий идет слева-направо и сверху-вниз, то в некоторых случаях кроссворд выгодно перевернуть.
  • Линии можно отсортировать по их “значимости” для кроссворда и проходить от самых к наименее “значимым”.

На результат можно посмотреть здесь.

Комментарии

Свиридов Александр © 2015