読者です 読者をやめる 読者になる 読者になる

Creatable a => a -> IO b

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

Haskellでポーカーを作ろう〜第七回 プロジェクトを整理するよっ〜

外はすっかり真夏日よりですが、今日も冷房の前ででプログラミング充しています。 嘘です、ずっとスプラトゥーンやってました。
結果として相変わらずGithubのContributionsは真っ白です。 どもども、ちゅーんさんです。

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

第一回 リストのシャッフルとカードの定義
第二回 ポーカー・ハンドの判定をする 前編
第三回 ポーカー・ハンドの判定をする 中編
第四回 ポーカー・ハンドの判定をする 後編
第五回 カードの入れ替え処理を作る
第六回 CPU対戦機能を付けよう

前回までは、やや場当たり的に作って行きましたが、 そろそろ程度整理しないと全体像が掴みにくい規模になってきたようです。

そこで今回は、Haskellのビルドツールについて簡単に紹介/説明し、 ここまで書いたプログラムをプロジェクトとして管理できるように移行します。

その後、前回までに作成した関数を洗い出して、モジュール構成を整理しましょう。

前準備とか

まず、前回までの内容を手順通りに勧めていれば、以下の3ファイルが出来ているはずです。

  • Main.hs
  • Cards.hs
  • Hands.hs

Main.hsPoker.hsに書き換えて、main関数の名前をsimpleGame関数に変更してください。 そして、Poker.hsのモジュール宣言部を次のように書き換えます。

module Game.Poker
    ( module Game.Poker.Hands
    , module Game.Poker.Cards
    , simpleGame
    ) where

...

その上で、新しくMain.hsを作りなおしましょう。

module Main where
import Game.Poker

main :: IO ()
main = simpleGame

これらのファイルを以下のように配置します。

.
├── app
│   └── Main.hs
└── src
    └── Game
        ├── Poker
        │   ├── Cards.hs
        │   └── Hands.hs
        └── Poker.hs

srcディレクトリ以下に基本的なプログラムは書くようにし、 appディレクトリは、アプリケーション本体のソースコードを配置する事にしましょう。

こうする事によって、例えば「GUI版を作りたい」といった時に、このプロジェクトをインストールし、 Game.Pokerモジュールを読み込む事によって、ポーカーゲームを実装するための全ての関数を再利用する事ができます。
開発者はUIだけ作れば良くなるというわけですね。

ディレクトリの構成に合わせて、各モジュールのモジュール名を変えます。

  • Cards.hs -> Game.Poker.Cards
  • Hands.hs -> Game.Poker.Hands

併せて、各ファイルのimport文も書き換えましょう。

ビルドのための設定を行う

これまで紹介したcabalの使い方といえば、cabalコマンドを使ってパッケージをインストールするだけでしたが、 cabalにはプロジェクトをビルドして、パッケージや実行ファイルをインストールしたりするビルドツールとしての機能もあります。

cabal自体はかなり優秀なツールなのですが、依存関係が壊れやすいという少々ややこしい問題を抱えており、 Haskellで巨大なライブラリを使ったり、色々なライブラリを一緒に使おうとした時に問題が発生する事が多く、 長らく問題になっていまして、それがほんの数カ月ほど前にリリースされたstackというビルドツールによって解決される事になりそうな状況なのです。

基本的にstackの方を推奨したいのですが、 stackはまだ開発中のツールですし、cabalの上で動作するものでもあるので、今回は両方の使い方を説明しようと思います。

いちおう、どちらかが使えれば良いという方に向けて、それぞれ独立して読んでも使えるように説明します。

  • ちゃんと理解したい人 -> 「cabalの使い方」「stackの使い方」両方読む
  • 使えれば良い人 -> stackの使い方を読む
  • 枯れていない技術は信用できない人 -> cabalの使い方を読む

cabalの使い方

というわけで、ビルドツールとしてcabalを使う方法を簡単にご説明しましょう。

cabalを使ったパッケージ管理を行うためには、*.cabalという拡張子の設定ファイルを作成する必要があります。
cabal initというコマンドを実行する事によって、対話形式によって入力された内容や現在のディレクトリの状態等といった 情報を元に、ある程度の項目が埋められた状態のcabalファイルを簡単に生成する事ができます。

$ cabal init
Package name? [default: draw-poker] 
Package version? [default: 0.1.0.0] 
Please choose a license:
 * 1) (none)
   2) GPL-2
   3) GPL-3
   4) LGPL-2.1
   5) LGPL-3
   6) AGPL-3
   7) BSD2
   8) BSD3   9) MIT
  10) ISC
  11) MPL-2.0
  12) Apache-2.0
  13) PublicDomain
  14) AllRightsReserved
  15) Other (specify)
Your choice? [default: (none)] 8

...

残念ながら、このコマンドによってすぐにビルド出来る状態にはなりません。 いくつか追加設定が必要な項目があるのですが、今回は以下のようにcabalファイルを設定します。

-- Initial draw-poker.cabal generated by cabal init.  For further 
-- documentation, see http://haskell.org/cabal/users-guide/

name:                draw-poker
version:             0.1.0.0
synopsis:            playing draw poker
description:         for blog entry
homepage:            http://tune.hateblo.jp/entry/2015/05/12/023112
license:             BSD3
license-file:        LICENSE
author:              Tokiwo Ousaka
maintainer:          its.out.of.tune@gmail.com
-- copyright:           
category:            Game
build-type:          Simple
-- extra-source-files:  
cabal-version:       >=1.10

library
  hs-source-dirs:      src
  exposed-modules:     Game.Poker
                     , Game.Poker.Hands
                     , Game.Poker.Cards
  build-depends:       base >= 4.6 && < 4.7
                     , random-shuffle >=0.0&& <0.1
                     , safe >=0.3 && <0.4
  default-language:    Haskell2010

executable draw-poker
  main-is:             Main.hs
  -- other-modules:       
  -- other-extensions:    
  build-depends:       base >=4.6 && <4.7, draw-poker
  hs-source-dirs:      app
  default-language:    Haskell2010

source-repository head
  type:     git
  location: https://github.com/tokiwoousaka/draw-poker

変更箇所については以下のdiffをご覧ください。

https://gist.github.com/tokiwoousaka/37c93cd7a067dbac1483/revisions

各項目について詳しい説明は行いません、 得に設定する事の多い、以下の二点のみ、認識しておいてください。

  • モジュールが増えた場合はexposed-modulesに項目の追加が必要
  • 依存するパッケージが増えた場合、build-dependsに項目の追加が必要

それ以外で今後修正が必要な場合は都度説明します。

ポイントとしては、

  • descriptionの項目を設定した
  • libraryおよびexecutable両方の項目
  • executableのソースファイルがapp/Main.hsを指定しているようになっている必要がある
  • 外部ライブラリへの依存しているのはexecutableではなくlibrary
  • executabledraw-pokerパッケージそのものに依存している旨記載が必要
  • source-repositoryの設定は任意(しなくても良い)

といったところでしょうか。
その他、以下の基本的な機能についてはざっくりと覚えておきましょう。

  • 動作確認
    • cabal replコマンド:libraryをGHCiで読み込みます
    • cabal run app/Main.hsコマンド:app/Main.hsを実行します
  • インストール
    • cabal installコマンド:ライブラリおよび実行ファイルのインストール
      • 初回はその前にcabal configureを実行する必要があります
      • cabalファイルのlibraryで設定されている情報を元にライブラリをインストール
      • cabalファイルのexecutableで設定されている
  • ドキュメント作成
    • cabal haddockコマンド:dis/dock/html配下にドキュメントを作成します
      • ビルド通ったら一度は確認しときましょう。とても便利です。

なお、全体的な説明については、以下の記事を参考にすると良いでしょう。

http://itpro.nikkeibp.co.jp/article/COLUMN/20121106/435201/?ST=develop&P=2

stackの使い方

この節では、stackの使い方を説明します。

stackのインストールは、以下のREADMEの、How to Install を参照してください。 (今の所、全環境へのインストール方法の日本語訳はされていないのです・・・。)

https://github.com/commercialhaskell/stack

stack newコマンドを利用する事により、新規プロジェクトを作成する事ができます。

既存のソースがある場所では実行する事ができませんので、 空のフォルダでstack newコマンドを利用し、プロジェクトを作成したら、 予め作っておいたソースコードをコピーして来てください。

生成されたファイルと、コピーしたファイルを含めて、以下のようなディレクトリ構成になっていればOKです。

.
├── app
│   └── Main.hs
├── LICENSE
├── new-template.cabal
├── Setup.hs
├── src
│   └── Game
│       ├── Poker
│       │   ├── Cards.hs
│       │   └── Hands.hs
│       └── Poker.hs
├── stack.yaml
└── test
    └── Spec.hs

そして、cabalファイルをdraw-poker.cabalにリネームし、以下を参考にして、内容を書き換えます。

name:                draw-poker
version:             0.1.0.0
synopsis:            playing draw poker
description:         for blog entry
homepage:            http://tune.hateblo.jp/entry/2015/05/12/023112
license:             BSD3  
license-file:        LICENSE
author:              Tokiwo Ousaka
maintainer:          its.out.of.tune.this.my.music@gmail.com
category:            Game
build-type:          Simple
cabal-version:       >=1.10

library
  hs-source-dirs:      src
  exposed-modules:     Game.Poker
                     , Game.Poker.Hands
                     , Game.Poker.Cards
  build-depends:       base >= 4.7 && < 5
                     , random-shuffle
                     , safe
  default-language:    Haskell2010

executable draw-poker
  hs-source-dirs:      app
  main-is:             Main.hs
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  build-depends:       base
                     , draw-poker
  default-language:    Haskell2010

test-suite draw-poker-test
  type:                exitcode-stdio-1.0
  hs-source-dirs:      test
  main-is:             Spec.hs
  build-depends:       base
                     , draw-poker
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  default-language:    Haskell2010

source-repository head
  type:     git
  location: https://github.com/tokiwoousaka/draw-poker

変更すべき箇所については以下のdiffを参照していただくと良いでしょう。

https://gist.github.com/tokiwoousaka/802654fd6e4ab3ed2f0c/revisions
http://tune.hateblo.jp/entry/2015/07/13/034148

各項目について詳しい説明は行いません、 得に設定する事の多い、以下の二点のみ、認識しておいてください。

  • モジュールが増えた場合はexposed-modulesに項目の追加が必要
  • 依存するパッケージが増えた場合、build-dependsに項目の追加が必要

それ以外で今後修正が必要な場合は都度説明します。

ポイントとしては、

  • パッケージ名をnew-templateから変更
  • synopsisdescription等のメタ情報を設定した
  • source-repositoryの設定は任意(しなくても良い)

といった所でしょうか。 その他、以下の基本的な機能については覚えておきましょう。

  • 動作確認
    • stack replコマンド:libraryをGHCiで読み込みます
    • stack runghc app/Main.hsコマンド:app/Main.hsを実行します
  • インストール
    • stack installコマンド:ライブラリおよび実行ファイルのインストール
      • cabalファイルのlibraryで設定されている情報を元にライブラリをインストール
      • cabalファイルのexecutableで設定されている
  • ドキュメント作成
    • stack haddockコマンド:
      • ビルド通ったら一度は確認しときましょう。とても便利です。

なお、残念ながら現状、日本語の資料は整いきっていない状況です。 以下の記事を参考にすると良いでしょう。

http://qiita.com/tanakh/items/6866d0f570d0547df026

Hackageへのアップロード

あまり詳細には説明しませんが、開発したアプリケーションやライブラリをHackageにアップロードするための機能として、 cabalにはcabal upload、stackにはstack uploadというコマンドが存在します。

本連載で開発中のポーカーも、Hackageにアップロード済です。

http://hackage.haskell.org/package/draw-poker

プロジェクトの整理

さて、これでひと通りビルドツールの説明を終えました、動く事が確認出来たはずです。
いよいよ開発っぽくなってきましたね。

ところで、前々回/前回で作成した関数はMain.hs(Poker.hsに変更したのでした)に纏めて作ったのでした。 このままでは今後整理し切れなくなる可能性があるため、これらをちゃんと整理し、機能毎のモジュール化を行いましょう。

モジュール化

まず、現状のMain.hsモジュールに宣言されている型や関数を列挙してみましょう。 前々回では「ハンドの入れ替え処理」を作りました。そして前回作成したのAIの思考ルーチンもありますね。

  • ハンドの入れ替え
      • type DiscardList = [Card] -- 捨て札
    • 関数
      • getHand :: Deck -> Maybe (Hand, Deck)
      • drawHand :: Deck -> DiscardList -> Hand -> Maybe (Hand, Deck)
      • getDiscardList :: Hand -> IO (Maybe DiscardList)
      • toIntList :: String -> Maybe [Int]
      • selectByIndexes :: [a] -> [Int] -> Maybe [a]
  • AIの思考ルーチン(カードの入れ替え)
    • 関数
      • aiSelectDiscards :: Hand -> DiscardList
      • nOfKindDiscards :: Hand -> DiscardList
  • 勝敗判定
    • 関数
      • judgeVictory :: (PokerHand, Card) -> (PokerHand, Card) -> Ordering
  • プロトタイプ
      • data Player = Player | Enemy deriving Eq
    • 関数
      • simpleGame :: IO ()
      • showPlayerName :: Player -> String
      • matchPoker :: (Hand, Deck) -> IO ()
      • playPoker :: Hand -> Deck -> Player -> IO ((PokerHand, Card), Deck, Hand)
      • inputDisuse :: Hand -> IO DiscardList
      • aiDisuse :: Hand -> IO DiscardList
      • printResult :: Hand -> Hand -> (PokerHand, Card) -> (PokerHand, Card) -> IO ()
      • printHand :: DiscardList -> Hand -> Player -> IO ()
      • printHand dis hand player =
      • ynQuestion :: String -> IO a -> IO a -> IO a
      • showChangeHand :: DiscardList -> Hand -> String

src/Game/Pokerディレクトリ以下に新たにAI.hsおよびHands.hsを用意します。 で、この4つに分類した関数を、以下のとおりモジュール分けしましょう。

  • ハンドの入れ替え:Hands.hs
  • AIの思考ルーチン:AI.hs
  • 勝敗判定:Hands.hs
  • プロトタイプ:Simple.hs

結果として、ソースコードは以下のような配置になっているはずです。

.
├── app
│   └── Main.hs
└── src
    └── Game
        ├── Poker
        │   ├── AI.hs <- 追加  
        │   ├── Cards.hs
        │   ├── Hands.hs
        │   └── Simple.hs <- 追加  
        └── Poker.hs

移動させた各関数をエクスポートした上で、Poker.hsを次のように書き換えます。

module Game.Poker
    ( module Game.Poker.Hands
    , module Game.Poker.Cards
    , module Game.Poker.AI
    ) where

import Game.Poker.Hands
import Game.Poker.Cards
import Game.Poker.AI

このように、module モジュール名のようにエクスポート文を記述する事によって、 そのモジュールがエクスポートしている全ての関数をエクスポートする事ができ、 Poker.hsはポーカー開発に便利なあらゆるモジュールを全て一気にエクスポートする事ができるようになります。 また、ポーカーゲーム本体になるIO処理は、このモジュールに作っていく事にしましょう。

プロトタイプの扱い

さらに、Game.Pokerモジュールではエクスポートしなかった、Simple.hsについて考えます。 ここでエクスポートしているsimpleGame関数は、前回までで作成したプロトタイプですね。

このプロトタイプも遊べるものにはなっているので、捨ててしまうのももったいないですし、 得にリソースを消費するほどのものでも無いですから、一緒に配布する事を考えましょう。

appフォルダ以下にSimple.hsを追加し、cabalファイルに以下のような記述を追加します。

executable draw-poker-simple
  hs-source-dirs:      app
  main-is:             Simple.hs
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  build-depends:       base
                     , draw-poker
  default-language:    Haskell2010

そして、追加したSimple.hsで、Poker.Simpleモジュールを読み込み、main関数でsimpleGame関数を呼び出すようにします。 同時に、先ほどまでsimpleGameを呼んでいたMain.hsmain関数については、ひとまずHello Worldでも書いておけば良いと思います。

これらをひと通り設定したら、ビルドが実行してみて、 上手く行ったらcabal installまたはstack installを実行し、 2つのアプリケーションがインストールされて実行出来るか確認すると良いでしょう。

色々と設定する事が多くて大変かもしれません、stack向けに構成したプロジェクトをGithubに上げてあるので、 もし上手く行かない場合はこちらも参考にしてみてください。

https://github.com/tokiwoousaka/draw-poker/tree/aa33fc7fdbf3e1292cbc33a580bd21758ae4a6b6

まとめ

というわけで、今回はビルドツールの使い方を説明し、モジュールの整理を行いました。

一定以上大きなプログラムを開発する上ではプログラミング言語そのものだけではなく、 さまざまな開発ツールの使い方を習得する必要がある事は、言うまでもないでしょう。

これらツールの使い方は本記事では解説し切れない事も多いので、 cabalやstack等ツールの使い方については、各々でも色々と調べてみてください。

さて、せっかくプロジェクトを整えたのですから、 この構成を利用して、プログラムの検証を行えるようになると良いですね。
というわけで、次回はHUnitやQuickCheckといったテスト用のライブラリについて説明し、 テストコードの書き方について説明して行きます。

それではまた、ノシノシ

←前

Haskellでポーカーを作ろう〜第六回 CPU対戦機能を付けよう〜

はいはいどうも、台風シーズンですね。
小学生の頃とか、台風はなんかドキドキするので好きでした。

今も好きですが、いろいろとアレがアレして、昔ほど手放しで楽しめないです。
おとなになんか、なりたくなかった。

はい、どうもパスタ大好きちゅーんさんです。

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

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

とゆーわけで、今回は、前回作ったプロトタイプに、CPUと対戦する機能をつけていきます。

仕様を考える

といっても、この段階でAIと呼べるほどがっつりしたものを作るわけではないです。

最終的には個性的なAIを作って、CPU同士やプレイヤー間でちょっとした駆け引きが行われるような感じに出来ると良いのですが、 現段階ではまだ簡単でも動く事が重要です。

というわけで、作っていくわけですけども、オブジェクト指向に慣れている方だと、 その前に対戦相手のAIを切り替えたりできるように、抽象クラスやインターフェイスのようなものを考えた方が良いと思われるかもしれません。

しかしHaskellの場合は、そこまで深く考える必要はないのです。何故でしょう?

今日作るもの

まず、「入れ替えるカードを判断する」処理というのは、 「手札からいらないカードを判定する」という処理と考える事が出来ます。

つまり、次のような関数が用意できれば良いわけですね。

aiSelectDiscards :: Hand -> DiscardList

本日の目標はこの関数と勝敗判定処理を実装し、それをベースに前回作ったプロトタイプを改造する事です。

AIの仕様の構想

Haskellには関数同士を糊付けする手段が沢山あるため、ひとまず必要な事がわかっている関数は作ってしまえば良い、 という事は以前も述べましたが、かといって闇雲に作っていってもゴールにたどり着くのが大変なので、 予めどのように構成していくのか、雰囲気だけでも考えておきましょう。

尚、ここで書くことはあくまで「現段階で考えられる方向性」ですので、 大幅に変更される可能性がある事をご了承ください。

まず、aiSelectDiscardsの型定義では、ちゃんとしたAIを作るためには不十分であると言えます。

同じスートのカードが4枚揃っていた場合、 残りの1枚だけ替えてフラッシュに賭けるか、それとも全換えしてワンペア以上の役に賭けるかを、 場の「状況」や「気まぐれ」等によって判断する必要がありますね。

対人のドローポーカーにおいて、相手が「何枚カードを捨てたか」というのは、 相手のハンドの強さを判断するための重要な情報になります。 そのため、「気まぐれ」にブラフとしてノーペアなのにわざと二枚残してカードを入れ替える事もあるでしょう。

場の「状況」等をAiHintという型に纏めると想定し、「気まぐれ」な判断をさせるため乱数(副作用)を許すような型を考えると、 最終的に捨て札を選択するAIの処理は次のような型を持った関数になると考えられます。

AiHint -> Hand -> IO DiscardList

IOは何でも出来てしまうので、危険だと感じる方も多いかもしれません。 より安全な型定義をする事も出来ますが、 やや高度な話になってきてしまうので、今回はIOで我慢する事にしましょう。

どんどん型を揃える

上記の定義では、AiHintを第一引数にしてありますので、この部分は簡単に部分適用できますね。
するとHand -> IO DiscardListという型を得る事ができます。

あー、そういえば 前回の最後のほうで、だだだーっとお見せしたプロトタイプの中に、次のような関数がありました。

inputDisuse :: Hand -> IO DiscardList
inputDisuse hand = do
  ...

これは、プレイヤーから捨て札の入力を受ける処理です。

この関数を元に、次のような関数を作る事ができまして・・・

inputDisuse' :: AiHint -> Hand -> IO DiscardList
inputDisuse' _ = inputDisuse

このように、先ほど想定したAIと型を合わせる事が可能です。 (尚、この関数は確実に使うといえるわけでは無いので、まだ作らなくても良いです)

Haskell関数型プログラミング言語ですから、この型を持った関数を内包したデータ構造を定義したり、 この型を持った関数を引数に持った高階関数を定義する事も簡単に出来ますね。

つまる所、ユーザーだろうがAIだろうが、プレイヤーが捨て札を選別する処理については、 AiHint -> Hand -> IO DiscardListの型になるように実装すれば全て同じように扱う事ができます。

結果的に、「必要な処理」の型を考える事によって、自動的に何種類ものAIを統一的に扱うための手段を得る事ができました。
それどころか、ユーザーの入力も同じ仕組みの上で扱えるというおまけも付いてきましたね。

Haskellではこのように、普段から型を揃えるクセを付ける事によって、 明記せずともオブジェクト指向ポリモーフィズムを駆使したのと同様の道具立てを得る事が出来るのです。

捨て札を選択する

さて、ふわふわっと方向性について考えた所で、今回作る関数の型を再掲します。

aiSelectDiscards :: Hand -> DiscardList

モジュールの整理は次回やる事として、今回もMain.hsにずらずらと書いていく事にしましょう。

ひとまずそれっぽく動くようにするのが目的なので、 今回は「役が確定している場合のみ残し、それ以外は捨てる」という方針で作っていきます。

最後には色々な思考パターンを持ったAIを作るのですから、今回作る「単純な判定処理」が無駄になる事はないでしょう。

番号の揃っているカードを除外する

まず、ワンペアやツーペア、スリーカードやフォーカードを判定します。

同じ番号が揃っている場合、そのカードは残しておきたいわけですから、捨て札からは除外する必要がありますね。 除外するには、まず揃っているカードを手札から抽出しなくてはいけないわけですから、手始めに次のような関数を作ります。

allNOfKinds :: Hand -> [Card]

返り値は、同じ番号のカードが2枚以上揃っているすべてのカードです。 例えば[D2_,S2_,CJ_,SJ_,HA_]が与えられた場合は、[D2_,S2_,CJ_,SJ_]を返し、 [D8_,C8_,S8_,DJ_,CA_]が与えられた場合は、[D8_,C8_,S8_]を返します。

この関数を実装するには、第三回で作ったnOfKindHint :: Int -> Hand -> Maybe [[Card]]関数が役に立ちそうです。 nOfKindHintは第二引数で指定した手札から、第一引数で指定したn枚組の全カードを返すのでしたね。

さらに、Data.MaybeモジュールにあるcatMaybes関数と、二重のリストを一重に押しつぶすconcat関数も使います。

ghci> :t catMaybes 
catMaybes :: [Maybe a] -> [a]
ghci> catMaybes [Just 1, Nothing, Just 2, Just 3]
[1,2,3]
ghci> :t concat
concat :: [[a]] -> [a]
ghci> concat [[1,2],[3,4,5]]
[1,2,3,4,5]

というわけで、必要な道具は次の2つです。

nOfKindHint :: Int -> Hand -> Maybe [[Card]]
catMaybes :: [Maybe a] -> [a]
concat :: [[a]] -> [a]

型を合わせていく感覚にも、そろそろ慣れてきた頃でしょうし、詳細な説明は省略し、 allNOfKindsの返り値になる[Card]という型を構成していく流れをだだーっと羅列していきましょう。

hand :: Hand とする

① nOfKindHint 2 hand :: Maybe [[Card]]
② [nOfKindHint 2 hand, nOfKindHint 3 hand, nOfKindHint 4 hand] :: [Maybe [[Card]]]
③ catMaybes [nOfKindHint 2 hand, nOfKindHint 3 hand, nOfKindHint 4 hand] :: [[[Card]]]
④ concat $ 
  catMaybes [nOfKindHint 2 hand, nOfKindHint 3 hand, nOfKindHint 4 hand] :: [[Card]]
⑤ concat . concat $ 
  catMaybes [nOfKindHint 2 hand, nOfKindHint 3 hand, nOfKindHint 4 hand] :: [Card]

というわけで、allNOfKinds関数は次のような実装になりました。

allNOfKinds :: Hand -> [Card]
allNOfKinds hand = concat . concat 
  $ catMaybes [nOfKindHint 2 hand, nOfKindHint 3 hand, nOfKindHint 4 hand]

で、実際には手札からこのallNOfKinds関数を除外したものを捨て札としたいわけですから、 次のようなnOfKindDiscards関数を実装すればOKですね。

nOfKindDiscards :: Hand -> DiscardList
nOfKindDiscards hand = filter (flip notElem $ allNOfKinds hand) $ fromHand hand
  where
    allNOfKinds :: Hand -> [Card]
    allNOfKinds hand = concat . concat 
      $ catMaybes [nOfKindHint 2 hand, nOfKindHint 3 hand, nOfKindHint 4 hand]

filter関数周りは、前回drawHand関数を作った際にやった事と同じです。

纏め上げる

役が確定しているパターンはこの他に、ストレートの場合とフラッシュの場合が考えられます。

やはり第三回で実装した、以下2つの関数が役に立ちそうです。

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

返却値は、それぞれ最強カードを返すのでした。 しかし今回はこの返却値は使わずに、結果がJustだった場合は全てのカードを残すようにしたい・・・ つまり捨て札が0枚になるようにしたいわけですね。

このような場合、Control.Applicativeモジュールで定義されている(*>)演算子が役に立ちます。 (Applicativeについては前回やりましたね、Maybe型はApplicative型クラスのインスタンスなのでした。)

*Main> :t (*>)
(*>) :: Applicative f => f a -> f b -> f b
*Main> Just 5 *> Just "Hoge"
Just "Hoge"
*Main> Just True *> Just "Hoge"
Just "Hoge"
*Main> Nothing *> Just "Hoge"
Nothing
*Main> Just 5 *> Nothing
Nothing

フラッシュかストレート、「どちらか」がJustだった場合には捨て札無しという事で空リストを返したいわけですが、 このようなパターンは以前にも一度あったのを覚えてますか?

そうです、「どちらかがJustの場合にのみ結果を返す」にはmplus関数でしたね。 というわけで、これらを使って捨て札の判定処理、aiSelectDiscards関数を完成させてしまいましょう。

aiSelectDiscards :: Hand -> DiscardList
aiSelectDiscards hand = 
  case straightHint hand `mplus` flushHint hand *> Just [] of 
    Nothing -> nOfKindDiscards hand
    Just xs -> xs 

mplusの結果がNothingだった場合に、nOfKindDiscardsの結果を返すようにしました。
nOfKindDiscardsはブタだった場合、手札をまるっと捨て札として返してきますので、 得に役無しの場合については考える必要ありません。

勝敗判定処理

さて、勝敗判定処理は簡単なのでちゃちゃーっと説明しちゃいますね。

judgeVictory :: (PokerHand, Card) -> (PokerHand, Card) -> Ordering
judgeVictory l r = compare (pullStrength l) (pullStrength r)
  where
    pullStrength :: (PokerHand, Card) -> (PokerHand, Int)
    pullStrength = fmap cardStrength

単純な大小比較によって勝敗を判定できるように、PokerHand型をOrd型クラスのインスタンスにしておいたのが役に立ちます。

Card型もOrd型クラスのインスタンスなので、 pokerHand関数の結果をそのまんまcompare関数で比較する事もできるのですが、 今回開発しているポーカーのルールでは、スートによって強弱に差は無いものとしたいです。

例えば、ハートの10とスペードの10は同じ強さになります。 そこで、予めCardsモジュールで定義しておいてcardStrength関数を使って、 カードの強さを表す数値に置き換えて、それから比較するという手順を踏んだわけですね。

pullStrength関数の実装について「おや?」となった方もいるかもしれません。 二値のタプルはFunctorとなっており、fmapを使って2要素目に関数を適用する事ができるのです。

ghci> fmap (\*2) (0, 100)
(0,200)
ghci> fmap show (0, 100)
(0,"100")

プロトタイプを改造

さて、今回作成した捨て札選択処理と勝敗判定処理を組み合わせて、 以前作ったプロトタイプを、CPU対戦できるように拡張します。

例によって、プロトタイプはべたべたと手続きプログラミングしているだけなので、得に面白い所はありません。

純粋関数型である事が災いして、山札の管理がかなり煩雑になってしまっていますが、 この問題については、プロトタイプではないゲーム本体を開発していく際にはちゃんと解決していきます。 (先に答えを言ってしまうと、山札を状態管理していない事が原因なので、山札を状態で管理してしまえば良いのです。)

main :: IO ()
main  = do
  putStrLn "------------------"
  putStrLn "-- simple poker --"
  putStrLn "------------------"
  deck <- shuffleM allCards
  case getHand deck of
    Nothing -> error "予期せぬエラー : getHand in simpleGame"
    Just res -> matchPoker res
  ynQuestion "-- もっかいやる?" main (putStrLn "-- またねノシノシ")

data Player = Player | Enemy deriving Eq

showPlayerName :: Player -> String
showPlayerName Player = "あなた"
showPlayerName Enemy = "あいて"

matchPoker :: (Hand, Deck) -> IO ()
matchPoker (mhand, deck) = do
  (mres, ndeck, nmhand) <- playPoker mhand deck Player
  case getHand ndeck of
    Nothing -> error "予期せぬエラー : getHand in matchPoker"
    Just (ehand, odeck) -> do
      (eres, _, nehand) <- playPoker ehand odeck Enemy
      printResult nmhand nehand mres eres
  
playPoker :: Hand -> Deck -> Player -> IO ((PokerHand, Card), Deck, Hand)
playPoker hand deck player = do
  discards <- if player == Player 
    then inputDisuse hand
    else aiDisuse hand
  case drawHand deck discards hand of
    Nothing -> error "予期せぬエラー : drawHand"
    Just (nhand, ndeck) -> do
      let res = pokerHand nhand
      return (res, ndeck, nhand)

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

aiDisuse :: Hand -> IO DiscardList
aiDisuse hand = do
  let res = aiSelectDiscards hand
  printHand res hand Enemy
  putStrLn "-- あいて:これでいいよ!" 
  return res

----
          
printResult :: Hand -> Hand -> (PokerHand, Card) -> (PokerHand, Card) -> IO ()
printResult mhand ehand mres@(mph, mcard) eres@(eph, ecard) = do
  putStrLn " ***** 結果発表!! *****"
  printHand [] mhand Player
  printHand [] ehand Enemy
  putStrLn $ concat ["あなたの手札は ", show mph, " で、最強カードは ", show mcard, " でした"]
  putStrLn $ concat ["あいての手札は ", show eph, " で、最強カードは ", show ecard, " でした"]
  case judgeVictory mres eres of
    LT -> putStrLn "あなたの負けです"
    EQ -> putStrLn "引き分けです"
    GT -> putStrLn "あなたの勝ちです"

printHand :: DiscardList -> Hand -> Player -> IO ()
printHand dis hand player = 
  putStrLn $ "-- " ++ showPlayerName player ++ "の手札 : " ++ 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)

長ったらしくて面白くもないやつなので、説明とかしないです。
前回とのdiffは、以下のURLを確認してください。

https://gist.github.com/tokiwoousaka/b471aa0efed725c6a05d/revisions

とにかく、これでCPUと対戦出来るプロトタイプが出来ました。

------------------
-- simple poker --
------------------
-- あなたの手札 : [H6_][D7_][C8_][S8_][CQ_]
-- 捨てるカードを選んでね
125
-- あなたの手札 :  H6_  D7_ [C8_][S8_] CQ_ 
-- あなた:これでいい?(y/n)
y
-- あいての手札 : [C3_][S3_] S7_  SJ_  SK_ 
-- あいて:これでいいよ!
 ***** 結果発表!! *****
-- あなたの手札 : [C7_][D8_][C8_][S8_][D10]
-- あいての手札 : [C3_][S3_][H8_][DQ_][DK_]
あなたの手札は ThreeOfAKind で、最強カードは S8_ でした
あいての手札は OnePair で、最強カードは S3_ でした
あなたの勝ちです
-- もっかいやる?(y/n)
y
------------------
-- simple poker --
------------------
-- あなたの手札 : [D2_][H3_][D5_][H7_][S9_]
-- 捨てるカードを選んでね
12345
-- あなたの手札 :  D2_  H3_  D5_  H7_  S9_ 
-- あなた:これでいい?(y/n)
y
-- あいての手札 :  H4_  D6_ [HJ_][SJ_] CK_ 
-- あいて:これでいいよ!
 ***** 結果発表!! *****
-- あなたの手札 : [S2_][S6_][C8_][HQ_][DQ_]
-- あいての手札 : [S3_][C10][S10][HJ_][SJ_]
あなたの手札は OnePair で、最強カードは DQ_ でした
あいての手札は TwoPair で、最強カードは SJ_ でした
あなたの負けです
-- もっかいやる?(y/n)
n
-- またねノシノシ

わりとたのしい。

まとめ

というわけで、今回はべたべたとCPUと対戦する機能を作ってみました。

多少新しい事も紹介しましたが、 基本的には今まで作った関数を、これまで使ったテクニックを組み合わせる事によって実現していく感じになりましたね。

Haskellで実装した関数の使い回しのしやすさを体感できたのではないでしょうか。

さて、そろそろMain.hsも煩雑になってきた頃ですし、宣言通り次回はこれまで作った関数群を整理していきます。 プログラム全体も良い規模になってきましたので、プロジェクトとしてちゃんと構成しなおし、 cabalstack等といったビルドツールの使い方も簡単にご紹介しようと思います。

それではノシノシ

←前 次→

もうcabal hellは怖くない、Stackを使ってみるよ!

はいはいどうも、最近はずっとドラクエやってます。 ちゅーんさんです。

人生ではじめてプレイしたRPGってドラクエ6だった気がします。 スマフォ版で久々にプレイしたのですが、やっぱりアレです。
バーバラちゃん、いいですね。

あ、ひとまずラスボス倒したので、今は3やってます。
ポカパマズさああああああん!!!!

はい。

というわけで、 この記事はちゅーんさんがイマドキのHaskellのビルドツールである、 stackを2日くらいぐりぐりいじって覚えた使い方をまとめようと思います。

ざっくりと、stackってどんなもんよ、みたいな話は

http://qiita.com/tanakh/items/6866d0f570d0547df026

の前半を読むとだいたいわかりますので、 ここでは実用的な具体例はさておき、とにかく動かしてみたい人に向けて、 「ここに書かれてる通りに色々やったら、なんとなくstackの使い方が分かった気がするー。」 くらいの感じのチュートリアルになるように頑張ります。頑張りました。

2015/7/13 18:19 投稿当時、本記事でsolver内のパッケージを使用する際に、stack.yamlへの追記を行っている場所がありましたが、solverに含まれないパッケージを使用する場合にのみ設定が必要とのご指摘を頂きました。現在は修正済です。

インストール

ここ

https://github.com/commercialhaskell/stack

のHow to installを参照しましょう。

自分の場合、Ubuntu14.04なので、ターミナルから

$ wget -q -O- https://s3.amazonaws.com/download.fpcomplete.com/ubuntu/fpco.key | sudo apt-key add -
$ echo 'deb http://download.fpcomplete.com/ubuntu/trusty stable main'|sudo tee /etc/apt/sources.list.d/fpco.list
$ sudo apt-get update && sudo apt-get install stack -y

でなんか良くわからないけど入りました。てへぺろ

実行プログラムを作る

準備

まず、適当なフォルダを作って、次のような手順でstack newコマンドを実行します。

$ mkdir firstApp
$ cd firstApp
$ stack new

すると、以下のような最低限のファイルがひと通り揃ったプロジェクトファイルが出来上がります。

.
├── app
│   └── Main.hs
├── LICENSE
├── new-template.cabal
├── Setup.hs
├── src
│   └── Lib.hs
├── stack.yaml
└── test
    └── Spec.hs

3 directories, 7 files

基本的には、これをベースにいい感じに書き換えてやればOKみたいです。

まず、以下のファイルをリネームします。

  • new-template.cabal -> firstApp.cabal
  • Lib -> FirstApp.hs

で、この2ファイルとMain.hsを、それぞれ次のように書き換えます。

src/FirstApp.hs:

module FirstApp
 ( message
 ) where

message :: String
message = "Hello, Stack!"

app/Main.hs:

module Main where
import FirstApp

main :: IO ()
main = putStrLn message

firstApp.cabal:

name:                firstApp 
version:             0.1.0.0
synopsis:            Initial project template from stack
description:         Please see README.md
homepage:            http://github.com/name/project
license:             BSD3
license-file:        LICENSE
author:              Your name here
maintainer:          your.address@example.com
-- copyright:           
category:            Web
build-type:          Simple
-- extra-source-files:  
cabal-version:       >=1.10

library
  hs-source-dirs:      src
  exposed-modules:     FirstApp
  build-depends:       base >= 4.7 && < 5
  default-language:    Haskell2010

executable firstApp 
  hs-source-dirs:      app
  main-is:             Main.hs
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  build-depends:       base
                     , firstApp
  default-language:    Haskell2010

test-suite firstApp-test
  type:                exitcode-stdio-1.0
  hs-source-dirs:      test
  main-is:             Spec.hs
  build-depends:       base
                     , firstApp
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  default-language:    Haskell2010

source-repository head
  type:     git
  location: https://github.com/name/project

cabalファイルはちょっと解りづらいですが、パッケージ名やファイル名等をビルド出来るようにリネームしたので、 それに合わせてパッケージ名やモジュール名などを編集しただけです。

実際には、synopsisとかcategoryとか、開発するプロジェクトに合わせて色々設定しましょう。

stack build

stack buildは、プロジェクトをビルドするコマンドです。 これによって、インストールされていない依存パッケージ等が解決されます。 後述のstack ghci等を使う前に、一回は実行する必要があるみたいですので、とりあえず実行しましょう。

cabalファイルの設定に不備があれば、この段階で指摘されるので修正していきます。

stack ghci

無事ビルドが成功したらstack ghciを実行すると、FirstAppモジュールが読み込まれた状態でGHCiが起動します。

こういう時に実行されるGHCのバージョンとかがどうやって決まるのかは、今の所ちゃんと調べてません。solver(Stackageのスナップショット)の設定によるんだと思われます。

$ stack ghci
Configuring GHCi with the following packages: firstApp
GHCi, version 7.8.4: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package firstApp-0.1.0.0 ... linking ... done.
[1 of 1] Compiling FirstApp         ( /home/tune/Documents/Program/Haskell/StackTutorials/Tutorial/firstApp/src/FirstApp.hs, interpreted )
Ok, modules loaded: FirstApp.
*FirstApp> message
"Hello, Stack!"

尚、この時に対応するバージョンのGHCがインストールされていない場合はエラーになります。
その場合、stack setupするだけで対応するGHCが簡単にインストールされますが、 stack buildでも自動的に解決されますので、基本的にこのコマンドを使う事は無いでしょう。

うーん、階層の深い所にある、小さなモジュールだけGHCiでロードして動作確認したい場合ってどうするのが良いんですかね?

stack runghc

んで、mainを実行してみたいのであれば、stack runghcコマンドを使います。

$ stack runghc app/Main.hs
Hello, Stack!!

こんな感じで、小さい単位で実行出来るのはsrc配下のライブラリ部分だけなので、 app以下のフォルダは必然的に最小限になるようです。

stack install

で、出来上がったアプリケーションをインストールしたい場合は、stack installコマンドを使います。

$ stack install

 ...略...

Installed executables to /home/tune/.local/bin/:
- firstApp
$ firstApp
Hello, Stack!

実行ファイルにパスが通っていれば、普通にコマンドラインから実行できるようになります。

ライブラリを作る/使う

ライブラリを作る

ライブラリを作る場合も、基本的な考え方は同じで、 cabalファイルをライブラリ用に書き換えでやればOKな感じですね。

まず、firstAppと同じ感覚でプロジェクトを作成しましょう。

$ mkdir firstLib
$ cd firstLib
$ stack new

で、次のようにリネームしたり、appフォルダを削除したりしまして…

$ tree
.
├── firstLib.cabal
├── LICENSE
├── Setup.hs
├── src
│   └── FirstLib.hs
├── stack.yaml
└── test
    └── Spec.hs

各ファイルを以下のようにして書き換えます。

src/FirstLib:

module FirstLib
    ( firstLib
    ) where

firstLib :: IO ()
firstLib = putStrLn "`firstLib` called!"

firstLib.cabal

name:                firstLib
version:             0.1.0.0
synopsis:            Initial project template from stack
description:         Please see README.md
homepage:            http://github.com/name/project
license:             BSD3
license-file:        LICENSE
author:              Your name here
maintainer:          your.address@example.com
-- copyright:           
category:            Web
build-type:          Simple
-- extra-source-files:  
cabal-version:       >=1.10

library
  hs-source-dirs:      src
  exposed-modules:     FirstLib
  build-depends:       base >= 4.7 && < 5
  default-language:    Haskell2010

test-suite firstLib-test
  type:                exitcode-stdio-1.0
  hs-source-dirs:      test
  main-is:             Spec.hs
  build-depends:       base
                     , firstLib
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  default-language:    Haskell2010

source-repository head
  type:     git
  location: https://github.com/name/project

後は、stack buildでビルドして、stack ghciで動作確認してみましょう。

で、これをStackageに上げるためには、stack uploadを使うみたいなんですが、 この辺はまだ試していないので良くわからんです(`・ω・´)キリッ

作成したライブラリを使う

さて、今作ったfirstLibfirstAppから使う方法を説明します。
firstApp側のstack.yamlと、firstApp.cabalそれぞれに、firstLibに依存している事を記述します。

cabalファイルはご存知の通りプロジェクトをビルドするための情報ですが、stack.yamlはstackがパッケージの依存関係等を安全に解決するための設定ファイルです。

stack.yaml

flags: {}
packages:
- '.'
- '../firstLib/'
extra-deps: []
resolver: lts-2.17

firstApp.cabal

 ...略...

executable firstApp 
  hs-source-dirs:      app
  main-is:             Main.hs
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  build-depends:       base
                     , firstApp
                     , firstLib
  default-language:    Haskell2010

 ...略...

で、app/Main.hsFirstLibimportしーの…

app/Main.hs

module Main where
import FirstApp
import FirstLib

main :: IO ()の
main = do
  putStrLn message
  firstLib

stack buildでビルドしーの、stack runghcで実行。

$ stack build
$ stack runghc app/Main.hs
Hello, Stack!
`firstLib` called!

良い感じですね。

Stackageのライブラリを使う

試しに、lensをfirstAppから使えるようにしてみましょう。

んで、最初solverのパッケージを使うためには単純にstack.yamlに記述が必要だと思っていたのですが、 どうやらcabalファイルにパッケージ名を追記すればOKなようです。

firstApp.cabal

 ...略...

executable firstApp 
  hs-source-dirs:      app
  main-is:             Main.hs
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  build-depends:       base
                     , firstApp
                     , firstLib
                     , lens
  default-language:    Haskell2010

 ...略...

もう一度、現段階のstack.yamlの設定を見てみましょう。

stack.yaml

flags: {}
packages:
- '.'
- '../firstLib/'
extra-deps: []
resolver: lts-2.17

resolverの設定がlts-2.17となっていますが、これはこのプロジェクトと対応したsolverのバージョンです。

Stackageのサイト内にある、該当するsolverのHoogle検索でlensに関する演算子を検索してみましょう。

https://www.stackage.org/lts-2.17/hoogle?q=%28.~%29

ここから、LensのHaddockに飛ぶと、バージョンが4.7.0.1になっています。 このようにして、自動的にインストールされるパッケージのバージョンを知る事ができます。

んで、ビルドして実行。
勝手にlensをStakageからダウンロードして、インストールしてくれます。

$ stack build
$ stack runghc app/Main.hs
Hello, Stack!  `firstLib` called!
---------------------------
222
("Hoge","Stack","Fuga")

Lensは巨大なライブラリなのでビルドには時間がかかりますが、 同じsolverのライブラリ群はどのような組み合わせでビルドしても、依存関係で詰まる事は無い事がわかっているので、 コーヒー片手にすごいH本でも読みながらまったり待ちましょう。

テストを書く

そういえば、なんやかんや型のおかげであんまりテストを必要に感じる事がなくて cabal経由でテストを試してみた事が無かったわけですけど、 いつ必要になるかわかりませんし、stackの練習も兼ねて作ってみましょう。

今回テストを追加してみるのは、firstLibの方です。

そういえば、firstLibの関数をIOにしてしまってましたね…、 面倒くさいので、テストしやすいようにメッセージ部分を切り離します。

src/firstLib.hs

module FirstLib
  ( firstLib
  , libMessage
  ) where

firstLib :: IO ()
firstLib = putStrLn libMessage

libMessage :: String
libMessage = "`firstLib` called!"

で、意味の無いテストですが、HUnitを使ってこのメッセージの内容をチェックするテストを書いてみます。

test/Spec.hs

 ...略...

test-suite firstLib-test
  type:                exitcode-stdio-1.0
  hs-source-dirs:      test
  main-is:             Spec.hs
  build-depends:       base
                     , firstLib
                     , HUnit
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  default-language:    Haskell2010

 ...略...

test/Spec.hs:

import Test.HUnit
import FirstLib

messageTest :: Test
messageTest = "MessageTest" ~: libMessage ~=? "`firstLib` called!"

main :: IO ()
main = runTestTT messageTest >>= print

これで、stack testを実行すれば、このテストを実行する事ができます。

$ stack test
firstLib-0.1.0.0: test (suite: firstLib-test)
Cases: 1  Tried: 1  Errors: 0  Failures: 0
Counts {cases = 1, tried = 1, errors = 0, failures = 0}

OKですね。

まとめ

とゆーわけで、ざっくりとstackの使い方をまとめてみました。

  • cabal sandboxよりはだいぶ使いやすい
  • ライブラリ間の依存関係に悩まされなくて済む
  • GHCのバージョンが上がってもプロジェクトが死なないで済む

とゆー感じで、ちょっと触った感触だと、かなり魅力的なビルドツールと言えます。

あと、既存のプロジェクトをstackで管理できるようにするstack initなんてコマンドもあるみたいですが、 これは近々に必要なので試してみようと思います。気が向いたらまた記事にするかもしれません。

そういえば、他の言語だと、こういう問題ってどうやって解決してるんでしょう?
それから、複数のsolverに対応したい場合とかって、どうすれば良いんですかねー(´・ω・`)

とかまぁ、色々気になる点はありますが、 慣れてくるとなかなか良い感じなので、愛用していこうと思いました。まる。

ではではノシノシ

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

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

はい

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

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

前回からの修正点

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

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

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

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

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

今回は何をやろう

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

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

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

関数の型を考える

全体の構成がどうなっていくのか、現段階ではわからないので、 ひとまず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は型を作るコストが小さいので、多用しすぎてわかりづらくなってしまう事もあるため、 ケース・バイ・ケースで適切に設計する必要があります。

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

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

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

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

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

getDiscardList :: Hand -> IO (Maybe DiscardList)

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

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モナドを使っている部分について、(<-)によって得る事が出来たhandndeckを順にタプルに当てはめているだけなのに気づいたでしょうか。 (,) :: a -> b -> (a, b)となるため、この部分は(,) hand ndeckと書いても同じ事になります。

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

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

(<$>) :: 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 -> Cx :: Maybe Ay :: Maybe Bとした時、xyfに適用する方法を考えましょう。
まず、fmapを使ってfxを適用すると、次のように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は2引数以上の関数に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と入力した場合、引数の手札の2枚めと3枚めと5枚めのカードを捨て札として返します。

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

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

数値にパースできない入力や、カードの枚数を超えた数値を入力するなど、ユーザーにより不正な入力を受ける事によって例外が発生する可能性があったため、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型クラスが出てきても驚かなくなった頃でしょうか。
MaybeMonad型クラスのインスタンスですから、mMaybeを当てはめればすぐに何をする関数かわかるでしょう。

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
-- またねノシノシ

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

まとめ

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

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

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

←前 次→

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]]

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

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関数をつかって、 次のようなプログラムを書いた時、(<-)の左側の変数、 xygetLineの型からIOが外れた、String型となります。

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

getLine :: IO StringIOMaybeに差し替えた、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_monadmay1may2が「どちらも」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 を使った何か計算 〜

各ハンドの判定処理

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

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)

ストレート・フラッシュ

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

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

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

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

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

それでは、ノシノシ

←前 次→

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セット以上あること

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

  • 連続する番号のカードが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型を付けているのには、straightHintflushHint関数と使い方を揃える意図があります。

実装していく

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

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

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ですが、キングに続く最強のカードでもありますから、 以下の2つの手札は両方ともストレートになるのです。

[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関数の型のmMaybe型に置き換えれば、動かし方はすぐにわかると思います。

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

ストレートを判定する

でもって、ストレートの判定をしていくわけですが、flushHintnOfKindHintの場合と違って、 エースに2通りの解釈が考えられるため、単純に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

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

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検索すればけっこうお目当ての関数が見つかったりするので、このような細々とした道具の扱いには慣れておいたほうが良いでしょう。

これで、2通りの方法で[(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の演習問題の実践みたいな感じになりましたねw

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

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

それではノシノシ

←前 次→

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

はいはいどーも、皆さん進捗どうですか? 毎度おなじみのちゅーんさんですこんにちは。

この記事は、ちゅーんさんの連載エントリ「Haskellでポーカーを作ろう」の第二回目です。

第一回 リストのシャッフルとカードの定義

今回から2〜3回にわけて、ポーカー・ハンドを判定する処理を作っていきます。
若干ややこしい部分も含みますので、一つ一つ確実に理解しながら進めていきましょう。

尚、この記事では各ポーカーハンドの説明は行いません。
↓↓↓覚えてないよーって人は、Wikipediaを見ときましょう↓↓↓

http://ja.wikipedia.org/wiki/%E3%83%9D%E3%83%BC%E3%82%AB%E3%83%BC%E3%83%BB%E3%83%8F%E3%83%B3%E3%83%89%E3%81%AE%E4%B8%80%E8%A6%A7

はじめに

この連載エントリでは、なるべくとっかかりやすい部分から少しづつプログラムを組み立てていきますが、 単に写経して出来上がったものを動かすだけでは、個々のコードの意味を理解するのは難しいかもしれません。

関数型プログラミングのメリットは宣言的である、とよく言われますが、 基本的に関数を一つ、型を一つ定義した段階でコンパイルしたり動かしたりする事が出来るのです。

もし本エントリを読みながら実際に手を動かす場合、コンパイル出来そうな段階では実際にコンパイルしてみて、 動かせそうな単位でGHCiやrunghcを使った動作確認をしてみる事が、Haskellプログラミングを身につける要になるでしょう。

値チェックは型の力を借りるべし

Hands.hsというファイルを作って下さい。 ポーカー・ハンドを判定するための型や関数はこのモジュールに作っていく事にします。

ポーカー・ハンドを判定するにあたって、 カードの枚数は5枚であるべきとか、ソートされていた方が判定しやすいとか、本題に入る前に多少考えるべき事がありますね。

この「カードの枚数が間違いないか判定したり、カードをソートする」処理について、 どのタイミングで実施するかはさておき、何処かで実施する必要がある事は分かってるんですから、作っちゃいましょうか。

decision :: [Card] -> Maybe [Card]
decision l = 
  if length l == 5 
    then Just $ sort l
    else Nothing

Haskellには、部品同士を繋げるための糊が呆れるほど沢山ありますので、 とにかく、必要だと解っている部分は作ってしまうのがポイントです。

ところで、上のdecision関数について、もうちょっと考えてみましょう。 次のような型になっています。

decision :: [Card] -> Maybe [Card]

decision関数の引数の[Card]型と、返り値の[Card]型では少し意味合いが違う事に気が付きませんか?
この関数を通して得られた[Card]型の値は、カードが5枚である事や、ソートされている事が保証されています。 (カードが5枚以外の場合結果がNothingになるため、そもそもソートされた[Card]型の値を得る事ができないですよね。)

にも関わらず、[Card] -> Maybe [Card]という型からその情報が得られないのですが、これって何かもったいない気がしません? もし、この「もったいない」感覚が解るなら、あなたはもう立派なHaskellerですw

「もったいない」感覚を解決するために、次のようなHand型を定義しましょう。

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

データコンストラクタHand[Card]型の値を一つ内包する事が出来るだけですから、 扱える情報は本質的に[Card]と同じですね。(このような関係を同型といいます)

続いてdecision関数を次のようなtoHand関数に書き換えます。

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

この関数の成すことは、本質的ににdecision関数とまったく違いはありません。 しかし、返り値の型がHandになっているだけで、ずいぶんと印象は違って見えますね。

そして、Hand型をエクスポートする際に、データコンストラクタはエクスポートせずに、 代わりにtoHand関数をエクスポートします。
Hand型の値を作成する際にtoHand関数を使う事を強制する事によって、 Hand型が内包するリストが必ず5枚で、ソートされている事が保証されるのです。

module Hands 
  ( Hand
  , toHand, fromHand
  ) where

ここで、toHand関数とfromHandフィールドの型を並べてみましょう。

toHand :: [Card] -> Maybe Hand
fromHand :: Hand -> [Card]

toHandfromHandの意図や使い方は、型定義を見ただけで明らかです。
この例を見るとなんとなく、Haskellerが「型はドキュメントだっ!」なんていう理由が伝わるのでは無いでしょうか。


Haskellの場合、よく知られたオブジェクト指向言語よりも型を作るのがずっと簡単なので、 Hand型のケースのような、ちょっとした条件の保証や、軽い意味付けを与えるためだけに、 新たな型を定義するという事をよくやります。 細かい単位で型の制約を与える事で、プログラマの間違いをコンパイル時に検出して、 しょうもないバグを未然に防ぐ事ができるというわけです。

ポーカー・ハンドの型定義

さて、ここから本格的にハンドを判定するプログラムを書いていきます。

端的に言えば、手札からポーカー・ハンドを返す、次のような型を持つ関数が必要なわけですね。
(引数が[Card]型ではなくHand型になっている事によって、不正な枚数のカードを渡す事ができなくなっていますね。)

pokerHand :: Hand -> PokerHand
pokerHand = ...

あっ、今、ナチュラルに未定義のPokerHandという型名を使いました。
ちょっとへんてこな手順に感じるかもしれませんが、まず欲しい関数の型を書くことで、 どのような型を定義する必要があるのか、整理する事ができるのです。

もし、具体的なPokerHand型をすぐに定義出来そうに無い場合、 以下のようにデータコンストラクタを持たない型を定義し、関数の方はundefinedとする事でひとまずコンパイルできます。

pokerHand :: Hand -> PokerHand
pokerHand = undefined

data PokerHand

詳細が決まっていない箇所をundefinedとしておいて、不要なコンパイルエラーを回避しながら、 型の整合性を整えたり、APIをデザインしたりする事は良くあります。

その際にひとつ注意が必要なのは、 undefinedを評価しようとすると、以下のような実行時エラーが発生するという事です。

*Hands> undefined
*** Exception: Prelude.undefined

そのため、プロダクトの完成時にundefinedが残っているような事のないようにしましょう。

ちなみに、undefinedは評価された時のエラー情報が少なすぎるため、 $notImplementedを使うのがナウい方法みたいです・・・

http://maoe.hatenadiary.jp/entry/20120214/1329211696

が、色々と前準備が必要だったりと、面倒な部分もあるようなので、 開発しているプログラムの規模等によって使い分けても良いかもしれませんね。

とかなんとかいいつつ、今回のPokerHand型の要件は明確なので、とっとと定義してしまいましょう。

data PokerHand 
  = HighCards --ハイ・カード(いわゆるブタ)
  | OnePair --ワンペア
  | TwoPair --ツーペア
  | ThreeOfAKind --スリーカード
  | Straight --ストレート
  | Flush --フラッシュ
  | FullHouse --フルハウス
  | FourOfAKind --フォーカード
  | StraightFlush --ストレート・フラッシュ
  deriving (Show, Read, Eq, Ord, Enum)

例によって、弱いハンドからデータコンストラクタを記述しOrd型クラスのインスタンスにする事によって、 ハンドの強弱の比較が行いやすいようにしておきました。

設計はトップダウン、実装はボトムアップ

はじめに、pokerHand関数の型が、本当にこれで良いかという点について触れておきましょう。

pokerHand :: Hand -> PokerHand
pokerHand = undefined

単純に、ポーカー・ハンドを判定したいだけならこれで良さそうですが、 ポーカーでは対戦相手と同じハンドだった場合、より強いカードでハンド作ったほうが勝ちになります。

例えば、以下の2つのハンドはどちらもツーペアですが、 ①はキング、②はジャックがそれぞれハンドを構成する最強のカードなので、①の勝ちになります。

①[S3_,C8_,S8_,HK_,DK_] -- DK_ 勝ち"
②[H2_,S2_,HJ_,DJ_,CK_] -- DJ_ 負け"

そのため、ハンドの種類と一緒に、そのハンドを構成する最強のカードを一緒に返却出来ると良さそうです。

pokerHand :: Hand -> (PokerHand, Card)
pokerHand = undefined

さて、手続き的なプログラミング言語に慣れていると、 いきなりこのpokerHand関数の中身を書きに行きたくなってしまいますが、 あまり大きな所からいきなり手を付けはじめると、最終的にカオスなプログラムになったり、 そもそもコンパイル出来なかったりという状態に陥る可能性があるのです。
(手続きプログラムだとそうならない、というわけでは無いですが。 その、誤魔化しが効きやすいというか・・・)

というわけで、問題をもう少し小さな単位に切り分けましょう。
どのように組み合わせるかはさておき、 各ポーカー・ハンドを判定する処理が必要なのは、間違いなさそうです。

例えば、ツーペーアだったら、次のような感じです。

-- 引数がツーペーアだったら `Just (TwoPair, 最強カード)`という値を、
-- そうで無い場合は `Nothing` を返す。
twoPair :: Hand -> Maybe (PokerHand, Card)
twoPair = undefined 

こんな感じで、ひと通りのポーカー・ハンド分の関数を定義します。

straightFlush :: Hand -> Maybe (PokerHand, Card)
straightFlush = undefined

fourOfAKind :: Hand -> Maybe (PokerHand, Card)
fourOfAKind = undefined

fullHouse :: Hand -> Maybe (PokerHand, Card)
fullHouse = undefined

flush :: Hand -> Maybe (PokerHand, Card)
flush = undefined

straight :: Hand -> Maybe (PokerHand, Card)
straight = undefined

threeOfAKind :: Hand -> Maybe (PokerHand, Card)
threeOfAKind = undefined

twoPair :: Hand -> Maybe (PokerHand, Card)
twoPair = undefined
  
onePair :: Hand -> Maybe (PokerHand, Card)
onePair = undefined

いずれも同じような目的をもった関数ですね。 このような場合、可能であれば全て同じ型になるように定義することで、 あとで一纏めに扱える可能性があります。

実際、最終的にこれらの関数を上手く繋げてpokerHand関数を作成するわけですが、 その話はまた後の回で行う予定です。


さて、だんだん全体図が見えてきました。
徐ろに「ポーカー・ハンドを判定せよ」と言われてもどうすれば良いか困ってしまいますが、 役の一つ一つの判定だったら、既に知っているリスト処理を頑張ればどうにかなりそうです。 (ストレート・フラッシュやフルハウス等、 判定が複雑になりそうな関数もありますから、もう少し掘り下げが必要ですが)

このように欲しい関数の型を並べていくことによって、 「上から下に」型を設計していけば、徐々に目的の関数を実装するための道標が見えてきます。 そして、具体的な実装がイメージしやすい粒度まで掘り下げる事ができたら、 今度は「下から上へ」と中身を作りこんでいけば良いのです。

「設計はトップダウン」「実装はボトムアップ
この方法が常に最善手というわけではありませんが、Haskellプログラミングにおける、良いヒントになるでしょう。

まとめ

今回は、ポーカー・ハンドを判定するプログラムの前編という事で、関数の型を定義して行きました。

実装の前に型定義を行う事によって、全体のイメージを掴む事ができるというのも、本エントリの重要な所ではあります。
しかし、それよりも、本エントリではHand型のtoHand関数を定義して以降、型を定義しただけで実装については何も触れていないという事に注目してください。にも関わらず、皆さんは今後の開発の進め方や実装方法等について色々とイメージする事ができたはずです。 このことから、「Haskellの型は実に多くの情報を持っている」という感覚が、少しでも伝われば幸いです。

ところで、本エントリで紹介しているプログラムは、一旦動く所まで書き上げたものを、 冗長な部分を修正したり、より読みやすくリファクタリングする事で、現在の形に落とし込んだものです。
大雑把な手順に違いはありませんが、型設計はあくまで「下書き」の段階であり、 熟練したHaskellプログラマでも、いきなり完璧な設計が出来るわけではありません。 もしご自身のプロジェクトで上手く設計出来なくても気を落とさずに、少しづつ感覚を掴んで行けば良いと思います。

と、なんとなく色々とポエムってしまいましたが、 ポーカー開発エントリの第二回は、お楽しみいただけたでしょうか。

次回から、今回undefinedとした部分を具体的に実装していくフェーズに入ります。 その際にMaybeモナドの話をしますので、焦らずにゆっくり進んでいきましょう。

それではノシノシ

←前 次→