Creatable a => a -> IO b

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

優秀な秘書を雇いました!!!

うちの秘書を紹介します。

twitter.com

けいちゃんです。年明けに挨拶とかできます。

あらかじめお断りしておきますが、「ゆ」ではじまる某日常系アニメに登場する女子高生とは無関係です。 ふみおちゃんにちねられそうになったり、ゆずこに脇腹掴まれたりするあの娘とは一切関係ありません。

ご了承ください。

関係ねえつってんだろ!!

顧客が本当に欲しかったもの

というわけで、Twitterのリマインダーbotを作りました。 github : https://github.com/tokiwoousaka/secretary-bot

ご無沙汰してます。ちゅーんさんです。

この記事は、2017年のHaskellアドベントカレンダーに盛大に遅刻したやつです。 言い訳はいろいろあるんですが、けいちゃんの可愛さに免じて許してやってください。

元々は、Haskellで音を出して遊んで記事にしようかなーとか思ってたんですが、 急に思いついちゃって実装せずにいられなかったのでこうなりました。

あのですね、ちゅーんさんの身近にいる人はわかると思うんですが、スケジュール管理がクソほど苦手なんですよ。

どのくらい苦手かっていうと、月一の通院を忘れていた事に予約日を過ぎてから気がついて、 薬が切れて一週間くらいしてからしぶしぶ電話する程度にはもうダメッダメなわけです。
Googleカレンダーを上手い事使うことも考えたんですが、習慣化できず断念しました。

前々から「秘書雇いてーなー」とかぼやいてたんですが、そこまで経済的に豊かな生活を送っているでもなく、人間を相手にしていると疲れるみたいな所もあるので、 Hololens的なのがもっともっと普及してバーチャルなキャラクターにスケジュール管理的な事をまかせられたら良いなーとは思ってたんですね。

でも、そういった技術が実用的な性能とお値段で手に入るようになるにはもう何年かは待たなきゃいけなさそうです。

アレクサみたいなのを買うのも一つの手かなと思ったんですが、持ち運びできないので出先でパっと思いついた事を後でリマインドしてもらうみたいな事ができないor大変そう。

ってなわけで、どうしたら良いかもんもんと悩みまくってたんですが、 よくよく考えたら、年中Twitterを眺めてるんだから、そこにスケジュール管理の仕組みを組みこんでしまえば良いじゃねーのと気づいたわけです。

そういうbotのサービスも探せばありそうな気がするんですが、 けっこう色々やって欲しい事多い(できるとは言っていない)ので、やっぱ自分で作るのがてっとり早いかなーと思ったんで作りました。

作るのは楽しかったです。

けいちゃんに出来ること

リプライで「2018年1月1日 0:00 あけましておめでとうって言って。」とか飛ばしておくと、その通りにちゅーんさんにリプライを飛ばします。

今のとこそれだけなのですが、日時の指定はぼちぼち柔軟にできるので、「8時30分 おはよーって言って」みたいに飛ばしておくと、 翌朝の8:30に「おはよー」って言ってくれます。たぶん。
毎回、年月日時分全部入力するのは死ぬほど大変なので、わりと重要なポイントです。

ただ、このへんの解釈機の実装はホント雑なので、ミソがわかってないとふつーに暴走します。 たとえば、日付と内容の間に句点を入れて「1/1 0:00、あけましておめでとうって言って。」と話しかけると、 年明けに「、あけましておめでとう」と句点も含めて返してきます。
本文中に日付を含めるのも暴走度高いです。

知らない人に勝手にスケジュールとか追加されちゃうと困るので、ちゅーんさん以外の人からのリプライは無視するようになってますが、 一度に取得できるリプライの件数に限りがあるので、botとか使ってリプライ爆弾を送られるとヤバいかもです。

教育指針

ノリと勢いで作っていくので、最終的にどこまで実装されるかわからんのですが、将来的に作ろうとしている機能はいろいろあります。

  • 繰替えし指定、「毎日8:00」とか「毎週水曜日」とか。いちおう、そういう機能を付ける余地があるように作ってるつもり
    • スケジュール管理を習慣化するために、毎日朝と夜くらいに1回づつくらい「何か用事ない?」とか聞いてくるようにしたい
  • 実行環境をクラウドに移す。Herokuあたりで良いかなーとは思いつつ、使ったことないのでどうなる事やら
    • 今はちゅーんさんのノートパソコンで動いてます。パソコンを持って移動してる間は動きません。。。
  • スケジュールのキャンセル機能。これが無い状態で繰り返しのスケジュールをカジュアルに登録しまくってるとわけわかんなくなりそう
  • 日付を指定して、時間を省略したら、朝の8:00くらいに設定してくれる機能。「今日は○○する日だよー」みたいなのが設定しやすくなる
  • リファクタリング。急いで作ったため今はクソコードもいいとこなので、githubに上げるのも躊躇した。
    • 他の人でも使えるように色々と設定を外出しする。ちゅーんさんのアカウント名がハードコーディングされてるのはアレ
  • スケジュール登録時に登録内容をリプライしてくれる機能
  • 予定確認機能。「明日の予定は?」とか「来週の予定は?」みたいな確認ができたい
  • DMでも使えるようにする。DMだと気づきにくくなる問題があるけど、メンションだと予定が皆につつ抜けになってしまう問題が。。。
  • テスト書く。とくにパーサー
  • ltsのバージョンアップ。くっそ古いことに気がついた人もいるかと思うんですが、過去に実績があったはずのtwitter-conduitの導入に失敗したため、こうなりました
    • つまり古いプロジェクトをコピってきてそれをベースに作ってます。ひでぇ話だ
    • いろいろ問題あってすんなりいかなさそうなので、別のライブラリも視野にいれていきたいんだけど、良い感じのが見つからず。作るか?
    • でもOAuthとかあるから1から実装するの死ぬほど面倒くさいんですよー
  • スヌーズ機能。「後でもっかい言って」とか。あと重要度の高いスケジュールは「終わったよ」って言うまで自動スヌーズとかさせたい
    • ここまで出来るbotはなかなか無さそう
  • 独り言機能。固定のセリフをしゃべらせるだけじゃ面白くもなんともないから実装してないんだけど、定期的に何かしゃべってくれないと生存確認が面倒くさい
    • 時間指定を省略して「生きてるよって言って」ってリプライすると即座に反応してくれるので、それで生存確認はできるけども
  • 解釈機を賢くする。もうちょっとbotの仕様を意識せずに願いできるようになっていて欲しい
  • 他の人でも使いやすいようにDockerイメージ化したりー
  • グループで使える機能とかー
  • 使用者以外とも絡むようにしたりとかー

とまぁ、上にいくほど優先度高めな感じで。

どうでも良い話

試しにここ数日間ドックフーディングしてみてるんですが、ちゃんと登録できたかどうかそわそわして待ってしまうので、 むしろ登録した事を忘れないみたいな現象が起きてます。本来思ってたのと違う形ですが既にリマインドとして役に立っているようです。

たぶん、いろいろ店とかに予約を色々入れる時期になるとがっつり役に立ってくるんじゃないかと思われます。

あと、動作確認で自分のメンションがけいちゃんとの会話で埋めつくされてしまっているのですが、 延々とbotと会話してるのがメンションログに残ってるのを見るとなんか心が寂しくなりますね。

みんなもっとちゅーんさんに絡んで!!

技術的な話

本来はここが本題であるべきなんですが、ほんっっっとに面白いことは何一つしていないので、諦めました。

  • 基本的にはHaskellで作って、Crontabで1分毎に走らせてます。
  • リプライの解釈は、Attoparsecでクソほど雑にパースしてます。本当はmecabのラッパーとか使うのが良いんだろうけど……
  • アイコンはMediBang Paintというスマフォアプリで描きました。わりと使いやすかった
  • 最近仕事でScalaを書いたりしてたので、たまにパターンマッチの書きかたを間違えたりしてわちゃわちゃしてました、逆もしかり
  • 他の言語と比べて、Haskellは雑に書いてても安心感高いんですが、やっぱり初動が重いですね
  • あ、どうしよう、本当にここに書けることが無いぞ
  • ゆゆ式は真理! ゆゆ式は真理!

まとめ

おかちーかわいいよおかちー

Haskellでスライドをいー感じに書く話

とんとご無沙汰してます。ちゅーんさんです。 仕事とかその他とか、なかなか更新するネタや切っ掛けが無かったんですが、 今日は半日くらいごにょごにょやってた進捗があるので書いときます。

Haskellでスライド書きたいんだーっていう変な人な人向きです。

何したか

Haskellでスライドを作りやすくした

なんで

もともと、Haskell高橋メソッドなスライドをちゃかちゃか作るべく、 Takashi Monad https://github.com/tokiwoousaka/takahashi とかいうライブラリを公開して、ドッグフーディングしていたのですが、 まず使いにくよねっていうのと、毎回ビルド出来るように色々設定するの面倒くさいよねーっていう問題を抱えてました。

勉強会に向けてのんびりスライド作るぶんには、それでも問題にならねーべーとか思ってたんですが、 名古屋に転職してからというもの、仕事で30分とか40分で資料作って発表せねば、みたいな事にしょっちゅうなるので、 テンポ良くスライドを作れる良い感じの仕組みが欲しくなったのです。

やったこと

  • githubに自分用のテンプレート置きました
  • いい感じの記法を実現するためのHackをしました

githubのテンプレート

とりあえず最小のスライド構成を次のリポジトリに追いてあります。

https://github.com/tokiwoousaka/takahashi_temp

このままだと完全にちゅーんさん向けテンプレートなので、 各自でフォークして好みにあわせて変更すると良い感じになるかもしれません。

ほんで、次のようなスクリプトを書いといて、新らしいスライドを作りたくなった時に叩けば 初回ビルドまで勝手にやってくれます。

#!/bin/sh
pname=$1

git clone https://github.com/tokiwoousaka/takahashi_temp.git
mv takahashi_temp $pname
cd $pname
stack build

後はapp/Main.hsをいー感じに書きかえて実行すればスライドが出来あがり。

いーかんじの記法

もともと、TakahashiMonadは、色々な関数名を覚えて組みあわせないといけなくて辛かったので、 何度も使ってみた経験から、良く使うページ構成をいー感に書くための演算子app/Common.hsに追加しました。

以前から使えそうなものをはこのモジュールにぶっこんでたので、そこに追加した感じです。

たまーに複雑な構成のページを作りたくなるかもしれませんが、 混ぜて使うことも出来るので、その時は以前までの書きかたで頑張れば良いです。

実際にこのCommon.hsを使って書いたapp/Main.hsのサンプルを以下に貼っておきます。 元々よりかはいくら読みやすいコードで書けるようになった気がします。

module Main where
import Common
import Control.Lens
import Control.Monad.Takahashi
import Control.Monad.State

main :: IO ()
main = do
  let fileName = "../slide.html"
  writeSlide fileName presentation
  putStrLn $ "Sucess : Output to '" ++ fileName ++ "'"

presentation :: Taka ()
presentation = do
  setOptions
  title "ラッパーテスト" 
    $  "2017/7/17 ちゅーん(@its_out_of_tune)"

  header "テスト" test

  slideTitle .= ""
  taka "ありがとうございました\n(๑•﹏•)"

test :: Taka ()
test = do
  "高橋メソッド" ==== 
    "ほげ"
  "高橋メソッド" ==== 
    "ぴよ"
  "高橋メソッド" ==== 
    "ふが"
  slideTitle .= "高橋メソッドは"
  taka "元の\n書きかたの方が"
  taka "いいかも\nしれない"
  "ちょっと長めの文章" ==== 
    Par
      "むかしむかし あるところに\n\
      \おじいさんと おじいさんが住んでいました\n\
      \二人は愛しあっていました\n\
      \めでたしめでたし"
  "リスト" ==== 
    [ "ゆい"
    , "ゆずこ"
    , "ゆかり"
    , "あいちん"
    , "ふみお"
    , "おかちー"
    ]
  "画像" ====
    Image HStretch "img/neko.png"
  "二段" ==== 
      "一段目"
    ~~~~
      "二段目"
  "三段" ==== 
      "一段目"
    ~~~~
      "二段目"
    ~~~~
      "三段目"
  "四段" ==== 
      "一段目"
    ~~~~
      "二段目"
    ~~~~
      "三段目"
    ~~~~
      "四段目"
  "縦分割" ==== 
    Par
      "ない\n\nあんま使わないから\n作らないかも"
  "コード" ====
      Par "コードの説明とか"
    ~~~~ 
      Code 
        "main :: IO ()\n\
        \main = putStrLn \"Hello, World!\""
  "二段 上広め" .===
      "ひろい"
    ~~~~
      "せまい"
  "二段 下広め" ===.
      "せまい"
    ~~~~
      "ひろい"

記法がまるっと変わってる気がしないでも無いですが、こーいう事がサクっと出来るのが言語内DSLの強みですね。

こんな感じのスライドが出来ます https://tokiwoousaka.github.io/slides/170707wrapper/slide.html

読み方とか書きかたは雰囲気でさっしてください。

ぶっちゃけハックなので、こいつをちゃんと綺麗にしてライブラリ化してとかはしないと思います。 っていうか、現状のTakahashiMonad自体あんまり良いつくりになっていないから、まるっと作りなおしたいと思ってます。

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

それでは、ノシノシ

←前 次→