Решение для тех, кто не хочет разбираться сам

Для тех, кто не хочет разбираться, а хочет просто посмотреть, как выглядит решение этой задачи на Haskell, приведем его здесь целиком:

module Boat where

import List

import Array

-- лодка и волк-коза-капуста

-- объект

data Item = Wolf | Goat | Cabbage | Farmer

deriving (Show, Eq, Ord, Ix)

-- положение

data Location = L | R

deriving (Show, Eq, Ord)

-- обратное положение

from L = R

from R = L

-- позиция: где кто

type Position = Array Item Location

-- начальная и целевая позиция

startPosition = listArray (Wolf, Farmer) [L, L, L, L]

goalPosition = listArray (Wolf, Farmer) [R, R, R, R]

-- неправильная позиция: без контроля человека остаются

-- волк с козлом или козел с капустой

wrongPosition :: Position -> Bool

wrongPosition p =

all (/= p!Farmer) [p!Wolf, p!Goat] ||

all (/= p!Farmer) [p!Cabbage, p!Goat]

-- шаг переправы с берега на берег с кем-нибудь:

-- какие варианты можно получить

step :: Position -> [Position]

step p =

[p // [(who, from wher)] // [(Farmer, from wher)] |

(who,wher) <- whom] where

whom = filter ((== p!Farmer) . snd) $ assocs p

-- решение: последовательность позиций

-- (самая последняя - в начале списка)

type Solution = [Position]

-- построение нового списка возможных решений

-- из старого

stepSolution :: [Solution] -> [Solution]

stepSolution sols =

[(newpos:sol) |

sol <- sols,

newpos <- step (head sol),

not $ wrongPosition newpos]

-- итеративный процесс построения возможных решений,

-- для поиска среди них того, которое является ответом

search :: [[Solution]]

search = iterate stepSolution [[startPosition]]

-- нахождение первого решения, которое является ответом

solution :: [Position]

solution = head $

filter ((==goalPosition).head) $

concat $

search

-- вывод решения на экран

showSolution = sequence $

map (putStrLn.show.assocs) solution

Через списки, лог истории и уникальную очередь

Рассмотрим альтернативное решение той же самой задачи. Начнем с совершенно другого представления, с другой модели данных. Может быть, мы связались с массивами? Ведь массивы хороши тогда, когда нужно обращаться к элементам в произвольном порядке – а нужен ли он нам здесь, произвольный порядок? Попробуем обойтись списком, и кроме того, вынесем мужика в отдельную сущность – среди объектов перевозимых его больше не будет:

-- объект

data Item = Wolf | Goat | Cabbage

deriving (Show, Eq, Ord)

-- положение: где человек-лодка +

-- кто на левом берегу +

-- кто на правом + лог истории

data Position = L [Item] [Item] String | R [Item] [Item] String

deriving Show

Перевозимые объекты теперь – все, кроме мужика. Позиция – это (L список список история) или (R список список история), где L и R кодирует то, где сейчас находится мужик, два списка кодируют, соответственно, текущих обитателей левого и правого берега, а в истории мы будем хранить текстовую информацию о том, как мы до этой позиции дошли. Кстати, теоретически этой информации совсем не обязательно быть строкой – там может быть что угодно, в том числе и опять позиция – предыдущая к этой (вспомните про рекурсивные типы данных).

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

-- два положения одинаковые, если все одинаковое,

-- кроме лога

instance Eq Position where

(==) (L l1 r1 _) (L l2 r2 _) =

l1 == l2 && r1 == r2

(==) (R l1 r1 _) (R l2 r2 _) =

l1 == l2 && r1 == r2

_ == _ = False

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

-- начальная и целевая позиция

startPosition = L [Wolf, Goat, Cabbage] [] ""

goalPosition = R [] [Wolf, Goat, Cabbage] ""

-- неправильная компания

wrongCompany c =

null ([Goat, Cabbage] \\ c) ||

null ([Goat, Wolf] \\ c)

-- неправильная позиция:

-- без контроля человека остается плохая компания

wrongPosition (L left right _) = wrongCompany right

wrongPosition (R left right _) = wrongCompany left

Одна из самых главных функций, как и в прошлом варианте – какие варианты позиции можно получить из заданной позиции. Пусть позиция равна (L left right hist), то есть, мужик находится на левом берегу, в left хранится список тех, кто с ним, а в right – список тех, кто на противоположном берегу, ну а в hist содержится описание того, как они дошли до жизни такой.

-- шаг переправы с берега на берег с кем-нибудь:

-- какие варианты можно получить

step (L left right hist) =

[R left right (hist++"Move Right ")] ++

[R (left \\ [who]) (sort $ who:right)

(hist++"Take "++show who++" Right ")

| who <- left]

Работает наша функция так:

• Выбирается кто-то, кто поедет с мужиком на другой берег: who <- left.

• Для каждого варианта строится новая позиция, причем:

  • мужик в новой позиции – на правом берегу (R _ _ _),

  • с левого берега пассажир убывает: (left \\ [who]),

  • на правый берег он прибывает и сортируется там по росту: (sort $ who:right),

  • в лог новой позиции дописывается, что мужик перевез who на правый берег.

• Кроме того, добавляется еще один вариант, когда мужик без попутчиков переезжает на правый берег

Если же мужик находился на правом берегу, функция выглядит с точностью до наоборот:

step (R left right hist) =

[L left right (hist++"Move Left ")] ++

[L (sort $ who:left) (right \\ [who])

(hist++"Take "++show who++" Left ")

| who <- right]

Проверим?

step startPosition →

[R [Wolf,Goat,Cabbage] [] "Move Right ",

R [Goat,Cabbage] [Wolf] "Take Wolf Right ",

R [Wolf,Cabbage] [Goat] "Take Goat Right ",

R [Wolf,Goat] [Cabbage] "Take Cabbage Right "

]

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

queue :: [Position] -> [Position] -> [Position]

-- очередь поиска

queue old [] = []

queue old (p:ps) =

p : queue (p:old) (nub $ ps ++ candidates) where

candidates = filter (not.wrongPosition)

(step p) \\ old

Как эта функция работает? Она берет очередную позицию p, применяет к ней функцию step и получает, тем самым, список позиций, в которые можно из p попасть. Далее оставляются только корректные позиции и только те, что раньше не встречались – они все становятся кандидатами candidates.

Далее функция queue возвращает только что просмотренную позицию p (ее вернуть нужно как можно раньше, – ведь она может оказаться целевой!), и запускает сама себя, при этом:

• позиция p добавляется в список уже встреченных, и поэтому больше не повторится;

• кандидаты из candidates добавляются в общую очередь так, чтобы не было повторений.

Осталось только запустить эту очередь и найти в ей целевую позицию:

-- запускаем поиск по очереди и находим в нем решение

solution = head $

dropWhile (/= goalPosition) $

queue [] [startPosition]

Проверим?

Boat> solution

R [] [Wolf,Goat,Cabbage] "Take Goat Right Move Left Take Wolf Right Take Goat Left Take Cabbage Right Move Left Take Goat Right "

Ура! Решение найдено и описано вполне человеческим языком!

Обратите внимание, функцию queue можно было написать немножко по-другому, с помощью хвостовой рекурсии:

-- очередь поиска

queue old [] = old

queue old (p:ps) =

queue (p:old) (nub $ ps ++ candidates) where

candidates = filter (not.wrongPosition)

(step p) \\ old

Ответ при этом не изменится – но вот сама функция станет опасной. В этом варианте, она возвратит всю очередь только в том случае, если эта очередь когда-нибудь закончится. Но вы же понимаете, что в какой-нибудь другой задаче поиск может никогда и не остановиться (или остановиться теоретически через «нцать» лет, что нас тоже не устраивает) – хотя решение вполне может находиться чуть ближе, чем совсем уж в бесконечности.

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