５４問目

http://projecteuler.net/index.php?section=problems&id=54
ポーカーの手を二人分千組含むファイルから、一人目のプレイヤーが勝つ組がいくつあるかを求める。
それぞれの手についてワンペアは1点、ロイヤルフラッシュは9点といった点数をつけ、その大小を比べています。点数が同じときは手に含まれるカードの数字を順番に比べていきます。
実際のファイルにはロイヤルフラッシュもストレートフラッシュもありませんでした。残念。

import Data.Char
import Data.List
import Data.Ord

main = do
  cs <- readFile "poker.txt"
  print $ length $ euler054 $ map ((splitAt 5) . (map pre) . words) $ lines cs

pre :: String -> (Int, Char)
pre [n, c] = (n', c)
  where n'
      | (n == 'A') = 14
      | (n == 'K') = 13
      | (n == 'Q') = 12
      | (n == 'J') = 11
      | (n == 'T') = 10
      | otherwise = digitToInt n

euler054 :: [([(Int, Char)], [(Int, Char)])] -> [([Int], [Int])]
euler054 = filter p1win . map (\ (a, b) -> (score $ order a, score $ order b))

order :: [(Int, Char)] -> ([[Int]], [Char])
order xs = (reverse $ sortBy (comparing length) $ group $ sort $ fst $ unzip xs,
  nub $ snd $ unzip xs)

p1win :: ([Int], [Int]) -> Bool
p1win (n1:ns1, n2:ns2) = if (n1 > n2)
  then True
  else if (n1 < n2)
    then False
    else p1win (ns1, ns2)

score :: ([[Int]], [Char]) -> [Int]
score (ns, cs) = if (isFlush cs)
    then if (isStraight ns)
      then if (isRoyal ns)
        then 9 : map head ns -- Royal Flush
        else 8 : map head ns -- Straight Flush
      else 5 : map head ns -- Flush
    else if ((map length ns) == [1,1,1,1,1])
      then if (isStraight ns)
        then 4 : map head ns -- Straight
        else 0 : map head ns -- High Card
      else if ((map length ns) == [2,1,1,1])
        then 1 : map head ns -- One Pair
        else if ((map length ns) == [2,2,1])
          then 2 : map head ns -- Two Pairs
          else if ((map length ns) == [3,1,1])
            then 3 : map head ns -- Three of a Kind
            else if ((map length ns) == [3,2])
              then 6 : map head ns -- Full House
              else 7 : map head ns -- Four of a Kind

isStraight :: [[Int]] -> Bool
isStraight (n:ns) = ns == [ [(head n) - i] | i <- [1..4] ]

isFlush :: [Char] -> Bool
isFlush cs = length cs == 1

isRoyal:: [[Int]] -> Bool
isRoyal (n:ns) = head n == 10