Could you please review the following code, and point out how I can make it cleaner, more idiomatic and easier to understand?

``````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 }
``````

IMHO the `findMoves` function seems to be quite verbose, and the `findSolutions` function looks confusing.

Thank you!

-
Oh, I can write `data Pos = Pos {cabb, goat, wolf, farmer :: Place} deriving (Eq, Show)`. –  Landei Jul 30 '11 at 17:19

Haskell's record system is not really good at providing you uniform access to record entries. That is the reason your `findMoves` implementation has to be so verbose: You cannot generalize over the fields.

There are a number of ways to get around that. One could be using a library such as fclabels that facilitates this job for you. You set it up like follows:

``````import Data.Record.Label

data Pos = ....

\$( mkLabels [''Pos] )
``````

This will give you "labels" with names such as `lCabb` that you can use with functions such as `getL` or `modL`. Without all this boilerplate, it is possible to write a much more satisfying `findMoves` function:

``````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
``````
-

I'd be inclined to change your representation. At each step, the farmer moves from his current location to the opposite location. It makes life much simpler if you just represent each state as a pair consisting of the list of things at the farmer's current location and the list of things at the other location.

My Haskell is a bit rusty, but under this scheme you get something like this:

``````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))
``````

The location of `withFmr` for each successive state is the opposite of that for the preceding state.

Hope this helps.

-
I already had this representation, but in order to avoid to go back to a position we already had, the lists must be compared, which means they must be sorted. I also tried `Set`s instead of lists, which worked somewhat better, but had to be translated back to lists in `findSolution`. –  Landei Jul 8 '11 at 6:20

I kept the record syntax (but it's good to know about the alternatives). This is my last version:

``````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
``````
-

Here's my attempt using arrays and list comprehensions:

``````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
``````
-
That looks very clean. I'll meditate over it :) –  Landei Sep 4 '12 at 19:15