ポーカーの勝敗判定
haskell入門中
■参考
http://www6.airnet.ne.jp/spade/poker/rule/yaku.html
import Data.List import Data.Maybe import Random data Suit = Spade | Heart | Diamond | Club deriving (Eq, Enum, Show) type Rank = Int data Card = Card Rank Suit deriving Show data Pair = Pair Rank Int deriving Show data Role = HighCard | OnePair | TwoPair | ThreeOfAKind | Straight | Flush | FullHouse | FourOfAKind | StraightFlush | RoyalFlush deriving (Eq, Ord, Show) data Hand = Hand Role [Rank] deriving Show run :: [Card] -> [Card] -> Ordering run p1 p2 = deal (analysis p1) (analysis p2) deal :: Hand -> Hand -> Ordering deal (Hand h1 r1) (Hand h2 r2) | h1 /= h2 = h2 `compare` h1 | otherwise = r2 `compare` r1 analysis :: [Card] -> Hand analysis cs = let rs = sortRank cs s = straight rs f = flash cs ps = pair rs hs = highcard rs in hand s f ps hs where sortRank :: [Card] -> [Rank] sortRank = sortRoyal . toRanks where toRanks = map $ \(Card r _) -> r sortRoyal rs | rs == [1, 2, 3, 4, 5] = rs | otherwise = sort $ map (\r -> if r == 1 then 14 else r) rs straight :: [Rank] -> Bool straight rs = all (== 1) $ zipWith (-) (tail rs) rs flash :: [Card] -> Bool flash = same . toSuits where toSuits = map $ \(Card _ s) -> s same (s:ss) = all (== s) ss pair :: [Rank] -> [Pair] pair = (map (\xs -> Pair (head xs) (length xs))) . (filter ((> 1) . length)) . group highcard :: [Rank] -> [Rank] highcard = concat . (filter ((== 1) . length)) . group hand :: Bool -> Bool -> [Pair] -> [Rank] -> Hand hand True True [ ] rs | rs == [10, 11, 12, 13, 14] = Hand RoyalFlush [] | otherwise = Hand StraightFlush [head rs] hand False False [(Pair r 4) ] rs = Hand FourOfAKind $ r:reverse rs hand False False [(Pair r2 2), (Pair r3 3)] _ = Hand FullHouse [r3, r2] hand False False [(Pair r3 3), (Pair r2 2)] _ = Hand FullHouse [r3, r2] hand False True [ ] rs = Hand Flush [head rs] hand True False [ ] rs = Hand Straight [head rs] hand False False [(Pair r 3) ] rs = Hand ThreeOfAKind $ r:reverse rs hand False False [(Pair r1 2), (Pair r2 2)] rs = Hand TwoPair $ r2:r1:reverse rs hand False False [(Pair r 2) ] rs = Hand OnePair $ r:reverse rs hand False False [ ] rs = Hand HighCard $ reverse rs
ランダムに対戦させてみる。
cards = [(Card r s) | r <- [1 .. 13], s <- [Spade .. Club]] main = do cards' <- getStdGen >>= (\g -> return $ shuffle g cards) mapM_ (\(p1, p2) -> poker p1 p2) $ oddEvenList $ splits 5 cards' where poker :: [Card] -> [Card] -> IO () poker p1 p2 = do print $ "p1 = " ++ (show p1) print $ " = " ++ (show $ analysis p1) print $ "p2 = " ++ (show p2) print $ " = " ++ (show $ analysis p2) print $ msg $ run p1 p2 where msg LT = "P1 Win!!" msg GT = "P1 Lose..." msg EQ = "even" splits :: Int -> [a] -> [[a]] splits n xs | length xs >= n = let (x, xs') = splitAt n xs in x : splits n xs' | otherwise = [] oddEvenList :: [a] -> [(a, a)] oddEvenList xs = zip (oddList xs) (evenList xs) where filterList :: ([a] -> Bool) -> [a] -> [a] filterList p [] = [] filterList p (x:xs) | p xs = x : filterList p xs | otherwise = filterList p xs oddList = filterList (odd . length) evenList = filterList (even . length) shuffle g [] = [] shuffle g xs = x : shuffle g' rest where (n, g') = randomR (0, length xs - 1) g (x, rest) = pick n xs pick :: Int -> [a] -> (a, [a]) pick n xs = let (ys, p:zs) = splitAt n xs in (p, ys++zs)