みずぴー日記

兄弟の論理クイズ

Haskell 30分プログラム

30分プログラム、その231。兄弟の論理クイズをリストモナドで解いてみる。

5人兄弟が年長順に並んXいます。
それぞれの背中にはOかXのマークが書かれています。
自分の背中のマークは見えませんが、自分より前の兄弟の背中は見えます。
1〜5がそれぞれ上から何番目の息子さんか当てましょう。

Oが2つあるな。

Xが2つ見える。

1と2がそういうなら、俺はXかな

俺の前はOだ

帰っていい?

使い方

*Main> main
[('5',O),('4',O),('1',X),('3',X),('2',O)]
[('5',O),('4',O),('1',X),('3',X),('2',X)]
[('3',X),('5',X),('2',O),('4',O),('1',O)]
[('5',X),('3',X),('2',O),('4',O),('1',O)]
[('3',X),('5',X),('2',O),('4',O),('1',X)]
[('5',X),('3',X),('2',O),('4',O),('1',X)]

さて、困ったことに解がひとつじゃない。出題ミスだー、と騒いでおこう。

ソースコード

import Control.Monad
import Data.List

data Mark = Maru | Peke deriving Eq
type Order = Int
type State = [Order]
type Person = (Order,Mark)

instance Show Mark where
    show Maru = "O"
    show Peke = "X"

person :: State->[ (Person,State) ]
person orders = do order <- orders
                   mark  <- [Maru,Peke]
                   return ((order,mark),delete order orders)

getFront :: Order -> Mark -> [Person] -> Int
getFront n mark = length . filter (\(i,m)-> i < n && m == mark)

assertA :: Person -> [Person] -> Bool
assertB :: Person -> [Person] -> Bool
assertC :: Person -> [Person] -> Bool
assertD :: Person -> [Person] -> Bool
assertE :: Person -> [Person] -> Bool

assertA (n,_) xs = 2 == (getFront n Maru xs)
assertB (n,_) xs = 2 == (getFront n Peke xs)

assertC (n,_) xs = 
    let guess =  do (a,b,c,d,e) <- makePeople
                    guard $ map fst [a,b,d,e] == map fst xs
                    guard $ fst c == n
                    guard $ assertA a [b,c,d,e]
                    guard $ assertB b [a,c,d,e]
                    return $ snd c == Peke
    in and guess

assertD (n,_) xs = case find (\(m,_)-> m+1 == n) xs of
                     Just (_,mark) -> mark == Maru
                     _             -> False

assertE _ _ = True

makePeople = do (a,s1) <- person [1..5]
                (b,s2) <- person s1
                (c,s3) <- person s2
                (d,s4) <- person s3
                (e,_ ) <- person s4
                return (a,b,c,d,e)

selva = do (a,b,c,d,e) <- makePeople
           guard $ assertA a [b,c,d,e]
           guard $ assertB b [a,c,d,e]
           guard $ assertC c [a,b,d,e]
           guard $ assertD d [a,b,c,e]
           guard $ assertE e [a,b,c,d]
           return [a,b,c,d,e]

main = let sort xs = sortBy (\((a,_),_) ((b,_),_)->compare a b) $ zip xs ['1'..]
           format xs = map (\((_,m),n)-> (n,m)) xs
       in mapM_ (print.format.sort) selva

参考