Haskellでポーカーを作ろう〜第五回カードの入れ替え処理を作る〜

はいはい、どうも、お風呂大好きちゅーんさんです。
お風呂あがりの乳酸菌とかたまりませんね。最近はアセロラジュースとか飲んでます。

はい

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

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

前回からの修正点

フルハウスの判定処理なんですが、改めて調べると、「３枚組の最強カード」「２枚組の最強カード」の順に比較しなくてはいけないらしいですね。

前回は２枚組か３枚組の両方から一番強いカードを選択していましたが、これじゃまずいです。

同じ強さのカードは４枚しか無いため、ドローポーカーの場合は３枚組で引き分けるという事はありえないので、最強カードとしては３枚組の１枚を選択すれば良いですから、判定処理は次のように書き換えればOKでしょう。

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

なお、テキサス・ホールデムのようなフロップポーカーの場合は、共通のカードで役を作るので、２枚組のカードでの判定が必要になるかもしれませんから、もう少し工夫が必要です。

今回は何をやろう

さて、前回ポーカーの判定処理を作りました。

次は何処を作っていこうかなぁという話なのですが、確実に必要だとわかっていて、手をつけやすく、手っ取り早く動かせる所が良いですねー。

というわけで、今回はカードの交換処理を作っていきましょう。

関数の型を考える

全体の構成がどうなっていくのか、現段階ではわからないので、ひとまずMain.hsに書いて行き、ある程度見えてきたらモジュールに分割する方針でいきます。

手札を入れ替える処理を純粋な関数にすると、「捨てるカードのリスト」「山札」「手札」を取って、「手札と残りの山札の組」を返すような感じになりますかね。山札も手札も、基本的には「カードのリスト」で良いはずですから、手札を交換するdrawHand関数は、次のような型になりますね。返り値がMaybe型になるのは、山札が足りないなどの理由で新たな山札を構成する事ができない可能性があるためです。

drawHand :: [Card] -> [Card] -> Hand -> Maybe (Hand, [Card])

と言っても、これだけだといくつかある[Card]型が何を表しているかイマイチわかりづらいですね。

そこで、typeを使って[Card]に手札、捨て札のリストを表す別名をつけましょう。以下のようにするだけで、drawHand関数の型はずいぶん読みやすくなります。

type DiscardList = [Card] -- 捨て札
type Deck = [Card]        -- 山札

drawHand :: Deck -> DiscardList -> Hand -> Maybe (Hand, Deck)

この程度の問題であれば、僕の感覚だと別名を付けるだけでも十分だろうと判断するのですが、後々ややこしくなってきたら型安全にするためにnewtypeに書き換えるかもしれません。

なお、そもそも新たに型を定義したり型の別名をつけたりする事は、コードを読む人やライブラリの利用者に、その型の理解を要求している事に注意してください。なまじHaskellは型を作るコストが小さいので、多用しすぎてわかりづらくなってしまう事もあるため、ケース・バイ・ケースで適切に設計する必要があります。

この辺の基準というか、バランス感はプログラマによっても差があるため、「こういう時はこうする」という明確な基準はありません。ですが、typeもnewtypeもうまく使えば、Haskellプログラミングをわかりやすく、安全にする事ができる仕組みですので、色々と試しながら感覚を掴んでいくのが良いと思います。

さて、山札を表すDeckという型を作りましたから、山札から手札を取り出す関数も欲しいですね。

getHand :: Deck -> Maybe (Hand, Deck)

ゲームとして使うには、捨て札を入力するためのIO処理も必要になりそうです。 CUI用のゲームとして開発する予定ですので、無駄になる事もなさそうですし、一緒に作ってしまいましょう。

返り値がMaybeになっているのは当然、範囲外の手札等が入力が失敗する可能性があるという事なのですが、それはまた、実装する時に詳しく説明します。

getDiscardList :: Hand -> IO (Maybe DiscardList)

というわけで、今回作成する関数は、以下の３つになります。

drawHand :: Deck -> DiscardList -> Hand -> Maybe (Hand, Deck)
getHand :: Deck -> Maybe (Hand, Deck)
getDiscardList :: Hand -> IO (Maybe DiscardList)

こうして型を並べると、getHand関数で手札を取得し、getDiscardListで捨て札を選択、 drawHand関数で手札を交換するという一連の流れに必要なものが揃うのがわかると思います。

各関数の実装

では、どんどん実装していきましょう。

`getHand`関数の実装

まず、デッキから手札を取る関数はMaybeモナドを使えば簡単ですね。
take関数で5枚抜いてtoHand関数で手札にします。

さらに、drop関数で5枚の手札を捨てて、デッキの残りを一緒に返せばOKです。

getHand :: Deck -> Maybe (Hand, Deck)
getHand deck = do
  hand <- toHand . take 5 $ deck
  return (hand, drop 5 deck)

`drawHand`関数の実装

続いて、手札を交換する関数の実装です。

返り値のタプルの左側は新しい手札になるわけですが、これは次のように、filter関数で残すカードのみ選択し、山札を後ろに結合した後に、 take関数とtoHand関数を使う事で得る事ができそうです。

toHand . take 5 $ filter (捨て札に含まれているか判定) 手札 ++ 山札

で、続いてタプルの右側は新たなデッキになるのですが、これは次のような感じになりますね。

drop (5 - length 手札を捨てた残り) 山札

手札を捨てた残りの部分は、タプルの左側の次の部分で得られます。

手札を捨てた残り = filter (捨て札に含まれているか判定) 手札

というわけで、drawHand関数の全体はこんな感じになるでしょう。
let ... inの後にdoが来ているので混乱するかもしれませんが、返り値がMaybe型なので、たんなるMaybeモナドです。

drawHand :: Deck -> DiscardList -> Hand -> Maybe (Hand, Deck)
drawHand deck dis h = let
  nl = 手札を捨てた残り
  nr = drop (5 - length nl) deck
  in do
    hand <- toHand . take 5 $ nl ++ deck
    ndeck <- return nr
    return (hand, ndeck)

手札を捨てた残りの部分の実装について考えます。

手札の各札が捨て札のリストに入っていない事を確認すれば良いのですね。そのためには「リストに入っている事、いない事」を確認するための、elem関数と、notElem関数を使いましょう。

-- リストに第一引数の値が入っている事を確認する関数(入っていたらTrue)
elem :: Eq a => a -> [a] -> Bool
-- リストに第一引数の値が入っていない事を確認する関数(入っていなかったらTrue)
notElem :: Eq a => a -> [a] -> Bool

これを使えば、手札を捨てた残りの部分は、次のようにして実装できます。 flip関数を使って引数の順番を入れ替える事で、filterに渡す関数をラムダ式を使わずに実装できますね。

filter (flip notElem 捨て札) 手札

で、これを先ほどの実装に組み込めば、次のような感じになるでしょう。

drawHand :: Deck -> DiscardList -> Hand -> Maybe (Hand, Deck)
drawHand deck dis h = let
  nl = filter (flip notElem dis) (fromHand h)
  nr = drop (5 - length nl) deck
  in do
    ...

とりあえず、これでdrawHand関数は完成なのですが、 Maybeモナドを使っている部分について、(<-)によって得る事が出来たhandとndeckを順にタプルに当てはめているだけなのに気づいたでしょうか。 (,) :: a -> b -> (a, b)となるため、この部分は(,) hand ndeckと書いても同じ事になります。

このような場合、Applicativeを使う事によってMaybeモナドのdo構文の部分がもう少しシンプルにする事が可能です。

Control.Applicativeモジュールをインポートすると、次の２つの演算子を使う事ができるようになります。

(<$>) :: Functor f => (a -> b) -> f a -> f b
(<*>) :: Applicative f => f (a -> b) -> f a -> f b

<$>演算子は、fmapの中置記法版である事に注意しましょう。 Maybe型はFunctorでありApplicativeなので、これらの演算子は以下のようにして読み替える事ができます。 (GHCiで確認してみてください)

(<$>) :: (a -> b) -> Maybe a -> Maybe b
(<*>) :: Maybe (a -> b) -> Maybe a -> Maybe b

f :: A -> B -> C、x :: Maybe A、y :: Maybe Bとした時、xとyをfに適用する方法を考えましょう。
まず、fmapを使ってfにxを適用すると、次のようにMaybe型に内包された関数が出来てしまい・・・

fmap f x :: Maybe (B -> C)

Functorの機能だけではfの第二引数にyを適用する事ができなくなってしまいます。

Applicativeであれば、この型は<*>演算子の第一引数に当てはめる事ができますので、次のようにして、Maybe型に内包されてしまった関数に対して、さらに別のMaybe型の値を適用する事ができるわけです。

fmap f x <*> y :: Maybe C

さて、<$>演算子はfmapの中置記法でしたね。これらを組み合わせて、以下のように二つ以上引数を取る関数fに左から何かしらのApplicative（今回の場合はMaybe`)の値を、適用していく事が出来るのです。

f <$> x <*> y :: Maybe C

というわけで、基本的にApplicativeは２引数以上の関数にMaybe等の多相型を適用したい場合に使うことができるわけです。

この事を利用して、drawHand関数のMaybeモナドだった部分は、次のように書きかえる事が出来ます。

drawHand :: Deck -> DiscardList -> Hand -> Maybe (Hand, Deck)
drawHand deck dis h = let
  nl = filter (flip notElem dis) (fromHand h)
  nr = drop (5 - length nl) deck
  in (,) <$> toHand (take 5 $ nl ++ deck) <*> Just nr

`getDiscardList`関数の実装

最後にgetDiscardList関数を実装しましょう。

getDiscardList :: Hand -> IO (Maybe DiscardList)

この関数は、ユーザーから入力を受けて、捨て札のリストを作成するのでした。
例えば、ユーザーが235と入力した場合、引数の手札の２枚めと３枚めと５枚めのカードを捨て札として返します。

この実装のややこしいのは、ユーザーからの入力は文字列になるので、これを数値のリストにパースする処理が必要になるため、まず最初に文字列を数値のリストに変換する必要がある所ですね。

toIntList :: String -> [Int]

"1234"を["1", "2", "3", "5"]に変換することが出来れば、あとはread関数をmapする事で、ひとけたの数値のリストを得る事ができるはずです。

String型は、[Char]の別名ですから、Char型の各要素をリストにする事が出来れば良いわけですね。
(:) :: a -> [a] -> [a] な事を利用すれば、セクション記法を使って(:[]) :: a -> [a] とする事が出来ますから、 toIntList関数は次のように実装する事ができます。

toIntList :: String -> [Int]
toIntList = map $ read . (:[])

例えばリストからn番目の要素を取り出すには(!!)演算子を使えば良いので、以下のようにすれば、リストのインデックスを並べて各要素を取り出す事ができますね。

ghci> map ("abcdef"!!) [0, 1, 3, 4]
"abde"

実際には、添字は1から選択したいので、subtract関数で各インデックスを1引く必要がありますね。
というわけで、リストと添字のリストからリストを選択する関数を次のように実装する事にしました。

selectByIndexes :: [a] -> [Int] -> [a]
selectByIndexes l = map ((l!!).(subtract 1))

で、selectByIndexes関数とtoIntList関数、これらを組み合わせて、getDiscardListを実装すると次のような感じになります。

getDiscardList :: Hand -> IO (Maybe DiscardList)
getDiscardList h = do
    input <- getLine
    return . Just . selectByIndexes (fromHand h) $ toIntList input

で、軽く動作確認・・・っと。

ghci> deck <- shuffleM allCards 
ghci> let Just (hand, _) = getHand deck
ghci> hand
Hand {fromHand = [D2_,C4_,C9_,C10,CJ_]}
ghci> getDiscardList hand
125
Just [D2_,C4_,CJ_]
ghci> getDiscardList hand
1145
Just [C3_,C3_,SJ_,SQ_]

同じカードが重複して取り出されてしまう問題は、Listモジュールのnub関数を使う事によって解決する事ができますが、捨て札として同じリストを何度も指定された所で、二回目以降は無視すれば良いだけなので、そのままでも問題ないです。

なんかこれでいけそうな気がしますねー。でもコレじゃダメなんですよー、はい。

*Main> deck <- shuffleM allCards 
*Main> let Just (hand, _) = getHand deck
*Main> getDiscardList hand
hoge
Just [*** Exception: Prelude.read: no parse
*Main> getDiscardList hand
129
Just [S2_,C5_,*** Exception: Prelude.(!!): index too large

read関数と(!!)演算子は想定外の入力を受けると例外を返します。

HaskellにはEitherやMaybe等、計算が失敗した場合に例外に頼らずに対処する方法があるため、例外を発生させなくてはいけないシチュエーションというのが無いはずなのですが、困ったことに、標準ライブラリには例外を発生させる関数や演算子がけっこう色々あります。

数値にパースできない入力や、カードの枚数を超えた数値を入力するなど、ユーザーにより不正な入力を受ける事によって例外が発生する可能性があったため、getDiscardListの返り値をMaybe型にしていたのです。
まず、toIntList関数、selectByIndexes関数をそれぞれMaybe型を返すようにしましょう。

toIntList :: String -> Maybe [Int]
selectByIndexes :: [a] -> [Int] -> Maybe [a]

toIntList関数ですが、(!!)演算子のMaybe版として、 atMayという関数がsafeというパッケージのSafeモジュールにありますので、 cabalを使ってインストールしてこれを使う事にしましょう。（こんくらいなら作っちゃっても良いとは思いますが。）

atMay :: [a] -> Int -> Maybe a

で、もともとのselectByIndexes関数の実装から、(!!)演算子の部分を差し替えると、 map ((atMay l).(subtract 1)) :: [Maybe a]となるのですが、このMaybe型をリストの外に出す事はできないでしょうか？

このような場合、sequence関数を使います。

sequence :: Monad m => [m a] -> m [a]

もうMonad型クラスが出てきても驚かなくなった頃でしょうか。
MaybeはMonad型クラスのインスタンスですから、mにMaybeを当てはめればすぐに何をする関数かわかるでしょう。

mにはMonad型クラスのインスタンスであれば、リストだろうがIOだろうが、何でも使う事ができるのですが、 Maybe型の場合は全ての要素がJustの場合のみ、Justを返します。

このsequence関数を使えば、selectByIndexes関数の実装は次のようにできますね。

selectByIndexes :: [a] -> [Int] -> Maybe [a]
selectByIndexes l = sequence . map ((atMay l).(subtract 1))

続いて、toIntList関数のほうですが、こっちはもう少し簡単です。

toIntList :: String -> Maybe [Int]
toIntList str = if and $ map isDigit str then Just $ reads str else Nothing
  where
    reads :: String -> [Int]
    reads = map $ read . (:[])

isDigit :: Char -> Bool関数はData.Charモジュールをimportする事で使う事ができます。
この関数は、引数の文字が 0 ~ 9 の場合にTrueを返しますので、文字列にmapする事で、全要素が数値である事を確認できます。

そして、and :: [Bool] -> Bool関数はリストの全要素がTrueの場合にTrueを返します。

よって、toIntList関数の引数の文字列をisDigit関数をmapして、結果として得られたBool型のリストをandに適用すれば、文字列の全ての文字が数値か否か判定する事ができますので、Trueだった場合には全文字をInt型にreadする事が出来るというわけです。

最後に、出来上がったtoIntList関数と、selectByIndexes関数を組み合わせて、 getDiscardList関数を組み直しましょう。

getDiscardList :: Hand -> IO (Maybe DiscardList)
getDiscardList h = do
    input <- getLine
    return $ do
      intList <- toIntList input
      res <- selectByIndexes (fromHand h) intList
      return res

return関数の直後にdo構文が続く不思議なコードに見えますが焦らないでください。 getDiscardList関数の返却値はIO (Maybe DiscardList)なので、このdo構文の中身はMaybeモナドですから、 toIntList関数と、selectByIndexes関数の結果両方ともJustの場合のみ結果を返すようになっているだけです。

動作確認 -> プロトタイプ実装

さて、今回作ったgetHand関数、getDiscardList関数、drawHand関数と、前回までで作ったpokerHand関数を組み合わせる事によって、

山札から手札を取り出す→捨て札を選択→新しい手札を取得→手札を判定

という、ドローポーカーの一連の流れを実現できるようになりました。

ghci> deck <- shuffleM allCards 
ghci> let Just (hand, newDeck) = getHand deck
ghci> hand
Hand {fromHand = [D2_,C5_,S5_,H8_,D9_]}
ghci> Just discards <- getDiscardList hand
145
ghci> discards 
[D2_,H8_,D9_]
ghci> let Just (newHand, _) = drawHand newDeck discards hand
ghci> newHand
Hand {fromHand = [H2_,C2_,C5_,S5_,D8_]}
ghci> pokerHand newHand 
(TwoPair,S5_)

まだまだ、対戦してチップを賭けあうポーカーにするには作らなくてはいけないものが沢山ありますが、モチベーション的に「動く」というのは大事ですし、後々使えるパーツが出てくるかもしれないので、ひとまずプロトタイプを作ってみましょう。

ちょっと長いですが、動かすためのプログラムをだだーっと紹介しますが、自信のある人は自分で作ってみましょう。

main :: IO ()
main = do
  putStrLn "------------------"
  putStrLn "-- simple poker --"
  putStrLn "------------------"
  deck <- shuffleM allCards
  case getHand deck of
    Nothing -> error "予期せぬエラー"
    Just (hand, deck) -> playPoker hand deck
  ynQuestion "-- もっかいやる？" main (putStrLn "-- またねノシノシ")
  
playPoker :: Hand -> Deck -> IO ()
playPoker hand deck = do
  discards <- inputDisuse hand
  case drawHand deck discards hand of
    Nothing -> error "予期せぬエラー"
    Just (nhand, _) -> do
      printHand [] nhand
      printResult $ pokerHand nhand

inputDisuse :: Hand -> IO DiscardList
inputDisuse hand = do
  printHand [] hand 
  putStrLn "-- 捨てるカードを選んでね"
  gotDisuse <- getDiscardList hand
  case gotDisuse of
    Nothing -> do
      putStrLn "-- 1~5の数値を並べて入力してね"
      inputDisuse hand
    Just disuses -> do
      printHand disuses hand 
      ynQuestion "-- これでいい？" (return disuses) (inputDisuse hand)

----
          
printResult :: (PokerHand, Card) -> IO ()
printResult (ph, card) = putStrLn $ concat 
  ["***** あなたの手札は ", show ph, " で、最強カードは ", show card, " でした*****"]

printHand :: DiscardList -> Hand -> IO ()
printHand dis hand = putStrLn $ "-- 手札 : " ++ showChangeHand dis hand

ynQuestion :: String -> IO a -> IO a -> IO a
ynQuestion s yes no = do
  putStrLn $ s ++ "(y/n)"
  input <- getLine
  case input of 
    "y" -> yes
    "n" -> no
    _ -> do
      putStrLn "-- `y`か`n`で入力してね"
      ynQuestion s yes no

showChangeHand :: DiscardList -> Hand -> String
showChangeHand dis h = let
  judge x = if elem x dis then " " ++ show x ++ " " else "[" ++ show x ++ "]"
  in concat $ map judge (fromHand h)

ちょっと長めなので大変かもしれませんが、普通にIOモナドで手続きプログラミングしているだけなので、今までの知識と手続き言語のノウハウで読むことができるはずです。

また、プレイヤーの操作によっては入り得ない分岐は、error関数で例外を飛ばしていますが、これは「呼び出されるとしたらこのモジュールのプログラムミスが原因である」という場合だからであり、外部に公開するライブラリや、ユーザーの操作ミスによって例外を返すようなプログラムにすべきではありません。

そのような場合は、Maybe型やEither型を返すようにしたり、適切なメッセージを表示させて、ユーザーにアナウンスするようにすべきでしょう。

とにかく、このプログラムを実行してみます。

------------------
-- simple poker --
------------------
-- 手札 : [C4_][H5_][S5_][S7_][S8_]
-- 捨てるカードを選んでね
145
-- 手札 :  C4_ [H5_][S5_] S7_  S8_ 
-- これでいい？(y/n)
y
-- 手札 : [S3_][H5_][S5_][C8_][SJ_]
***** あなたの手札は OnePair で、最強カードは S5_ でした*****
-- もっかいやる？(y/n)
y
------------------
-- simple poker --
------------------
-- 手札 : [D2_][C5_][H10][S10][CK_]
-- 捨てるカードを選んでね
125
-- 手札 :  D2_  C5_ [H10][S10] CK_ 
-- これでいい？(y/n)
y
-- 手札 : [S3_][D6_][H10][S10][HK_]
***** あなたの手札は OnePair で、最強カードは S10 でした*****
-- もっかいやる？(y/n)
y
------------------
-- simple poker --
------------------
-- 手札 : [C4_][S6_][C8_][C10][SJ_]
-- 捨てるカードを選んでね
12345
-- 手札 :  C4_  S6_  C8_  C10  SJ_ 
-- これでいい？(y/n)
y
-- 手札 : [D5_][C5_][H10][S10][HJ_]
***** あなたの手札は TwoPair で、最強カードは S10 でした*****
-- もっかいやる？(y/n)
n
-- またねノシノシ

なんかゲームっぽくなってきました。
うーん、それにしてもなかなか良いハンドが出来ないものですねｗ

まとめ

というわけで、今回はカードの交換フェーズを作成し、これまで作った道具を組み合わせたプロトタイプを実装しました。

今回から多少説明の粒度を荒くしたので、難易度が少し上がったかもしれませんが、ちゃんとついてこれたでしょうか？前回までの記事の内容がちゃんと頭に入っていれば、丁寧に型を追うことで理解できるはずです。

次回は交換するカードを自動で選別するAIの機能を作りましょう。
この辺はだいたいパターンなので、ゲーム性はあんまりありませんが、プロトタイプに簡単な対戦機能が追加できると良いですね。

←前　次→

Creatable a => a -> IO b

Haskellと数学とちょびっと音楽

Haskellでポーカーを作ろう〜第五回カードの入れ替え処理を作る〜

前回からの修正点

今回は何をやろう

関数の型を考える

各関数の実装

`getHand`関数の実装

`drawHand`関数の実装

`getDiscardList`関数の実装

動作確認 -> プロトタイプ実装

まとめ

前回からの修正点

今回は何をやろう

関数の型を考える

各関数の実装

getHand関数の実装

drawHand関数の実装

getDiscardList関数の実装

動作確認 -> プロトタイプ実装

まとめ

`getHand`関数の実装

`drawHand`関数の実装

`getDiscardList`関数の実装