# ポーカーの勝敗判定

```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)
```