Решение задачи о миссионерах и каннибалах на языке Haskell

Изучая язык Haskell, я в очередной раз встал перед проблемой поиска какой-нибудь задачи для отработки новых навыков. После непродолжительных раздумий решено было реализовать написанный давным-давно на python алгоритм поиска в ширину для задачи о переправах миссионеров и каннибалов. Решение показалось мне довольно лаконичным, посему я решил поделиться им с людьми (а заодно и выслушать критику).

Интересующихся прошу проследовать под кат.

Формулировка задачи

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

Решение

Театр начинается с вешалки, а программа на языке Haskell начинается с импорта необходимых для работы модулей. С них и начнем.

import Data.List 

Для хранения информации о расположении миссионеров, каннибалов и береге, на котором находится лодка, определим свой тип данных.

data State = State { missioners :: Int, cannibals ::  Int, bank :: Char} deriving (Eq, Show)

Внимательный читатель может спросить: “Но почему в State имеется лишь два целочисленных поля? Миссионеры могут находиться как на левом берегу, так и на правом; то же самое относится и к каннибалам. Получается четыре числовых поля.”
Верное замечание, но по определенным причинам информация о количестве людей на берегу без лодки является избыточной (по каким — будет сказано чуть ниже).

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

move01 (State msn cnb bk) = State (3 - msn + 2) (3 - cnb) (oppositeBank bk)
move02 (State msn cnb bk) = State (3 - msn) (3 - cnb + 2) (oppositeBank bk)
move03 (State msn cnb bk) = State (3 - msn + 1) (3 - cnb + 1) (oppositeBank bk)
move04 (State msn cnb bk) = State (3 - msn + 1) (3 - cnb) (oppositeBank bk)
move05 (State msn cnb bk) = State (3 - msn) (3 - cnb + 1) (oppositeBank bk)

Замечаете? Нам не нужно хранить информацию о том, сколько у нас миссионеров на противоположном берегу — мы всегда можем получить их количество, вычтя число миссионеров на текущем берегу из трех. То же самое относится к каннибалам.

oppositeBank — простейшая функция, изменяющая метку берега на противоположную.

oppositeBank :: Char -> Char
oppositeBank bank
	| bank == 'L' = 'R'
	| otherwise = 'L'

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

isStatePossible :: State -> Bool
isStatePossible (State msn cnb bk) = msn >= 0 && msn <= 3 && cnb >= 0 && cnb <= 3

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

isStateSafe :: State -> Bool
isStateSafe (State msn cnb bk) = (cnb == msn) || (msn == 3) || (msn == 0)

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

bfsSolution :: [[State]] -> [State]
bfsSolution (path:tail')
	| State 3 3 'R' `elem` extensions = State 3 3 'R' : path
	| otherwise = bfsSolution $ tail' ++ [ext : path | ext <- extensions, (not . elem ext) path]
	where
		headState  = head path
		extensions = filter (\x -> isStatePossible x && isStateSafe x) [move01 headState, move02 headState, move03 headState, move04 headState, move05 headState]

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

(not . elem ext) path

Оно не позволяет возвращаться в одно из состояний, пройденных алгоритмом в процессе построения данного пути. Например, если на шаге n мы переслали с левого берега на правый двух миссионеров, то на шаге (n+1) нет никакого смысла возвращать их обратно на левый берег — впустую потратим время, и не продвинемся в решении ни на шаг (приведенная программа находит на моем нетбуке решение за 0.85 cекунды; убрав приведенное выше условие, я получаю нехилый рост производимых вычислений — для нахождения ответа требуется уже 45 секунд).

Последний штрих — функция main.

main = do
	mapM_ (putStrLn . show) $ (reverse . bfsSolution) ([[State 3 3 'L']])

Заключение

Данная статья никоим образом не претендует на полноту обзора и исчерпывающее объяснение всех возможных решений данной задачи. Интересующиеся читатели могут реализовать алгоритм поиска в глубину с возвратами; есть также еще одна (пока что не реализованная) задумка по “доведению до ума” вышеизложенного решения — попробовать отойти от хранения всех сгенерированных решений в списке списков и реализовать n-арное дерево.

Спасибо за внимание.