Haskellでブラックジャックを作ってみた

# はじめに

1年弱くらい前からHaskellをほそぼそと勉強しています。
何かにつけてHaskellで何か作れないかと思っていたところ、[プログラミング入門者からの卒業試験は『ブラックジャック』を開発すべし](https://qiita.com/hirossyi73/items/cf8648c31898216312e5)という記事を見つけたのでGWを使って挑戦してみました。

ルールなどは上記リンクの記載に従います。また追加でAは1もしくは11として扱えるようにしてみました。

ソースコードはGitHubにおいてあります。→ https://github.com/amderbar/hjack


# 実行イメージ

ターミナルからコマンドで実行します。

```
$ stack exec hjack-exe
ディーラーの初期手札（2枚のうち片方）：
 Q

現在のあなたの手札：10, K
どうしますか？ Hit/Stand
Stand                  # <- 標準入力を待ち受け

結果：
あなたの手札：10, K
ポイント合計：20

ディーラーの手札：5, 6, Q
ポイント合計：21

ディーラーの勝ち
```

# 実装の詳細

## カードの型

カードの処理は、自分でなんとなく考えたものに加えて[こちらの記事](http://tune.hateblo.jp/entry/2015/05/12/023112)を参考に作りました。

スートは不要なので省き、ランクを`Enum`にしました。
さらに`Show`型クラスのインスタンスを自分で実装することで、表示を整えています。

```Haskell:Lib.hs
data Card = CardA | Card2 | Card3 | Card4 | Card5
            | Card6 | Card7 | Card8 | Card9 | Card10
            | CardJ | CardQ | CardK
            deriving (Eq, Ord, Enum)

instance Show Card where
    show CardA = "A"
    show CardJ = "J"
    show CardQ = "Q"
    show CardK = "K"
    show card  = show $ fromEnum card + 1
```
`Int`を型引数に取るようにしなかったのは、ランクも13個しかないことをはっきりさせたかったから。

デッキはカードのリストとして表現しています。
構築は同じランクのカードを4枚ずつ入れるということでこんな感じ。これで4×13計54枚分のカードリストの出来上がりです。

```Haskell:Lib.hs
type Deck = [Card]

allCards :: Deck
allCards = concatMap (replicate 4) [CardA ..]
```

## カードのシャッフルについて

カードのシャッフルは`random-shuffle`パッケージの`System.Random.Shuffle`モジュールから`shuffleM`関数がやりたいことそのままズバリなのでこれを使用しました。
（本当はカードのシャッフルも自分で実装したほうが練習にはなったのでしょうけれど……）

## 点数の計算について

カードごとの点数はそれ用の関数を定義しました。
Aが1と11のどちらになるか非決定的なので、返り値はリストモナドにしました。

```Haskell:Lib.hs
cardValue :: Card -> [Int]
cardValue CardA = [1, 11]
cardValue CardJ = [10]
cardValue CardQ = [10]
cardValue CardK = [10]
cardValue card  = [fromEnum card + 1]
```

手札もデッキ同様カードのリストとして表現します。

そして手札にあるカードの点数を元に手札の点数を計算するわけですが、上述の通りカードの点数は非決定的です。
なので、点数の「強さ」も定義し、その手札で可能な点数のうち「強さ」が最大になる点数を実際の点数として採用しています。

```Haskell:Lib.hs
type Hands = [Card]

countHands :: Hands -> Int
countHands hands = snd $ maximum $ map (\c -> (powerHands c, c)) $
        foldl (liftM2 (+)) [0] $ map cardValue hands

powerHands :: Int -> Int
powerHands handsCount
    | handsCount > 21 = 0
    | handsCount <  1 = 0
    | otherwise       = handsCount
```

### この計算の問題点

ただこの計算には問題がありまして、Aの点数の扱いが本来のルールとは違っています。

この記事の作成中に気づいたのですが、もし手札に複数枚のAがある場合、手札の強さを最大化するように各Aの得点が割り振られてしまうのです（一方のAは1、もう一方のAは11として扱われる場合がある）。

最初はこれでいいと思っていたのですが、ふと気になってルールを調べなおしてみると、違いますね……。

結構いろいろ本を読み返したりして頑張って作った部分だけにすぐ直す気にはなれずそのままにしてあります。
気が向いたら修正します。

## ゲームの進行について

下準備はこれくらいで、いよいよゲームの本体を作っていきます。

まずゲーム中の場の状態を保持するデータ型をとりあえず定義してみました。場はプレイヤーとディーラーのそれぞれの手札と、山札によって構成されています。

```Haskell:Lib.hs
data Field = Field
    { playerHands :: Hands
    , dealerHands :: Hands
    , fieldDeck   :: Deck
    }
```

ゲーム自体は

1. 場を初期化するアクション
2. 場を発展させるアクション
3. 場の最終的な状態から勝敗を判定するアクション

という3つの要素から成り立っているものと考えました。

また場を発展させるアクションは

1. プレイヤーによる操作で発展する
2. ディーラーによる操作で発展する

という2種類があります。

したがってゲームの実行アクションは次のような形になりました。

```Haskell:Lib.hs
play :: IO ()
play = initField
        >>= printInitialField
        >>= playerTurn
        >>= dealerTurn
        >>= gameResult
    where
        printInitialField field = do
            putStrLn "ディーラーの初期手札（2枚のうち片方）："
            putStrLn $ ' ' : show (head (dealerHands field))
            putStrLn ""
            return $ Right field
```

※`printInitialField`で場を`Right`でくるんでいる理由は後で出てきます。

### 場を初期化するアクション

場の初期化は

1. 必要な枚数のカードを揃えて山札を作る
2. 山札をシャッフルする
3. 山札の先頭から4枚を取って初期手札として配る

という手順です。シャッフルするところで`IO`が付きます。

```haskell:Lib.hs
initField :: IO Field
initField = deal <$> shuffleM allCards
        where
            deal (c1:c2:c3:c4:cards) = Field
                { playerHands = [c1, c3]
                , dealerHands = [c2, c4]
                , fieldDeck = cards
                }
```

### 場の状態を発展させるアクション

場の状態を発展させる2つのアクションは、上では分けて書きましたし実際べつべつに作りましたが、基本的な構造は同じです。つまり、

* 山札の先頭からカードを一枚引いて自分の手札に加える
* 条件を満たすまで上の操作を繰り返す

というふうになっています。
操作の終了条件は、

* 山札がなくなった場合
* バーストした場合

という二つは共通していて、個別のものが一つずつです。

* [プレイヤー] スタンドした場合
* [ディーラー] 手札の得点が17を超えた場合

また終了条件のうち共通する二つに当てはまる状況では、それ以上場を発展は行わずに勝敗判定に飛ぶ必要があります。

と、ここまでわかっていながらうまいこと抽象化できず……実際に出来上がったのは以下のコード。

```haskell:Lib.hs
draw :: Deck -> (Maybe Card, Deck)
draw []       = (Nothing, [])
draw (c:deck) = (Just c, deck)

isBust :: Int -> Bool
isBust = (> 21)

playerTurn :: Either Field Field -> IO (Either Field Field)
playerTurn = either whenError whenNormal
    where
        whenError = return . Left
        whenNormal field = do
            let hands = playerHands field
            let count = countHands hands
            putStrLn $ "現在のあなたの手札：" ++ showHands hands
            if isBust count then do
                putStrLn "バーストしました。"
                return $ Left field
            else do
                let (maybeNextCard, nextDeck) = (draw . fieldDeck) field
                maybe whenDeckEmpty (whenDeckRemain nextDeck) maybeNextCard
                where
                    whenDeckEmpty = do
                        putStrLn "もう山札がありません。"
                        return $ Left field
                    whenDeckRemain nextDeck nextCard = do
                        putStrLn "どうしますか？ Hit/Stand"
                        input <- map toLower <$> getLine
                        case input of
                            "hit" -> let hands = playerHands field
                                        in playerTurn $ Right field
                                            { playerHands = nextCard : hands
                                            , fieldDeck = nextDeck
                                            }
                            _     -> return $ Right field


dealerTurn :: Either Field Field -> IO (Either Field Field)
dealerTurn = either whenError whenNormal
    where
        whenError = return . Left
        whenNormal field = do
            let hands = dealerHands field
            let count = countHands hands
            if isBust count then do
                putStrLn "ディーラーがバーストしました。"
                return $ Left field
            else do
                let (maybeNextCard, nextDeck) = draw $ fieldDeck field
                maybe whenDeckEmpty (whenDeckRemain nextDeck) maybeNextCard
                where
                    whenDeckEmpty = return $ Left field
                    whenDeckRemain nextDeck nextCard = do
                        let hands = dealerHands field
                        let count = countHands hands
                        if count < 17 then
                            dealerTurn $ Right
                                field{dealerHands = nextCard : hands, fieldDeck = nextDeck}
                        else return $ Right field
```

まとめると以下のことをしています。

* 山札からカードを引く操作は`draw`関数として定義した（山札がまだあるかどうかのチェックにもなっている）
* 共通条件で終了する場合は`Left`、個別条件で終了する場合は`Right`でそれぞれくるみ、違いを表現
* ディーラー操作では`Left`を受け取った場合操作をスキップして、受け取った場をそのまま次に渡す
    * プレイヤー操作もそれと構造が同じになるように変更
    * そのため場の初期化直後の場を`Right`でくるむ必要があった

### 場の最終的な状態から勝敗を判定するアクション

ここはとくに複雑なことはしていないです。

1. 受け取った場の状態から各々の手札の点数を計算して表示
2. 手札の点数から勝敗を判定して表示

といった感じ。

勝敗の判定には上でも出てきた点数の「強さ」を使っています。実は点数の「強さ」は最初はここのために導入したものだったりします。

実際のコードは省略。

# 課題的なもの

上述のルール的に間違っている点を除いて、今思っていること。

* `playerTurn`と`dealerTurn`はもっとなんとかしたい。
* 場の発展アクション中で`Either`はモナド変換子で使うほうがいい？
* 場の状態を保持するのは`State s`モナドを使うほうがいい？

# 作ってみての感想

とりあえず作って一応動くことを確かめたものの、書いたものが全体としていいのか悪いのか、自分じゃイマイチ評価できないのがなんとなくもやっとしたところ。

ただ作ってる最中にいろいろ調べたり本読み返したりすることになって、まだまだ身についてないことはよくわかりますね。

とりあえず調べてる時によくわからなくて別の方法でとりあえず別の方法で済ませた部分とかを、もっとHaskellっぽく書けるようにやってみるといいのかなと思っています。

あと、やっぱり単なる練習のための問題を解くよりも、こういう出来上がったあと実際に使えそうなものを作るほうが楽しいですね。