I tried to translate the (working!) Puzzle solution from the cabbage-goat-wolf-wolf from Scala to Haskell, but the code causes and causes an error when calling head in findSolutions , because the list of solutions is empty, so the problem seems to be somewhere in the loop. findMoves working fine.
import Data.Maybe(fromMaybe) data Item = Farmer | Cabbage | Goat | Wolf deriving (Eq, Show) type Position = ([Item], [Item]) validPos :: Position -> Bool validPos p = valid (fst p) && valid (snd p) where valid list = elem Farmer list || notElem Goat list || (notElem Cabbage list && notElem Wolf list) findMoves :: Position -> [Position] findMoves (left,right) = filter validPos moves where moves | elem Farmer left = map (\item -> (delItem item left, addItem item right)) left | otherwise = map (\item -> (addItem item left, delItem item right)) right delItem item = filter (\i -> notElem i [item, Farmer]) addItem Farmer list = Farmer:list addItem item list = Farmer:item:list findSolution :: Position -> Position -> [Position] findSolution from to = head $ loop [[from]] where loop pps = do (p:ps) <- pps let moves = filter (\x -> notElem x (p:ps)) $ findMoves p if elem to moves then return $ reverse (to:p:ps) else loop $ map (:p:ps) moves solve :: [Position] solve = let all = [Farmer, Cabbage, Goat, Wolf] in findSolution (all,[]) ([],all)
Of course, I would also like to receive advice on improvements not related to the actual error.
[Update]
Just for the record, I followed the suggestion to use Set . Here is the working code:
import Data.Set data Item = Farmer | Cabbage | Goat | Wolf deriving (Eq, Ord, Show) type Position = (Set Item, Set Item) validPos :: Position -> Bool validPos p = valid (fst p) && valid (snd p) where valid set = or [Farmer `member` set, Goat `notMember` set, Cabbage `notMember` set && Wolf `notMember` set] findMoves :: Position -> [Position] findMoves (left,right) = elems $ Data.Set.filter validPos moves where moves | Farmer `member` left = Data.Set.map (move delItem addItem) left | otherwise = Data.Set.map (move addItem delItem) right move f1 f2 item = (f1 item left, f2 item right) delItem item = delete Farmer . delete item addItem item = insert Farmer . insert item findSolution :: Position -> Position -> [Position] findSolution from to = head $ loop [[from]] where loop pps = do ps <- pps let moves = Prelude.filter (\x -> notElem x ps) $ findMoves $ head ps if to `elem` moves then return $ reverse $ to:ps else loop $ fmap (:ps) moves solve :: [Position] solve = let all = fromList [Farmer, Cabbage, Goat, Wolf] in findSolution (all, empty) (empty, all)
The call to head in findSolution can be made more secure, and it is better to use the printout of the solution, but I am also quite happy with it.
[Update 2]
I think that the previous views were suboptimal for this problem. I switched to the next data model that made the move, etc. A bit more verbose, but much more readable:
data Place = Here | There deriving (Eq, Show) data Pos = Pos { cabbage :: Place , goat :: Place , wolf :: Place , farmer :: Place } deriving (Eq, Show)