Хаскель — ход конем

В моем школьном детстве одним из развлечений, помню, было заполнить в тетрадке в клеточку ходом коня какой-нибудь прямоугольник m x n. Обычно это был квадрат 10х10 и вот, закусив губу (высунув язык), вписываешь старательно циферки в клеточки. На очередном шаге понимаешь, что зашел в тупик и начинаешь все с начала. Это было давно и неправда, но, изучая язык Haskell, я наткнулся на эту задачу в общем перечне https://wiki.haskell.org/99_questions за номером 91.

Собственно как можно попытаться решить эту задачу. Вспомним заповедь автора книжки «Изучай Хаскель во имя добра!», которая звучит как «думай рекурсивно». То есть берем какую-то клетку из нашего набора клеток, как-то заполняем оставшееся и проверяем, что исходная клетка соединяется с заполненным «ходом коня». Ну а «как-то заполняем оставшееся» и означает уйти в рекурсию с уменьшенным набором клеток. Рано или поздно набор сократится до единственного элемента, это и будет базой нашей рекурсии. Ну а в коде с помощью конструктора списков это можно записать, например, так:

knightComb [x] = [[x]]
knightComb xs = [x:ks | 
    x <- xs, 
    ks <- knightComb $ delete x xs, 
    near x $ head ks]
    where near (x1,y1) (x2,y2) = abs ((x2-x1)*(y2-y1)) == 2

Функция delete в базе языка отсутствует, но ее можно подгрузить из модуля Data.List.

На вход функции комбинирования подается набор клеток в виде списка пар координат (x,y), а на выходе – список всех возможных путей обхода этого набора. Если же все варианты не требуются и достаточно одного произвольного, можно взять первый с помощью функции head и тогда, в силу ленивости Хаскеля, остальные вычисляться и не будут. НО! Гладко было на бумаге. Алгоритм действительно работает и квадрат 3x3 без центральной клетки заполняет «на ура». На прямоугольнике 3x4 первый результат появляется через пару минут, но добавление всего одной клетки увеличивает это время до получаса. Про большие пространства можно даже не заикаться.

Ну и, в принципе, результат объясним. Проверка правильности выбора начальной клетки производится после ухода в рекурсию, клеток изначально много, а подходит далеко не каждая, поэтому и сложность перебора, несмотря на ленивость, оказывается порядка N!.. Справедливости ради, если мы на вход подадим уже упорядоченную последовательность, то тут же на выходе ее и получим, так что ленивость таки работает, просто нужно как-то ограничить лишний перебор.

Как именно? Первое, что приходит в голову – это брать изначально не произвольную клетку, а такую, в которую можно попасть из предыдущего хода. Т.е. на вход рекурсии кроме набора свободных клеток передаем координаты последней занятой, по ней строим список возможных ходов, проверяем, что эти клетки свободны и снова уходим в рекурсию с новым ходом, пока клетки не закончатся.

knightsTo x [] = [[x]]
knightsTo x xs = [x:ks | 
    k  <- next x,  
    elem k xs, 
    ks <- knightsTo k $ delete k xs]
    where next (x,y) = [(x+dx,y+dy) | (dx,dy) <- 
            [(-2,-1),(-2,1),(-1,-2),(-1,2),(1,-2),(1,2),(2,-1),(2,1)] ]

Как-то так. Ну и для удобства напишем интерфейс

knights n = 
    head . knightsTo (1,1) $ tail [(x,y) | x <- [1..n], y <- [1..n]]

И, надо сказать, это уже заметный шаг вперед!

А если набраться терпения, то и

На квадрате 10x10 я результата не дождался. Но, тем не менее, на каждом шаге рекурсии количество новых вызовов теперь зависит не от количества свободных клеток, а от количества возможных ходов, которых точно не больше восьми (точнее даже семи, из одного мы только что пришли), чаще гораздо меньше. Т.е. сложность алгоритма стала O(p^N). Тоже не полином, но уже продвинулись.

Функция next может выдавать лишние ходы, которые потом, правда, отсекаются проверкой elem, но восемь раз пробегать список может быть неэффективно. Разумней кажется пробежать список свободных клеток один раз и отфильтровать подходящие.

knightsTo x [] = [[x]]
knightsTo x xs = [x:ks | 
    k  <- filter (near x) xs, 
    ks <- knightsTo k $ delete k xs]
    where near (x1,y1) (x2,y2) = abs ((x2-x1)*(y2-y1)) == 2

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

Как еще можно ограничить лишний перебор? Можно, например, на каждом шаге рекурсии организовать дополнительную проверку входного списка на отсутствие одиноких клеток. Каждая незаполненная клетка во входном наборе должна иметь хотя бы одного свободного соседа, если только весь набор не состоит из одной клетки. Но после этой проверки могут оставаться брошенными пары, тройки и т.д. клеток. И, если обобщать, то необходимо проверять на связность всю оставшуюся область. А общая связность, в свою очередь означает, что из текущей позиции должен существовать путь в любую оставшуюся клетку. Такую проверку можно осуществить, например, алгоритмом обхода «в ширину», для чего напишем вспомогательную функцию.

connected _ [] = True
connected [] _ = False
connected (x:xs) ws = 
    let ns = filter (near x) ws in connected (xs++ns) (ws\ns)

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

Добавляем новую проверку в основную функцию

knightsTo x [] = [[x]]
knightsTo x xs = [x:ks | 
    connected [x] xs,
    k <- filter (near x) xs, 
    ks <- knightsTo k $ delete k xs]

А функцию проверки соседства описываем глобально

near (x1,y1) (x2,y2) = abs ((x2-x1)*(y2-y1)) == 2

Оно неплохо работает! Решение для квадрата 9x9 теперь находится быстрее времени, которое раньше требовалось для квадрата 8x8. И это не смотря на то, что сложность дополнительной проверки квадратично зависит от входных данных. Но поскольку общая сложность алгоритма экспоненциальна, отбрасывание лишних ветвей даже такой ценой позволяет заметно сократить вычисления.

Если проанализировать выдаваемые решения, то можно заметить, что алгоритм выбора ходов старается плотно заполнить левую часть области, и, по крайней мере, вначале это у него неплохо получается, что наталкивает на мысль разбивать большие области на более мелкие компакты. Отличная идея! Наш проблемный квадрат 10x10 – это четыре квадрата 5x5, а их мы теперь щелкаем как орешки. Необходимо разве что научиться не только стартовать из определенной точки, но и заканчивать где укажем. Для этого модифицируем интерфейсную функцию

knights5 ((m,n), st, fin) = head . filter (end fin) . 
    knightsTo st $ delete st [(x,y) | x <- [m..m+4], y <- [n..n+4]]
    where end x xs = x == last xs

Размер области фиксируем, на вход подаем координаты левого нижнего угла квадрата 5x5, координаты начала искомого пути и его окончания. И четыре раза применяем эту функцию к нужным параметрам.

knights10 = concatMap knights5 
    [((1,1),(5,3),(5,5)), ((1,6),(3,6),(5,6)),
     ((6,6),(6,8),(6,6)), ((6,1),(8,5),(6,5))]

Вуаля!

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

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

Автор: shale

Источник