Капуста-коза-волк головоломка в Haskell


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

module Cabbage (
  solve
) where

data Place = Here | There deriving (Eq, Show)

data Pos = Pos { cabb :: Place
               , goat :: Place
               , wolf :: Place
               , farmer :: Place
               } deriving (Eq, Show)

opp :: Place -> Place
opp Here = There
opp There = Here

valid :: Pos -> Bool
valid (Pos {cabb = c, goat = g, wolf = w, farmer = f}) = (c /= g && g /= w) || g == f

findMoves :: Pos -> [Pos]
findMoves pos@(Pos {cabb = c, goat = g, wolf = w, farmer = f}) =
    filter valid $ moveCabb ++ moveGoat ++ moveWolf ++ moveFarmer where
    moveCabb | c == f = [pos {cabb = opp c, farmer = opp f}] | otherwise = []
    moveGoat | g == f = [pos {goat = opp g, farmer = opp f}] | otherwise = []
    moveWolf | w == f = [pos {wolf = opp w, farmer = opp f}] | otherwise = []
    moveFarmer = [pos {farmer = opp f}]

findSolution :: Pos -> Pos -> [Pos]
findSolution from to = head $ loop [[from]] where
    loop pps = do ps <- pps
                  let moves = filter (flip notElem ps) $ findMoves $ head ps
                  if to `elem` moves
                    then return $ reverse $ to:ps
                    else loop $ map (:ps) moves

solve :: [Pos]
solve = findSolution (setAll Here) (setAll There) where
            setAll x = Pos{ cabb = x, goat = x, wolf = x, farmer = x }

ИМХО findMoves функция кажется довольно громоздким, и findSolutions функция выглядит запутанно.

Спасибо!



669
2
задан 7 июля 2011 в 07:07 Источник Поделиться
Комментарии
4 ответа

Запись система Хаскелл не очень хорошо в предоставляя вам Универсальный доступ к записи. Что является причиной ваших findMoves внедрение должно быть так многословен: нельзя обобщать по полям.

Есть несколько способов обойти это. Можно использовать библиотеки, такие как fclabels , что облегчает эту работу за вас. Вы установите его, как следует:

import Data.Record.Label

data Pos = ....

$( mkLabels [''Pos] )

Это даст вам "ярлыки" с такими именами, как lCabb , что вы можете использовать функции, такие как getL или модл. Без всего этого балласта, его можно написать гораздо больше удовлетворения findMoves функции:

findMoves :: Pos -> [Pos]
findMoves pos = filter valid moves
where
moves = [ foldr (\obj -> modL obj opp) pos objs
| objs <- moveComb, same $ map (`getL` pos) objs
]
moveComb = [[lCabb, lFarmer], [lGoat, lFarmer], [lWolf, lFarmer], [lFarmer]]
same xs = all (== head xs) xs

4
ответ дан 7 июля 2011 в 01:07 Источник Поделиться

Я был бы склонен менять свои представления. На каждом шагу, фермер движется от своего текущего местоположения до противоположного расположения. Это делает жизнь намного проще, если вы просто представлять каждое государство как пара, состоящая из списка вещей на текущее местоположение фермера и список вещей в другом месте.

Мой Хаскелл-это немного ржавый, но по этой схеме получится что-то вроде этого:

move (withFmr, awayFromFmr) = [(awayFromFmr, withFmr) | map f withFmr]
where f x = (x :: awayFromFmr, filter (== x) withFmr)

valid (withFmr, awayFromFmr) =
not (elem Goat awayFromFmr && (elem Wolf awayFromFmr || elem Cabbage awayFromFmr))

Расположение withFmr для каждого последующего государство является противоположностью предыдущего государства.

Надеюсь, что это помогает.

2
ответ дан 8 июля 2011 в 12:07 Источник Поделиться

Я записывал синтаксис (но это хорошо, чтобы знать об альтернативах). Это моя последняя версия:

import Data.Maybe(catMaybes)

data Place = Here | There deriving (Eq, Show)

data Pos = Pos {cabb, goat, wolf, farmer :: Place} deriving (Eq, Show)

type Path = [Pos]

findMoves :: Path -> [Path]
findMoves path@(pos@(Pos c g w f) : prev) =
catMaybes [ c ??? pos {cabb = opp c} , g ??? pos {goat = opp g}
, w ??? pos {wolf = opp w} , f ??? pos ] where
opp Here = There
opp There = Here

valid (Pos c g w f) = (c /= g && g /= w) || g == f

x ??? p = let p' = p {farmer = opp f}
in if x == f && valid p' && notElem p' prev
then Just (p' : path) else Nothing

findSol :: Pos -> Path -> [Path]
findSol pos path@(p : _)
| p == pos = [reverse path]
| otherwise = findMoves path >>= findSol pos

solve :: [Path]
solve = findSol endPos [startPos] where
setPos place = Pos place place place place
startPos = setPos Here
endPos = setPos There

1
ответ дан 31 июля 2011 в 01:07 Источник Поделиться

Вот моя попытка, используя массивы и списочные включения:

import Data.Array
import Data.List

type Pos = Array Obj Place

data Place = Here | There deriving (Eq, Show)

data Obj = Cabb | Goat | Wolf | Farmer deriving (Ord, Eq, Ix, Show, Enum)

objs = [Cabb .. Farmer]

allAre a = listArray (Cabb, Farmer) $ map (const a) objs

start = allAre Here
end = allAre There

opp Here = There
opp There = Here

valid arr = (arr ! Cabb /= arr ! Goat && arr ! Goat /= arr ! Wolf) || arr ! Goat == arr ! Farmer

move arr obj = [(o, opp (arr ! o)) | o <- [Farmer, obj]]

nextStates arr = [ nextState | obj <- objs, let nextState = arr // move arr obj, arr ! Farmer == arr ! obj, valid nextState]

nextMove paths = [nextState : path | path <- paths, nextState <- nextStates (head path)]

filterSolutions = filter (\path -> head path == end)

shortestPath = head $ concatMap filterSolutions $ iterate nextMove [[start]]

main = print $ length shortestPath

1
ответ дан 4 сентября 2012 в 04:09 Источник Поделиться