Haskellでポーカーを作ろう〜第四回 ポーカー・ハンドの判定をする 後編〜

ポーカー開発の連載書きながら、 改めてコード書くより日本語書くほうが難しいなぁと感じています。 ちゅーんさんです、おはこんばんちわ。

ドクター・スランプネタなんて今時通じる人居るんですかね、 ちなみに実家には全巻揃っていたので、ひと通り読みました。

聞いてないですね

はい

このエントリは、ちゅーんさんによるポーカー開発連載記事の第四回目です。
過去のエントリはこちら

第一回 リストのシャッフルとカードの定義
第二回 ポーカー・ハンドの判定をする　前編
第三回 ポーカー・ハンドの判定をする　中編

状況整理

さて、いよいよポーカー・ハンドの判定処理も大詰めです。
簡単に現状を整理して、残りのやる事を再確認しましょう。

まず、手札は5枚である必要があり、予めソートしておく事で判定処理を行いやすいという理由から、 次のようなHand型を定義しました。

newtype Hand = Hand { fromHand :: [Card] } deriving (Show, Eq, Ord)

toHand :: [Card] -> Maybe Hand
toHand l = 
  if length l == 5 
    then Just $ Hand (sort l)
    else Nothing

必ずtoHand関数を使ってHand型を作るようにする事で、 Hand型のリストの要素数が5で、ソート済みである事を保証するようにしたのですね。

んで、ひと通り型設計を終えたので、 各ポーカー・ハンドの判定処理を行うための前段階として、以下の3つの関数を実装したのでした。

straightHint :: Hand -> Maybe Card
flushHint :: Hand -> Maybe Card
nOfKindHint :: Int -> Hand -> Maybe [[Card]]

これら３つの関数があれば、以下の各ポーカー・ハンドを判定できるはずでしたね。

straightFlush :: Hand -> Maybe (PokerHand, Card)
fourOfAKind :: Hand -> Maybe (PokerHand, Card)
fullHouse :: Hand -> Maybe (PokerHand, Card)
flush :: Hand -> Maybe (PokerHand, Card)
straight :: Hand -> Maybe (PokerHand, Card)
threeOfAKind :: Hand -> Maybe (PokerHand, Card)
twoPair :: Hand -> Maybe (PokerHand, Card)
onePair :: Hand -> Maybe (PokerHand, Card)

そして、最終的に以下のpokerHand関数を定義するのが、本エントリの最後の目標です。

pokerHand :: Hand -> (PokerHand, Card)

Maybeモナドの話

各ハンドの判定処理を作るにあたって、Maybeモナドの使い方を覚えておくと、とても楽です。
「モナドとは何か」みたいな難しい事は考えず、単純に道具として使えるようになってしまいましょう。

mplus関数は「どちらか」がJustであれば、具体的な結果を返す事ができました。 この事はMaybe型が3つ以上の場合は『「どれか」がJustであれば具体的な結果を返す事ができる』と言い換えても良いですね。

対して、Maybeモナドは、「すべてが」Justである時に、具体的な結果を返す計算を楽に書くための道具です。 IOモナドがdo構文を使って手続き的にプログラミングできたように、Maybeの場合もdo構文を使う事ができます。

io_monad :: IO Hoge
io_monad = do
  exp1
  exp2
  ....

maybe_monad :: Maybe Hoge
maybe_monad = do
  exp3
  exp4
  ....

難しいことは考えずに、型を合わせる事を考えましょう。IOモナドのdo構文内では、すべての行がIO型である事が要求されています。 同様にMaybeモナドのdo構文内では全ての行がMaybe型である必要があります。

具体的な例を見ていきましょう。 ユーザーから入力を一行受け取るIO処理、getLine関数は次のような型を持っています。

getLine :: IO String

このgetLine関数をつかって、 次のようなプログラムを書いた時、(<-)の左側の変数、 xとyはgetLineの型からIOが外れた、String型となります。

io_monad :: IO String
io_monad = do
  x <- getLine
  y <- getLine
  -- x, y :: Stringなので次のように(++)演算子で合成可能
  return $ x ++ y

getLine :: IO StringのIOをMaybeに差し替えた、Maybe Stringという型の値がいくつかあったとしますね。

may1 :: Maybe String
may1 = 〜？？？〜

may2 :: Maybe String
may2 = 〜？？？〜

MaybeモナドもIOモナドの時と同じように、 do構文の中で(<-)を使うと、Maybeが外れてString型のx, yを得る事ができます。

maybe_monad :: Maybe String
maybe_monad = do
  x <- may1
  y <- may2
  -- 型が変わっても x, y :: String
  return $ x ++ y

上記のmaybe_monadはmay1とmay2が「どちらも」Justだった場合のみに具体的な結果を返し、 それ以外の場合（つまりどちらか片方でもNothingだった場合）はNothingとなります。

may1	may2	maybe_monad
Just "Hoge"	Just "Piyo"	Join "HogePiyo"
Just "Hoge"	Nothing	Nothing
Nothing	Just "Piyo"	Nothing
Nothing	Nothing	Nothing

もし、これと同等のプログラムを、パターンマッチだけで実現しようとすると、 次のようなプログラムになってしまうでしょう。

without_monad :: Maybe String
without_monad = 
  case may1 of
    Just x -> case may2 of
      Just y -> Just $ x ++ y
      Nothing -> Nothing
    Nothing -> Nothing

当然、チェックしたいMaybe型の値が増えれば増えるほど、 パターンマッチのネストは増えて行き、どんどんプログラムは読みづらくなってしまいます。

しかし、do構文を使う事によって、Maybe型の値がいくら増えても、 すべての値がJustだった場合のパターンのみを意識して記述すれば良いので、 結果としてノイズの少ない、スッキリしたプログラムを書くことができるのです。

maybe_monad :: Maybe String
maybe_monad = do
  x <- may1
  y <- may2
  z <- may3
  ...
  w <- mayn
  
  return $ 〜 x .. w を使った何か計算 〜

各ハンドの判定処理

さて、いよいよ各ハンドの実装を書いて行きますよ〜。
くどいようですが念の為、ハンドを判定するための３つの関数の型をもう一度だけ再掲します。

straightHint :: Hand -> Maybe Card
flushHint :: Hand -> Maybe Card
nOfKindHint :: Int -> Hand -> Maybe [[Card]]

ここから先は「部品の組み立て」フェーズなので勢いに任せてだだーっと行っちゃいましょう。 弱いハンドから順に作りますよっと。

ワンペアを作る

ワンペアの場合、nOfKindHintで2枚組を捜して、一枚でも見つかれば判定成功です。
nOfKindHintの返却値はMaybe [[Card]]ですが、 このままだと最強カードを選択するのにちょっと不便なので、concat :: [[a]] -> [a]という関数を使いましょう。

onePair :: Hand -> Maybe (PokerHand, Card)
onePair h = do
  cs <- nOfKindHint 2 h
  return (OnePair, last $ concat cs)

ワンペアであれば、返り値は必ず同じ強さのカード2枚になるはずなので、 最強カードの判定はlastではなくheadのほうがパフォーマンスが良さそうな気はするのですが、 この関数はツーペアでもJustを返すので、ちゃんと強いカードを選択するようにしておいたほうが良いでしょう。

ちなみに、(,) :: a -> b -> (a, b)という事を知っていれば、 部分適用を利用して以下のようにポイントフリースタイルで書けたりするんですが・・・

onePair' :: Hand -> Maybe (PokerHand, Card)
onePair' = fmap (((,) OnePair) . last . join) . nOfKindHint 2 

今回はMaybeモナドの練習と、他のハンドとも記法を併せたほうが読みやすいという意味で、 すべてMaybeモナドを使って実装して行こうと思います。

ツーペアを作る

ツーペアーの場合nOfKindHintの結果のレコード数が2件になるはずなので、 lengthの結果を見てやればOKです。

twoPair :: Hand -> Maybe (PokerHand, Card)
twoPair h = do
  cs <- nOfKindHint 2 h
  if length cs == 2
    then Just (TwoPair, last $ concat cs)
    else Nothing

do構文の二行目が突然if式ではじまって、一行で終わっていますが、 do構文では最後の行が返却値になりますので、if式の型がMaybe (PokerHand, Card)であれば、その式を評価した結果を返します。 （余力のある人は、Maybeのdo構文内では、return :: a -> Maybe aとなる事について考えてみましょう。）

スリーカードを作る

スリーカードは、nOfKindHintの長さを調べる必要もありませんし、 ワンペアと一緒でOKです。

threeOfAKind :: Hand -> Maybe (PokerHand, Card)
threeOfAKind h = do
  cs <- nOfKindHint 3 h
  return (ThreeOfAKind, last $ concat cs)

ストレート

ストレートの場合、チェックすべき事はstraightHint関数ですべてチェック済なので、 そのまま取得した最強カードをPokerHand型と一緒に返せば良いだけです。

straight :: Hand -> Maybe (PokerHand, Card)
straight h = do
  c <- straightHint h
  return (Straight, c)

フラッシュ

ストレートの場合と一緒です。

flush :: Hand -> Maybe (PokerHand, Card)
flush h = do
  c <- flushHint h
  return (Flush, c)

フルハウス

フルハウスは、2つ組と3つ組が両方見つかれば成立します。

Maybe型を返すnOfKindHint関数を二回実行する必要があり、両方がJustの場合のみフルハウスになりるわけですが、 Maybeモナドが使える今なら何も恐ろしい事はありませんっ！

fullHouse :: Hand -> Maybe (PokerHand, Card)
fullHouse h = do
  cs1 <- nOfKindHint 3 h
  cs2 <- nOfKindHint 2 h
  return (FullHouse, maximum $ concat cs1 ++ concat cs2)

2つ組と3つ組、どちらのカードが強いかどうかは分からないので、 最強カードの選択にはmaximum関数を使います。

フォーカード

スリーカードの場合と一緒です

fourOfAKind :: Hand -> Maybe (PokerHand, Card)
fourOfAKind h = do
  cs <- nOfKindHint 4 h
  return (FourOfAKind, maximum $ concat cs)

ストレート・フラッシュ

ストレート・フラッシュはstraightFlushとflushHintの両方を満たせばOKです。

straightFlush :: Hand -> Maybe (PokerHand, Card)
straightFlush h = do
  c <- straightHint h
  d <- flushHint h
  return (StraightFlush, max c d)

ところで、どちらのハンドも５枚のカード全てが判定条件になるため、 必然的にcもdも同じカードになるはずです。

変数へのバインド((<-)を使った代入のような処理)をしなかった場合、 返却値は捨てられるだけなので、次のように書いても結果は同じですね。

straightFlush :: Hand -> Maybe (PokerHand, Card)
straightFlush h = do
  c <- straightHint h
  flushHint h
  return (StraightFlush, c)

判定処理を完成させる

さて、これで全てのハンド判定処理の実装が完了しましたので、 最後に手札がどのポーカー・ハンドになるのか判定する以下の関数を実装して完成です。

ついにここまで来ました

pokerHand :: Hand -> (PokerHand, Card)

まず、次のようなhandsという「関数のリスト」を作りましょう。 すぐに理由はわかりますが、リストは強いハンドから弱いハンドの順に並べます。

hands :: [Hand -> Maybe (PokerHand, Card)]
hands = 
  [ straightFlush
  , fourOfAKind
  , fullHouse
  , flush
  , straight
  , threeOfAKind
  , twoPair
  , onePair 
  ]

このリスト内の関数に一気に同じHand型を適用して、 [Maybe (PokerHand, Card)]という型のリストを得る方法を考えましょう。

単純にラムダ式を使うと次のような感じですかね。

h :: Hand

として

map (\f -> f h) hands :: [Maybe (PokerHand, Card)]

この中のh :: Handもラムダ式の引数に取るようにしてみましょう。

map ((\v f -> f v) h) hands :: [Maybe (PokerHand, Card)]

ラムダ式の型は次のようになっています。

(\v f -> f v) :: a -> (a -> b) -> b

で、この関数をflipすると($)演算子と同じ型になるのです。

flip (\v f -> f v) :: (a -> b) -> a -> b
($)                :: (a -> b) -> a -> b

($)は演算子なのでセクション記法を使って、($h)のように右辺にh :: Handを部分適用する事が可能です。
この($h)は先ほど作った\f -> f hというラムダ式と同じ意味になりますから、 結果的に[Maybe (PokerHand, Card)]というリストは、次のようにして作る事ができます。

fmap ($h) hands :: [Maybe (PokerHand, Card)]

このリストは、各ポーカーハンド判定処理を実行した結果です。 つまり、このリストの中から最強のハンドを選択すれば良いわけですね。

最強のハンドを選択する事は難しいことではありません、前回紹介したmplus関数は両辺ともJustの場合、左辺を返すのでした。 予めリストを作る際に、強いハンドから順に並べておいたのでfoldl関数で畳み込んでやれば、 最強のポーカー・ハンドが取り出せるという事がわかるでしょう。

foldl mplus Nothing $ fmap ($h) hands :: Maybe (PokerHand, Card)

さて、この結果がNothingだった場合は役なし（ハイ・カード）となります。
PokerHand型を定義する際、役なしを表すHighCardsというデータコンストラクタを作っておいた事を思い出してください。

役なしを表す明確なデータがあるのですから、いつまでもMaybe型にしておく必要はありませんね。
パターンマッチで引っぺがして、HighCardsも返せるようにしちゃいます。

ついでにhandsもこの関数の中でしか使われませんから、where句でくくってしまいましょう。

結果、ポーカー・ハンドを判定するpokerHand関数の実装は以下のようになりました。

pokerHand :: Hand -> (PokerHand, Card)
pokerHand h@(Hand l) = 
    case foldl mplus Nothing $ fmap ($h) hands of
      Just pc -> pc
      Nothing -> (HighCards, last l)
  where
    hands :: [Hand -> Maybe (PokerHand, Card)]
    hands = 
      [ straightFlush
      , fourOfAKind
      , fullHouse
      , flush
      , straight
      , threeOfAKind
      , twoPair
      , onePair 
      ]

動作確認してみよう

まず、Hands.hsのモジュールの定義を以下のようにしましょう。

module Hands
  ( Hand
  , toHand, fromHand
  , PokerHand(..)
  , pokerHand
  ----
  -- hint
  , straightHint
  , flushHint
  , nOfKindHint
  ----
  -- hand
  , straightFlush
  , fourOfAKind
  , fullHouse
  , flush
  , straight
  , threeOfAKind
  , twoPair
  , onePair
  ) where

自由に手札が作られては困るので、Hand型のデータコンストラクタはエクスポートしないのでしたね。 各ハンドの判定処理もエクスポートしているのには、後々思考ルーチンなんかを作るのに役立つ可能性があるからです。

その上で、次のようなMain.hsを用意すれば、今回作った判定処理の動作確認を行う事ができます。

Maybeモナドと、ちょっとしたIO処理が使えれば読むことができるはずなので、 今回は解説は行いません。

module Main where
import Cards
import Hands

import System.Random.Shuffle

main :: IO ()
main = do
  hand <- randomHand
  res <- return $ judgePoker hand
  print $ show hand ++ " -> " ++ show res

randomHand :: IO (Maybe Hand)
randomHand = do
  shuffled <- shuffleM allCards
  return . toHand . take 5 $ shuffled

judgePoker :: Maybe Hand -> Maybe (PokerHand, Card)
judgePoker h = do
  i <- h
  return $ pokerHand i

うーん、強いハンドはなかなか出ないので、一度に500件くらい表示できると嬉しいですね。

再起処理にしても良いですが、Control.MonadモジュールにあるforM_という関数を使えば、 メインストリームの手続きプログラミング言語のforeachと同じような書き方が出来ますよん。 (例によって詳しく説明はしませんが、パターンとして覚えておくと便利かもです。)

main :: IO ()
main = do
  forM_ [1..500] $ \i -> do
    hand <- randomHand
    res <- return $ judgePoker hand
    putStrLn $ show i ++ "   " ++ show hand ++ " -> " ++ show res

試しに、僕の環境で一回動かしてみたら、次のような実行結果を得る事ができました。

1   Just (Hand {fromHand = [H3_,C4_,D7_,H10,SK_]}) -> Just (HighCards,SK_)
2   Just (Hand {fromHand = [D4_,C5_,C8_,HQ_,DQ_]}) -> Just (OnePair,DQ_)
3   Just (Hand {fromHand = [D5_,C6_,S9_,DJ_,CK_]}) -> Just (HighCards,CK_)
4   Just (Hand {fromHand = [C3_,D5_,S7_,S8_,C10]}) -> Just (HighCards,C10)
5   Just (Hand {fromHand = [H3_,H7_,CJ_,DK_,HA_]}) -> Just (HighCards,HA_)
6   Just (Hand {fromHand = [C4_,CJ_,SJ_,CQ_,CA_]}) -> Just (OnePair,SJ_)
7   Just (Hand {fromHand = [S4_,C8_,S8_,D10,CK_]}) -> Just (OnePair,S8_)
8   Just (Hand {fromHand = [H2_,D7_,H9_,C9_,CA_]}) -> Just (OnePair,C9_)
9   Just (Hand {fromHand = [C2_,C4_,H5_,D5_,D10]}) -> Just (OnePair,D5_)
10   Just (Hand {fromHand = [S5_,D8_,SJ_,CQ_,CK_]}) -> Just (HighCards,CK_)
11   Just (Hand {fromHand = [H10,HQ_,HA_,DA_,SA_]}) -> Just (ThreeOfAKind,SA_)
12   Just (Hand {fromHand = [D2_,H3_,D4_,C6_,DK_]}) -> Just (HighCards,DK_)
13   Just (Hand {fromHand = [H7_,H8_,C9_,H10,HA_]}) -> Just (HighCards,HA_)
14   Just (Hand {fromHand = [H3_,D6_,DJ_,CJ_,DA_]}) -> Just (OnePair,CJ_)
15   Just (Hand {fromHand = [C3_,S9_,DJ_,CJ_,HA_]}) -> Just (OnePair,CJ_)
16   Just (Hand {fromHand = [D3_,S3_,H4_,S4_,H5_]}) -> Just (TwoPair,S4_)
17   Just (Hand {fromHand = [C4_,S5_,C7_,CJ_,CA_]}) -> Just (HighCards,CA_)
18   Just (Hand {fromHand = [H5_,S5_,DQ_,CK_,SA_]}) -> Just (OnePair,S5_)
19   Just (Hand {fromHand = [C2_,C5_,H6_,C8_,D10]}) -> Just (HighCards,D10)
20   Just (Hand {fromHand = [D4_,C4_,D6_,C7_,SJ_]}) -> Just (OnePair,C4_)

うんうん、上手く動いてるっぽいですね。

まとめ

というわけで、最初の目標であった、「ポーカー・ハンド」の判定処理を完成させる事ができました。

次回の内容はまだちゃんと決まっているわけではありませんが、 ハンドの入れ替え処理とか、その辺の手をつけやすい所から作っていこうかなぁとか考えています。

5/30日にちょっと大きな勉強会を控えており、そのための発表資料づくりがありますので、 ちょっと間が開くとは思いますが、気長にお待ちいただければ幸いです。

それでは、ノシノシ

←前 次→