wolf-goat-cabbage.hs

{- Крестьянину нужно перевезти через реку волка, козу и капусту. Но
лодка такова, что в ней может поместиться только крестьянин, а с ним
или один волк, или одна коза, или одна капуста. Но если оставить волка
с козой, то волк съест козу, а если оставить козу с капустой, то коза
съест капусту. Как перевёз свой груз крестьянин, если известно, что
все переправились через реку в целости и сохранности? -}

import Data.List (intercalate)

data C = Wolf | Goat | Cabbage deriving (Show, Eq)
data S = S { thisbank :: [C], otherbank :: [C] } deriving (Show)
type Move = Maybe C
type Log = [Move]
type Game = (Log, S)

start = S [Wolf, Goat, Cabbage] []

newGame :: S -> Game
newGame s = ([], s)

safe s = safe' (otherbank s)
  where
  safe' cs = not $ (Wolf `elem` cs && Goat `elem` cs) ||
                   (Goat `elem` cs && Cabbage `elem` cs)

move :: Game -> Move -> Game
move (l,s) c'@(Just c) = (c':l, S (c:(otherbank s)) (filter (/=c) (thisbank s)))
move (l,s) Nothing = (Nothing:l, S (otherbank s) (thisbank s))

safeMoves :: S -> [Move]
safeMoves s = let ms = Nothing : (map Just (thisbank s))
              in  filter (safe . snd . move (newGame s)) ms

deeper :: [Game] -> [Game]
deeper = concatMap deeper1
  where
  deeper1 :: Game -> [Game]
  deeper1 g@(l,s) = map (move g) . filter (notLast l) $ safeMoves s
  notLast (m':_) m = m' /= m
  notLast [] _ = True

isSolution :: Game -> Bool
isSolution (l, s) = (odd . length $ l) && (null . otherbank $ s)

someSolution :: Game
someSolution = let ss = iterate deeper [newGame start]
               in  head . head . dropWhile null . map (filter isSolution) $ ss 

showSolution :: Game -> String
showSolution = intercalate "\n" . map show . reverse . fst

main = putStrLn . showSolution $ someSolution

Just Goat
Nothing
Just Wolf
Just Goat
Just Cabbage
Nothing
Just Goat