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

はいどーも、我が家にポーカーチップとトランプカードが届きました。
ポーカー作っていたら、うっかりポーカーそのものが楽しくなってしまったちゅーんさんです、ハロ／ハワユ

テキサス・ホールデム本当に楽しい・・・楽しいです・・・ 楽しい・・・楽しい！！やろう！！やろうよ！一緒にやろうよー！！！

・・・落ち着きました。

そんなわけで、このエントリは、ちゅーんさんによるポーカー開発連載記事の第三回目です。

過去のエントリはこちら

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

ポーカー・ハンドの判定条件を整理する

前回、ワンペアからストレート・フラッシュまで、 全てのポーカー・ハンドを判定する関数の型を、以下のように定義しました。

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

今から、これら関数の中身を実際に作りこんでいくわけですが、 実際に書き始める前に、各ハンドの判定条件について、日本語で少し整理してみましょう。

• ストレート・フラッシュ
  • 同じスートのカードが5枚揃っていること
  • 連続する番号のカードが5枚揃っていること
• フォーカード
  • 同じ番号の4枚組が1セット以上あること
• フルハウス
  • 同じ番号の3枚組が1セット以上あること
  • 同じ番号の2枚組が1セット以上あること
• フラッシュ
  • 同じスートのカードが5枚揃っていること
• ストレート
  • 連続する番号のカードが5枚揃っていること
• スリーカード
  • 同じ番号の3枚組が1セット以上あること
• ツーペア
  • 同じ番号の2枚組が2セット以上あること
• ワンペア
  • 同じ番号の2枚組が1セット以上あること

こうして書き下してみると、いずれのハンドも以下の３パターンの条件で判定できる事がわかります。

• 連続する番号のカードが5枚揃っていること
• 同じスートのカードが5枚揃っていること
• 同じ番号のn枚組がmセット以上あること

まず、連続する番号のカードが5枚揃っている事を判定する関数straightHintと、 同じスートのカードが5枚揃っている事を判定する関数flushHintを考えてみましょう。

straightHint :: Hand -> Maybe Card
flushHint :: Hand -> Maybe Card

これらの関数は、もし条件を満たしていなかった場合はNothingを返し、 そうで無い場合は手札の最強のカードを返えすように作れば良さそうです。

そして、手札の中からペアや3つ組を探すためのnOfKindHint関数も作ります。

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

例えば、h :: Handという手札の中にペアがあるか無いか判定するためには、nOfKindHint 2 hのように呼び出すようにします。 返り値の型Maybe [[Card]]を見て、「おや？」と思われたかもしれませんので、少し説明しますね。

例えば手札が[D7_,C7_,C8_,HQ_,CQ_]だった場合に、Just [[D7_,C7_],[HQ_,CQ_]]という結果を返す事によって、 ペアの数(2つ)と、ペアを構成する最強のカード(クイーン)、どちらの情報も得られるようにするのがねらいです。
また、nつ組が見つからなかった場合、 Nothingを返すようにMaybeをつけていますが、単純に空リストを返しても良さそうに見えます。 それでもわざわざMaybe型を付けているのには、straightHintとflushHint関数と使い方を揃える意図があります。

実装していく

さて、ここまで掘り下げれば後はリスト操作です、いよいよ動くようにプログラミングしていきますよっと。

flushHintの実装

まずは一番簡単な所からいきましょう。
引数はHand型ですから、基本的にリストがソートされている事は保証されています。
(モジュール内で、うっかり変な方法でHand型を生成したりしていなければですが。)

よって、Hand型が内包するカードのリストから、最後の要素を取り出せば、それが最強の役になります。

flushHint :: Hand -> Maybe Card
flushHint (Hand h) = 
  if 〜判定処理〜 then Just (last h) else Nothing

あとは判定処理の部分が書ければこの関数は完成です。

フラッシュを判定するためには、全てのカードが同じスートである事が確認できれば良いわけですね。 リストの全ての要素が何らかの条件を満たす事はall関数を使う事で確認できます。

ghci> :t all
all :: (a -> Bool) -> [a] -> Bool
ghci> all (==1) [1,1,1]
True
ghci> all (==1) [1,2,1]
False

で、この条件の部分なんですが、 「hの等しいのスートと、引数のスートが等しい」を単純にラムダ式に書き起こすと次のようになります。

\x -> cardSuit (head h) == cardSuit x

なのですが、ラムダ式は変数の数が増えて余計な名付けが必要になってしまうとか、 開始と終了の位置がわかりづらいなどの理由で、この程度ならポイントフリースタイル （関数合成を駆使して引数の変数を取らなくても良いようにするスタイル） で書いてしまう事がしばしばあるのです。

上記のラムダ式を、ポイントフリースタイルに書き換えると、次のようになります。

(cardSuit (head h)==).cardSuit

まず、関数合成の両辺にあるcardSuit関数は、第一回で実装した、カードからスートを取り出す関数でしたね。

関数合成(.)の左側はセクション記法(\x -> x + 1を(+1)のように書く記法）を使って書いた、 「引数が手札hの先頭のスートと等しいかチェックする」関数になります。
右辺はcardSuit関数そのままですね。

結局これは、カードからスートを取り出し、手札の先頭のスートと等しいか比較する、 という関数になるのですが、なれるまでは読みづらいかもしれません。 しかし、関数合成は合成の右側から左に向かって、順に読んでいくことが出来るため、 慣れてさえいれば読みやすい場合が多いです。

このような記法に慣れていただくため、 本連載でもちょくちょくポイント・フリースタイルを交えていきましょう。

では、flushHint関数を完成させてしまいます。
先頭のカードは、パターンマッチで取り出すことができますし、 残りのカードから最後の１枚を取ってきても同じ事ですから、最終的な実装は次のようになるでしょう。

flushHint :: Hand -> Maybe Card
flushHint (Hand (x:xs)) = 
  if all ((cardSuit x==).cardSuit) xs then Just (last xs) else Nothing

nOfKindHintの実装

続いて、nOfKindHint関数を実装していきます。 この関数の返却値は、同じナンバーの組のリストでしたね。各組の数は最初の引数で決定するのでした。

この関数の返り値がNothingになるのは、作成したリストが空の場合ですから、次のような感じになるでしょう。

nOfKindHint :: Int -> Hand -> Maybe [[Card]]
nOfKindHint n (Hand h) = if cards /= [] then Just cards else Nothing
  where
    cards :: [[Card]]
    cards = 〜リスト作成処理〜

で、このリスト作成処理には、まず最初にData.ListモジュールのgroupBy関数を使います。 groupBy関数は、隣り合った要素の条件を元に、リストのグループ化を行います。

ghci> :t groupBy
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
ghci> groupBy (\x y -> odd x == odd y) [1,3,2,4,2,4,1,3,5,2,8]
[[1,3],[2,4,2,4],[1,3,5],[2,8]]

hがカードのリストであれば、次のようにして同じナンバーでグループ分けする事ができます。

groupBy (\x y -> cardNumber x == cardNumber y) h

あとは、各グループのlengthが、欲しい組の数のものをfilter関数で抽出すれば良いですね。
結果、nOfKindHint関数の実装は次のようになります。

nOfKindHint :: Int -> Hand -> Maybe [[Card]]
nOfKindHint n (Hand h) = if cards /= [] then Just cards else Nothing
  where
    cards :: [[Card]]
    cards = filter ((==n).length) 
      $ groupBy (\x y -> cardNumber x == cardNumber y) h

straightHintの実装

さて、続いてはstraightHint関数の実装に入っていくわけですが、 ストレートは少しだけ面倒くさい問題があります。

エースの番号は1ですが、キングに続く最強のカードでもありますから、 以下の２つの手札は両方ともストレートになるのです。

[S2_,D3_,H4_,H5_,DA_]
[D9_,D10,SJ_,CQ_,DK_]

そこで、実際に作る前に、少しだけ解説しておく事があります。

Maybe型とmplus関数

端的に言えば、エースを最弱のカードとして判定した場合と、 最強のカードとして判定した場合の「どちらか」の判定処理が成功していれば、そのハンドはストレートであると判断できます。

この「どちらかが成功した場合」を上手く扱える仕組みとして、 Control.Monadモジュールに、mplusという関数が用意されています。
Monadという名前を見て腰が引けてしまうかもしれませんが、とても簡単なので安心してください。

GHCiで調べてみましょう。

ghci> :t mplus
mplus :: MonadPlus m => m a -> m a -> m a
ghci> :i MonadPlus
class Monad m => MonadPlus m where
  mzero :: m a
  mplus :: m a -> m a -> m a
    -- Defined in `Control.Monad'
instance MonadPlus [] -- Defined in `Control.Monad'
instance MonadPlus Maybe -- Defined in `Control.Monad'

MonadPlusというなにやらおっかない型クラスが出てきましたが、 重要なのは、Maybe型がMonadPlusのインスタンスになっているという情報です。 mplus関数の型のmをMaybe型に置き換えれば、動かし方はすぐにわかると思います。

mplus :: Maybe a -> Maybe a -> Maybe a

この関数は、以下のように中置記法を使って書くとわかりやすいです。

ghci> Just 1 `mplus` Nothing
Just 1
ghci> Nothing `mplus` Just 1
Just 1
ghci> Just 1 `mplus` Just 2
Just 1
ghci> Nothing `mplus` Nothing
Nothing

mplus関数は、左辺／右辺の片方がJustで片方がNothingだった場合、Justの方を返し、 また両方がNothingだった場合は結果がNothingに、両方がJustだった場合は左辺の値を返します。

つまり左辺／右辺の「どちらか」の値がJustであれば、最終的な結果はJustになるわけです。

---

ちなみに、イマドキのGHCであれば、mplusをMaybe型に限定したfirstJustという関数が用意されているようですが、 手元のGHCのバージョンが少し古いので、mplus関数を利用し、firstJust関数は紹介だけさせていただきます(´・ω・`)

http://haddocks.fpcomplete.com/fp/7.8/20140916-162/ghc/Maybes.html#v:firstJust

firstJust :: Maybe a -> Maybe a -> Maybe a
firstJust (Just a) _ = Just a
firstJust Nothing  b = b

ストレートを判定する

でもって、ストレートの判定をしていくわけですが、flushHintやnOfKindHintの場合と違って、 エースに２通りの解釈が考えられるため、単純にCard型同士の大小比較で判定する事はできません。

カードの番号はInt型ですので、まずInt型が連番で並んでいるか判定する関数を作ってみましょう。

isStraight :: [Int] -> Bool
isStraight xs@(x:_) = xs == [x .. x + 4]
isStraight _ = False

カードのリストから、番号のリストを生成するのは簡単です。

cards :: [Card]

として

map cardNumber cards :: [Int]

しかし、[Int]という型が渡されたとして、ストレートか否かを判断する事が出来たとしても、最強のカードを抽出する事は出来ません。 そこで両方の情報を持った、[(Int, Card)]という型を取るようにしましょう。それにより、次のようにしてストレートか否かの判定をした上で、最強のカードを返却する事が出来ます。

judgeStraight :: [(Int, Card)] -> Maybe Card
judgeStraight = 
  if isStraight $ map fst l
    then Just . snd . last $ l
    else Nothing

この関数は、引数がソートされている前提で、タプルの第一要素が連番になっている事をisStraight関数で判定し、 もし連番になっているようなら、最後の要素の第二要素を最強カードと判断して返却します。

あとは[Card]という型を持つリストから、[(Int, Card)]というリストを作れれば良いわけです。 エースを1と解釈するパターンと、キングの次のカードと解釈するパターンをそれぞれ用意すれば、 mplus関数を使って「どちらかを満たせばストレート」という感じで判定する事ができそうですね。

cardNumber関数を使えば、エースを1と解釈したパターンの関数はすぐに作る事ができます。

extractCardNumber :: [Card] -> [(Int, Card)]
extractCardNumber f cs = map (\c -> (cardNumber c, c)) cs

エースをキングの次のスーツと解釈するパターンの場合、 Card型の内部でエースは14 :: Intとして扱われている事を考えると、 Cards.hsモジュール内に、次のcardStrength関数を追加して利用するのが効率良さそうです。

cardStrength :: Card -> Int
cardStrength (Card n _) = n

このcardStrength関数を使って[(Int, Card)]を作成する関数は、extractCardNumber関数と同じように実装する事ができますが・・・

extractCardStrength :: [Card] -> [(Int, Card)]
extractCardStrength f cs = map (\c -> (cardStrength c, c)) cs

こうして見ると、２つの関数はほとんど同じ実装ですね。
タプルの第一要素に適用する関数が、cardNumber関数かcardStrength関数の違いだけですから、 以下のように高階関数にくくりだしてしまえば、わざわざ似たような関数を２つも作らなくてすみそうです。

extract :: (Card -> Int) -> [Card] -> [(Int, Card)]
extract f cs = map (\c -> (f c, c)) cs

っていうか、ぶっちゃけCard型とInt型に限定する必要も無いです。

extract :: (b -> a) -> [b] -> [(a, b)]
extract f cs = map (\c -> (f c, c)) cs

慣れてくれば、このくらいなら順を追わなくても、すぐにextractのような高階関数をが必要だという事に気づけるようになります。 Hackageではextract関数に相当する関数が見つけられなかったため今回はわざわざ作りましたが、Hoogle検索すればけっこうお目当ての関数が見つかったりするので、このような細々とした道具の扱いには慣れておいたほうが良いでしょう。

これで、２通りの方法で[(Int, Card)]型の値を作れるようになりましたので、後はそれぞれjudgeStraight関数に適用します。「どちらか」が成功すればその手札はストレートという事になりますので、mplus関数で繋げてやればOKです。

straightHint :: Hand -> Maybe Card
straightHint (Hand l) = 
  (judgeStraight . extract cardStrength $ l)
  `mplus`
  (judgeStraight . sort . extract cardNumber $ l)

尚、エースを1として扱うパターンでは、 エースが先頭に来るようにソートし直す必要がある事に注意してください。

最後に、isStraight関数やjudgeStraight関数はどうせストレートの判定にしか使わないので、 スコープを汚さないようにstraightHint関数の中にwhere句で組み込んでしまいましょう。

straightHint :: Hand -> Maybe Card
straightHint (Hand l) = 
  (judgeStraight . extract cardStrength $ l)
  `mplus`
  (judgeStraight . sort . extract cardNumber $ l)
    where
      isStraight :: [Int] -> Bool
      isStraight xs@(x:_) = xs == [x .. x + 4]
      isStraight _ = False
      
      judgeStraight :: [(Int, Card)] -> Maybe Card
      judgeStraight l = 
        if isStraight $ map fst l
          then Just . snd . last $ l
          else Nothing

まとめ

と、思ったより長丁場になってしまったので、一旦ここで区切ろうと思います。
今回は、よくあるHaskellの演習問題の実践みたいな感じになりましたねｗ

とにもかくにも、これで役を判定するための最小の道具立てはひと通り揃ったので、 あとはこれらを組み合わせて、各ポーカー・ハンドの判定関数、 そして最終的にポーカー・ハンドを判定する関数を作成すればOKです。

次回、判定プログラムを書き上げて、実際に動作確認を行う事にしましょう。

それではノシノシ

←前 次→