Created
October 6, 2011 23:58
-
-
Save astanin/1269063 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{- Два солдата подошли к реке, по которой на лодке катаются двое | |
мальчиков. Как солдатам переправиться на другой берег, если лодка | |
вмещает только одного солдата либо двух мальчиков, а солдата и | |
мальчика уже не вмещает? -} | |
import Data.List (intercalate, (\\), sort, nub, permutations) | |
data C = Boy | Soldier deriving (Show, Eq, Ord) | |
data S = S { thisbank :: [C], otherbank :: [C] } deriving (Show) | |
type Move = [C] | |
type Log = [Move] | |
type Game = (Log, S) | |
start = S [Boy, Boy, Soldier, Soldier] [] | |
newGame :: S -> Game | |
newGame s = ([], s) | |
safe :: S -> Bool | |
safe _ = True | |
allowed :: Move -> Bool | |
allowed cs = let n = length cs | |
w Boy = 1 | |
w Soldier = 2 | |
m = sum $ map w cs | |
in n >= 1 && n <= 2 && m <= 2 | |
move :: Game -> Move -> Game | |
move (l,s) cs = (cs:l, S (cs ++ otherbank s) ((thisbank s) \\ cs)) | |
safeMoves :: S -> [Move] | |
safeMoves s = | |
let ms = nub . sort $ map (:[]) (thisbank s) | |
ms2 = nub . sort . map (take 2) . permutations $ thisbank s | |
in filter (safe . snd . move (newGame s)) . filter allowed $ ms ++ ms2 | |
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 . filter (==Soldier) . 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
[Boy,Boy]
[Boy]
[Soldier]
[Boy]
[Soldier]