ポーカーの役判定

http://d.hatena.ne.jp/argius/20080117/1200590510 を見ておもしろそうだなと思ったので書いてみた。そしてどう書く？org(http://ja.doukaku.org/121/)にも久し振りの投稿。

haskellではデータ構造が簡単に定義できるので、これくらいでも使いたくなる。コードの半分くらいがデータ構造の定義と文字列とのインターフェイスになってしまった。役までdataを使って書いてるのは、テストコードをちゃんと書こうと思ってやめたなごり。
入力チェックは全くやってないので、変な入力がはいるとエラーで落ちるか変な結果がでます。

testを実行するとこんなん。

("SQSJSASKST",Royal flush)
("D9D7D6D5D8",Straight flush)
("C2D2S2H3H2",Four of a kind)
("C2D3S2H3H2",Full House)
("S9S4S8STSJ",Flush)
("C4H7D5S6H3",Straight)
("S6H6C5DQC6",Three of a kind)
("S6HQC5DQC6",Two pair)
("S6H4C5DQC6",One pair)
("SJSQSKSAC2",No pair)

確定した役と可能性のある役を列挙するオンライン判定版、というのもおもしろいかもしれない。

以下ソース。

import System
import List(sort,group,elemIndex)
import Maybe(fromJust)

data Card = Card {suits::Suits,rank::Int} deriving Show
data Suits = S | D | H | C deriving (Read,Eq,Show)
data Hand = RF | STF | FK | FH | F | ST | TK | TP | OP | NO

read_cards :: String -> [Card]
read_cards str = map read_card $ split_2 str
    where 
      read_card [s,r] = Card (read [s])
                        (fromJust (elemIndex r "DD23456789TJQKA"))
      split_2 [] = []
      split_2 list = let (hd,rest) = splitAt 2 list in  hd : split_2 rest

instance Show Hand where
    show h = case h of
               RF  -> "Royal flush"
               STF -> "Straight flush"
               FK  -> "Four of a kind"
               FH  -> "Full House"
               F   -> "Flush"
               ST  -> "Straight"
               TK  -> "Three of a kind"
               TP  -> "Two pair"
               OP  -> "One pair"
               NO  -> "No pair"

hand :: [Card] -> Hand
hand  cards
    | check_st  && check_flush  && head rank_seq == 10 = RF
    | check_st  && check_flush  = STF
    | max_group == 4 = FK
    | sort group_count == [2,3] = FH
    | check_flush  = F
    | check_st = ST
    | max_group ==  3 = TK
    | pair_count == 2 = TP
    | pair_count == 1 = OP
    | otherwise = NO
    where
      rank_seq = sort $ map rank cards
      groups = group rank_seq
      group_count = map length groups
      max_group = foldl1 max group_count
      pair_count = length (filter (\l->length l == 2) groups)

      check_flush = all (\c->suits c==suits (head cards)) cards
      check_st = normal || rank_seq == [2,3,4,5,14]
          where
            normal = and $ zipWith (\a b->a-b == head rank_seq) rank_seq [0..]

main = getArgs >>= print . hand . read_cards . head

-- Test
test = mapM_ print $ zip testlist (map (hand .read_cards) testlist)

testlist = ["SQSJSASKST",
            "D9D7D6D5D8",
            "C2D2S2H3H2",
            "C2D3S2H3H2",
            "S9S4S8STSJ",
            "C4H7D5S6H3",
            "S6H6C5DQC6",
            "S6HQC5DQC6",
            "S6H4C5DQC6",
            "SJSQSKSAC2"]