(no subject)

[lomeo]

Несколько дней назад на rsdn натолкнулся на решение вот этой головоломки.

Не знаю как тут с форматировнием получится...

> import List
> import Monad

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

> data Person = Cop | Criminal | Dad | Mom | Boy | Girl deriving (Eq, Show, Ord)

Требуется переправить всех на другой берег. Однако, плот вмещает не больше двух человек. Управлять плотом умеют только полицейский, папа и мама.

> canSteer person = person `elem` [Mom, Dad, Cop]

Определим тип Side как группу человек, находящихся на одном берегу.

> type Side = [Person]

По условиям задачи, на одном берегу не могут оставаться:

- преступник с кем нибудь без полицейского
- мальчик с мамой, но без папы
- девочка с папой, но без мамы

> legal side = not $ or [
>         here Criminal && there Cop && (length side > 1),
>         here Boy  && here Mom && there Dad,
>         here Girl && here Dad && there Mom]
>     where
>         here  = (`elem` side)
>         there = (`notElem` side)

Текущее состояние определяется положением плота и людей (т.е. на каком берегу кто из них находится. Для этого мы введем тип State, конструкторы которого и будут определять положение плота (Here и There), а поля this и that подскажут нам кто из людей где находится.

> data State = Here  { this  :: Side, that :: Side }
>            | There { this  :: Side, that :: Side }

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

> instance Eq State where
>     Here  l1 _ == Here  l2 _ = sort l1 == sort l2
>     There l1 _ == There l2 _ = sort l1 == sort l2
>     _          == _          = False

Для более менее прилично вывода определим экземпляр класса Show для состояния.

> instance Show State where
>     show (Here  l r) = "\n" ++ show l ++ " <- " ++ show r
>     show (There l r) = "\n" ++ show l ++ " -> " ++ show r

Корректность состояния (т.е. проверка, не нарушает ли оно условия задачи) можно определить, проверив на удовлетворение условиям задачи оба берега.

> verify state = all legal [this state, that state]

Согласно задаче сначала все находятся на одном берегу, а в конце на другом.
Определим эти состояния.

> allPersons   = [Cop, Criminal, Dad, Mom, Boy, Boy, Girl, Girl]
> initialState = Here  allPersons []
> finalState   = There [] allPersons

Перемещаться с этого берег на тот может только тот, кто умеет управлять плотом. Он может отправиться один, а может захватить с собой кого нибудь еще. Определим функцию move :: State -> [State], которая генерирует состояния, возможные на
следующем шаге. Список состояний должен обладать следующими свойствами:

- Состояния должны быть уникальны (nub).
- Состояния должны быть корректны (filter verify).
- Список состоит из состояний, получающихся в результате перемещения одного или двух человек (one ++ two).

Для перемещения одного человека достаточно определить, что он умеет водить плот. После этого его можно переместить на другой берег. Перемещением будет операция удаления его с одного берега и добавление на другой.

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

> move (Here l r) = nub $ filter verify $ (one ++ two) -- optimize it
>     where
>         one = [ There (delete p l) (p:r) |
>                       p  <- filter canSteer l ]
>         two = [ There (deleteBoth p1 p2 l) (p1:p2:r) |
>                       p1 <- filter canSteer l,
>                       p2 <- delete p1 l ]
>         deleteBoth a b = delete a . delete b

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

> move st = (map flipState . move . flipState) st
>     where
>         flipState (Here  l r) = There r l
>         flipState (There l r) = Here  r l

К этому моменту мы полностью описали задачу и имеем все для ее решения. Решением задачи тоже будет декларация - определение что есть решение для данной задачи. Опишем функцию solve, принимающую в качестве параметров исходное (анализируемое) и финальное состояние, и список состояний, которые к данному моменту уже были проанализированы.

Что есть решение?

Если начальное и конечное состояния одинаковы, очевидно, что список из одного начального состояния и есть решение.

Если состояния разны, и из начального состояния больше нельзя получить никакие корректные состояния, не анализируемые ранее, значит решения нет.

(Поскольку возможен вариант, что решения нет, мы возьмем тип Maybe для того, чтобы это определять)

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

> solve start goal been
>     | start == goal   = Just (reverse nextBeen)
>     | null nextStates = Nothing
>     | otherwise       = msum $ map (\st -> solve st goal nextBeen) nextStates
>     where
>         nextBeen = start:been
>         nextStates = filter (`notElem` been) (move start)

Напишем программу, решающую нашу конкретную задачу.

> main = print $ solve initialState finalState []

Comments

[gliv.livejournal.com]

Почему-то по моим рассуждениям получается, что это алгоритм поиска в глубину,
но тогда мы должны сперва находить неоптимальные решения (перевести одного человека на ту сторону, привезти его обратно, потом другого, и т.д.)
Не могли бы вы пояснить этот момент?

UPD: ааа, или мы так и находим их, просто выводим самый быстрый среди них! Я прав?
UPD2: только высчитывать самый медленный мы так и не пойдем из-за ленивости, наверное.

[lomeo.livejournal.com]

В ширину: мы строим потенциально бесконечное дерево решений:

start : (map ... ) : (map ...) ...

где на каждом следующем шаге (рекурсивном вызове map solve) мы получаем следующие состояния и проверяем являются ли они целевыми.

В Haskell надо смотреть не на вызовы, которые ленивы, а на паттерн матчинг, который энергичен.

Подробнее.

start : map f nextStates не значит даже что nextStates вычислятся. Т.е. сначала будет проверка start == goal. Затем вычислится наличие(!) первого(!) элемента nextStates, чтобы убедиться, что хоть один элемент у нас да есть, пусть и пока не вычисленный. Поскольку вычисление рекурсивное дальше начнут проверяться == goal уже состояние из nextStates, вычисляясь по мере надобности -- а это обход следующего уровня дерева слева-направо. Т.е. это именно поиск в ширину, просто на ленивом языке он так пишется.