Project Euler 54

http://projecteuler.net/index.php?section=problems&id=54


カスタムのソートはsortByを使う。

import Data.List

a = [ 3, 1, 4, 1, 5 ]
b = sort a          -- [1,1,3,4,5]
c = zip [1..] a
d = sortBy cmp c    -- [(2,1),(4,1),(1,3),(3,4),(5,5)]
cmp (n1,m1) (n2,m2) = compare m1 m2

compareは引数の大小に応じて、LT,EQ,GTの値を取る関数。

compare 1 2     -- LT
compare 2 2     -- EQ
compare 2 1     -- GT

sortByの第1引数も同様にLT,EQ,GTの値を取る関数を指定すればよい。

import Data.List

index [] e = -1
index (x:xs) e = if x == e then 0 else
                if p == -1 then -1 else p + 1 where p = index xs e

count [] e = 0
count (x:xs) e = (if x == e then 1 else 0) + (count xs e)

card :: [Char] -> (Int,Char)
card [s,t] = (index "23456789TJQKA" s, t)
hands :: [Char] -> ([(Int,Char)],[(Int,Char)])
hands s = divide (map card (words s)) where
            divide [] = ([], [])
            divide (c:cs) | length (c:cs) > 5 = ([c] ++ a1, a2)
                          | otherwise         = (a1, [c] ++ a2)
                                where (a1,a2) = divide cs

collect nums = sortBy comp (f 12) where
        g (-1) = []
        g n = (count nums n, n):(g (n - 1))
        f n = filter (\(n,_) -> n > 0) (g n)
        comp (n1,m1) (n2,m2) = if n1 /= n2 then compare n2 n1
                               else compare m2 m1

comb_rank group = if group == [1,1,1,1,1]   then 0
             else if group == [2,1,1,1]     then 1
             else if group == [2,2,1]       then 2
             else if group == [3,1,1]       then 3
             else if group == [3,2]         then 6
             else if group == [4,1]         then 7
             else -1

rank :: [(Int,Char)] -> [Int]
rank hand = (r nums suits):ds where
    (nums,suits) = unzip hand
    (group,ds) = unzip (collect nums)
    is_flush [s]      = True
    is_flush (s:t:ss) = if s == t then is_flush (t:ss) else False
    is_straight [n]      = True
    is_straight (n:m:ns) = if n == m + 1 then is_straight (m:ns) else False
    is_royal (n:ns) = n == 12
    r nums suits = if (length group) == 5 then
                        if is_flush suits then
                            if is_straight ds then
                                if is_royal ds then 9 else 8
                            else 5
                        else if is_straight ds then 4
                            else 0
                    else comb_rank group

decide (h1,h2) = (compare (rank h1) (rank h2)) == GT

main = do
    cs <- readFile "poker.txt"
    print (length (filter decide (map hands (lines cs))))