Во второй статье я бы хотел продолжить начатую тему и рассмотреть задачу нахождения циклического маршрута при заполнении квадратов NxN ходом коня. Но в комментариях к первой статье подсказали интересную эвристику, за что комментаторам большое спасибо, и эту подсказку, безусловно, стоит рассмотреть подробнее. Идея известна как правило Варнсдорфа и требует из списка возможных ходов в первую очередь выбирать ход с наименьшим количеством продолжений. Это позволяет даже не в разы, а на порядки сократить время ожидания первого решения. При этом дополнительная проверка на связность становится лишней, ее квадратичная сложность только мешает и тормозит процесс.
Основную рекурсию, описанную в прошлой статье, для соответствия этому правилу изменить несложно, достаточно отсортировать список возможных ходов по требуемому критерию
knightsTo x [] = [[x]]
knightsTo x xs = [x:ks |
k <- ksort xs $ neighbours xs x,
ks <- knightsTo k $ delete k xs]
Нахождение свободных соседей стоит вынести в отдельную функцию
neighbours xs x = filter (near x) xs
where near (x1,y1) (x2,y2) = abs ((x2-x1)*(y2-y1)) == 2
Дело за малым, осталось расписать функцию сортировки ksort, которая упорядочивает список соседей по числу «соседей этих соседей». Как вариант, это можно сделать так
ksort xs ns = map snd $ sort $ zip
(map (length . (neighbours xs)) ns) ns
Для каждого соседа из списка ns находим список его возможных ходов и вычисляем его длину. Длины компонуем в пары с координатами соседей. Штатный sort сортирует по первому элементу, т.е. по длине, после чего отбрасываем первые элементы пар, оставляя только вторые.
Несколько витиевато, но главное — результат. Какой там 10x10 — 50x50 меньше чем за минуту! И даже 90x90, если чуть подождать. Вот результата 100x100 уже не дождался.
Поэкспериментировав с промежуточными размерами квадратов, можно выяснить, что алгоритм начинает спотыкаться даже раньше. Первым проблемным квадратом оказывается 49x49, вторым 60x60, потом идут квадраты со сторонами 64, 76, 87, 89 и 98. Если же обход квадрата начинать не с левого нижнего угла, а, скажем, с противоположного, то для квадратов со сторонами 49, 60 и 64 решения теперь находятся, но всплывают проблемы для других квадратов, причем начиная уже с размера 23x23. Левый верхний угол позволяет найти маршрут в квадрате 76x76 (и, кстати, 100x100), но проблемы обнаруживаются у квадрата со стороной 32.
Такая выборочная привередливость немного удивляет и кажется нелогичной, но и у этого правила могут возникнуть неопределенности при выборе хода. Соседей с одинаковым минимальным количеством исходов тоже желательно как-то упорядочивать, возможно эти ситуации и оказываются критическими. Но тут уж, действительно, чем больше находим ответов, тем больше возникает вопросов. На этом тему с произвольными маршрутами, я думаю, можно закрыть и перейти к маршрутам замкнутым.
Эта задача считается более сложной, и, действительно, требование вернуться в начальную клетку кажется трудновыполнимым. Ведь при построении замкнутого маршрута мы всегда должны оставлять лазейку для возвращения. Другими словами начальная клетка должна оставаться доступной из текущей позиции на каждом шаге построения. Но тут снова стоит вспомнить о проверке связности и отброшенной функции connected. Раз уж на начальную клетку теперь распространяется такое же требование связанности, как и на незанятые клетки, нужно просто добавить ее к общему списку при каждом вызове функции проверки. А саму начальную клетку можно передавать в рекурсию в качестве еще одного параметра.
knFromTo x _ [] = [[x]]
knFromTo x s xs = [x:ks |
connected [x] (s:xs),
k <- ksort xs $ neighbours xs x,
ks <- knFromTo k s $ delete k xs]
По-хорошему, для гарантии результата, в базе рекурсии тоже стоило добавить проверку того, что последняя занятая клетка соединяется с начальной ходом коня. Но, поскольку любой маршрут однозначно достраивается за два хода до конца, для четного количества клеток эта проверка необязательна, а для нечетного количества замкнутого маршрута все равно не существует, и для такого варианта алгоритм до последнего хода будет пытаться замкнуть путь, а последним ходом в отсутствие проверки просто заполнит оставшуюся клетку.
Слегка подправим интерфейс
knightС n =
head . knFromTo (1,1) (1,1) $ delete
(1,1) [(x,y) | x <- [1..n], y <- [1..n]]
*Main> knightC 6
[(1,1),(2,3),(1,5),(3,6),(5,5),(6,3),(5,1),(4,3),(3,1),(1,2),(2,4),(1,6),(3,5),(5,6),(6,4),(5,2),(4,4),(6,5),(4,6),(2,5),(1,3),(2,1),(3,3),(1,4),(2,2),(4,1),(6,2),(5,4),(6,6),(4,5),(2,6),(3,4),(4,2),(6,1),(5,3),(3,2)]
*Main> knightC 7
[(1,1),(2,3),(1,5),(2,7),(4,6),(6,7),(7,5),(5,6),(7,7),(6,5),(5,7),(7,6),(6,4),(7,2),(5,1),(6,3),(7,1),(5,2),(3,1),(1,2),(2,4),(1,6),(3,7),(2,5),(1,7),(3,6),(5,5),(4,3),(2,2),(1,4),(3,5),(4,7),(2,6),(3,4),(1,3),(2,1),(4,2),(6,1),(7,3),(5,4),(3,3),(4,1),(6,2),(7,4),(6,6),(4,5),(5,3),(3,2),(4,4)]
*Main> knightC 8
[(1,1),(2,3),(1,5),(2,7),(4,8),(6,7),(8,8),(7,6),(6,8),(8,7),(7,5),(8,3),(7,1),(5,2),(3,1),(1,2),(2,4),(1,6),(2,8),(3,6),(1,7),(3,8),(5,7),(7,8),(8,6),(7,4),(8,2),(6,1),(4,2),(2,1),(1,3),(2,5),(3,3),(1,4),(2,2),(4,1),(6,2),(8,1),(7,3),(5,4),(3,5),(4,3),(5,1),(6,3),(5,5),(4,7),(2,6),(1,8),(3,7),(4,5),(6,6),(5,8),(4,6),(3,4),(5,3),(7,2),(8,4),(6,5),(7,7),(8,5),(6,4),(5,6),(4,4),(3,2)]
Для четных размеров квадратов (а нечетные неинтересны) результаты находятся вплоть до размера 50x50, но сказывается квадратичная сложность дополнительной проверки и последнего результата ждать приходится уже 40 минут.
Кстати, можно заметить, что в качестве конечной цели необязательно указывать начальную клетку. Можно указать любую другую и алгоритм при построении маршрута будет старательно к ней стремиться. Стремиться в том плане, что после заполнения всей области в указанную клетку можно будет перейти следующим ходом. Это можно использовать при построении цепочек, как это уже описывалось в предыдущей статье. Только теперь, благодаря такому целенаправленному поиску, решение будет находиться гораздо быстрее. Необходимо лишь учитывать особенность хода коня и помнить, что для четного количества клеток целевая позиция должна иметь тот же цвет шахматной раскраски, что и начальная, другими словами, должна совпадать четность суммы координат. А для нечетного количества клеток цвет и, соответственно, четность должны чередоваться.
knightN n ((m,l), st, fin) = head . knFromTo st fin $
delete st [(x,y) | x <- [m..m+n-1], y <- [l..l+n-1]]
И применяем ее к заданным параметрам
knights10 = concatMap (knightN 5)
[((1,1),(5,5),(5,6)), ((1,6),(5,6),(6,6)),
((6,6),(6,6),(6,5)), ((6,1),(6,5),(5,5))]
knights4x26 = concatMap (knightN 26)
[((1 , 1),(26,26),(1 ,27)), ((1 ,27),(1 ,27),(27,27)),
((27,27),(27,27),(52,26)), ((27, 1),(52,26),(26,26))]
knights16x13 = concatMap (knightN 13)
[((27,27),(27,27),(27,26)), ((27,14),(27,26),(27,13)),
((27, 1),(27,13),(40,13)), ((40, 1),(40,13),(40,14)),
((40,14),(40,14),(40,27)), ((40,27),(40,27),(40,40)),
((40,40),(40,40),(39,40)), ((27,40),(39,40),(26,40)),
((14,40),(26,40),(13,40)), ((1 ,40),(13,40),(13,39)),
((1 ,27),(13,39),(13,26)), ((1 ,14),(13,26),(13,13)),
((1 , 1),(13,13),(14,13)), ((14, 1),(14,13),(14,14)),
((14,14),(14,14),(14,27)), ((14,27),(14,27),(27,27))]
Квадрат 10x10 разбиением на четыре квадрата 5x5 теперь заполняется моментально. Для проблемного квадрата 52x52 заполнение замкнутой цепочки из четырех квадратов 26x26 укладывается в 5 минут ожидания (а в квадрате 50x50, как уже говорилось, цикл искался 40 минут). Разбиение на 16 квадратов 13x13 циклически заполняется и вовсе за полтора десятка секунд. Так что для больших размеров такой метод заполнения мелкими областями все же может оказаться полезным.
Но бог с ними, с большими квадратами. Напоследок хотелось бы затронуть еще одну интересную проблему и попробовать-таки подсчитать количество замкнутых путей (или, чего уж стесняться, гамильтоновых циклов) в определенной фигуре-графе. По крайней мере, теперь можно вычислить число направленных циклов, для чего в интерфейсной функции достаточно убрать вызов head, после чего функция будет искать не только первый, но и все возможные маршруты, и добавить вызов length, чтобы посчитать их количество. Ну и запастись терпением.
kNCircles :: Int -> Int -> Int
kNCircles m n =
(`div` 2) $ length . knFromTo (1,1) (1,1) $
delete (1,1) [(x,y) | x <- [1..m], y <- [1..n]]
Для нечетного количества клеток, как мы уже говорили, таких циклов не существует. Для прямоугольников с длиной одной из сторон в 4 клетки их тоже нельзя построить, что доказывается, например, в книге Е. Гика «Математика на шахматной доске». Размеры 5x6 и 3x10 являются наименьшими среди допустимых прямоугольников, и для каждого из них программа за несколько минут находит 16 и 32 вариантов соответственно. Прямоугольник 3x12 содержит 352 циклических маршрутов, 3x14 – 3 072, а для квадрата 6x6 таких циклов находится уже 19 724 (при этом направленных незамкнутых маршрутов из одного только угла у него обнаруживается 524 486, кто бы мог подумать!), но времени на подсчет уходит уже полдня. Экспонента во всей красе. Большие области и вычислений потребуют на порядки больше.
В принципе, проверку связности можно свести к линейной сложности, если соседей находить за константное время. Для этого, правда, придется усложнить структуру данных, и, например, перейти к честному представлению графов в виде списка связностей. Но, во-первых, не хотелось бы залезать в дебри, а, во-вторых, если верить оценке из википедии, даже после всех оптимизаций для подсчета количества циклов таким грубым методом на квадрате 8x8, боюсь, жизни не хватит.
А для желающих поэкспериментировать последние наработки можно объединить в один модуль.
import Data.List(delete, (\), sort)
type Cell = (Int, Int)
type Pool = [Cell]
type Track = [Cell]
near :: Cell -> Cell -> Bool
near (x1,y1) (x2,y2) =
abs ((x2-x1)*(y2-y1)) == 2
neighbours :: Pool -> Cell -> Pool
neighbours xs x =
filter (near x) xs
ksort :: Pool -> Pool -> Pool
ksort xs ks =
map snd $ sort $ zip
(map (length . (neighbours xs)) ks) ks
knightsTo :: Cell -> Pool -> [Track]
knightsTo x [] = [[x]]
knightsTo x xs = [x:ks |
k <- ksort xs $ neighbours xs x,
ks <- knightsTo k $ delete k xs]
connected :: Pool -> Pool -> Bool
connected _ [] = True
connected [] _ = False
connected (x:xs) ws =
let ns = neighbours ws x
in connected (xs++ns) (ws\ns)
knFromTo :: Cell -> Cell -> Pool -> [Track]
knFromTo x _ [] = [[x]]
knFromTo x a xs = [x:ks |
connected [x] $ a:xs,
k <- ksort xs $ neighbours xs x,
ks <- knFromTo k a $ delete k xs]
knights :: Int -> Track
knights n =
head . knightsTo (1,1) $ delete (1,1)
[(x,y) | x <- [1..n], y <- [1..n]]
knightC :: Int -> Track
knightC n =
head . knFromTo (1,1) (1,1) $ tail
[(x,y) | x <- [1..n], y <- [1..n]]
kNCircles :: Int -> Int -> Int
kNCircles m n =
length . knFromTo (1,1) (1,1) $ tail
[(x,y) | x <- [1..m], y <- [1..n]]
Автор: Алексей Ш.
