Não foi possível encontrar o erro no meu código Haskell
Tentei traduzir uma solução (funcional!) Do quebra-cabeça de repolho-cabra-lobo de Scala para Haskell, mas o código gera um erro ao chamarhead
emfindSolutions
porque a lista de soluções está vazia, então o problema parece estar em algum lugar do loop.findMoves
parece funcionar bem.
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)
Claro que também gostaria de receber dicas sobre melhorias não relacionadas ao erro rea
[Atualizar
Apenas para o registro, segui a sugestão de usar umSet
. Aqui está o código de trabalho:
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)
A chamada parahead
emfindSolution
@ poderia ser mais seguro, e uma maneira melhor de imprimir a solução deveria ser usada, mas, além disso, estou muito feliz com iss
[Atualização 2]
Acho que as representações anteriores das posições eram abaixo do ideal para esse tipo de problema. Mudei para o modelo de dados a seguir, que tornou a movimentação etc um pouco mais detalhada, masMuito d mais legível:
data Place = Here | There deriving (Eq, Show)
data Pos = Pos { cabbage :: Place
, goat :: Place
, wolf :: Place
, farmer :: Place
} deriving (Eq, Show)