Не могу найти ошибку в моем коде на Haskell - PullRequest
Новая
       29

Не могу найти ошибку в моем коде на Haskell

4 голосов
/ 05 июля 2011

Я пытался перевести (работающее!) Решение головоломки «капуста-козел-волк» из Scala в Haskell, но при вызове head в findSolutions выдается код ошибки и ошибка, потому что список решений пуст, поэтомуПроблема, кажется, где-то в петле.findMoves, кажется, работает нормально. 

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)

Конечно, я был бы также признателен за советы, касающиеся улучшений, не связанных с фактической ошибкой.

[Обновление]

Только для записи, я последовал предложению использовать Set.Вот рабочий код: 

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)

Можно сделать вызов head в findSolution более безопасным, и следует использовать лучший способ распечатать решение, но кроме этого явполне доволен этим.

[Обновление 2]

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

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

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

1 Ответ

4 голосов
/ 05 июля 2011

Проблема в том, что [Farmer,Goat,Cabbage,Wolf] - это не то же самое, что [Farmer,Cabbage,Goat,Wolf], и вы не проверяете его при использовании elem и notElem.Одним из решений всегда является сортировка списка элементов, например, в функции findMoves вы можете использовать: 

import Data.List(ord)
import Control.Arrow((***))

data Item = Farmer | Cabbage | Goat | Wolf deriving (Eq, Show, Ord)

findMoves (left,right) = map (sort***sort) $ filter validPos moves where
-- ....

solve = let all = sort [Farmer, Cabbage, Goat, Wolf]
-- ....

Или вы можете использовать набор Item вместо списка Item.

...