はじめに
Qiitaのプログラミング入門者からの卒業試験は『ブラックジャック』を開発すべしを読んで、ふむふむなるほど、ブラックジャックが初心者向け課題として非常に面白いな〜と思いたち、プログラミングに挑戦してみました。一応、ちゃんと動作するようになったと思います。
ブラックジャックのルールなどは、上記リンクを参照ください。Aを1もしくは11として扱います。スピリットやダブルダウンなどは考えていません。
プログラミング言語はHaskellです。まだまだ勉強中で未熟ですが、今の時点での地力を残すという意味でも記事にしてみました。
** 2018/05/06追記 この記事の続編をこちらに書きました。
工夫したところ
なるべく純粋関数で書いて、IOを伴う処理はMonadで、、、と意識していたのですが、なかなか思うように実装出来ずに苦労しました。
カードについて
カードの処理は、最初いろいろやってたのですが、結局のところこちらの記事を参考にさせてもらいました。ほぼ丸写しですが、これが分かりやすかったので、、、
カードは、マークについてはEnumで、数はIntで1,2,3,...,13として扱い、表示時にA,J,Q,Kにしました。
data Suit = Spades | Hearts | Clubs | Diamonds deriving Enum
instance Show Suit where
show Spades = "スペード"
show Hearts = "ハート"
show Clubs = "クラブ"
show Diamonds = "ダイア"
data Card = Card { suit :: Suit, num :: Int }
instance Show Card where
show Card { suit = s, num = n } = (show s) ++ "の" ++ rank
where rank = case n of
11 -> "J"
12 -> "Q"
13 -> "K"
1 -> "A"
x -> (show $ x)
デッキを作るのは、内包表記とか使えば分かりやすくて良かったのですが、そういった便利な方法を知らなかったため、foldrとmapを組み合わせました。こちらの方が汎用性もあるので、これがいいかなと。
allCards = foldr (++) [] $ map (\x -> map (\y -> Card { suit = x, num = y }) [1..13]) [Hearts ..]
カードのシャッフルについて
カードのシャッフルのみ、乱数を使うため、唯一 main関数以外でIOの処理が入っています。（あ、後述するwhileMもmonad使ってますね、、、)
shuffle :: [a] -> IO [a]
shuffle [] = return []
shuffle list = do
n <- getStdRandom $ randomR (0, length list - 1) :: IO Int
list2 <- shuffle $ take n list ++ drop (n+1) list
return $ (list !! n) : list2
この関数は、こちらで載ってたものをそのまま採用させていただきました。シンプルで分かりやすい！
が、よく考えたら、ランダム関数を外から与えてシャッフルする方が汎用性が高かったかもしれないですね。そうすればこの関数もIOに依存しなくなりますし、、。でも、これはこれでシンプルで良い感じなので、とりあえずこのまま使います。
得点の計算について
これは単純に、Aを1として計算するのと、Aを11として計算するのを両方行い、前者が21を超えていたら後者を採用するということにしました。(元記事に書いてある通りです）
scoreNaive :: [Card] -> Int
scoreNaive cards =
foldr (+) 0 $ map (\card ->
let n = num card in if n <= 10 then n else 10
) cards
scoreWithAce10 :: [Card] -> Int
scoreWithAce10 cards =
foldr (+) 0 $ map (\card ->
let n = num card in case n of
1 -> 11
x | x <= 10 -> x
_ -> 10
) cards
score :: [Card] -> Int
score cards =
let s1 = scoreNaive cards
s2 = scoreWithAce10 cards
in if s2 > 21 then s1 else s2
プレイヤーについて
元記事 ではC#なので、プレイヤーを親クラスとして実装し、ユーザープレイヤーとディーラー（コンピュータプレイヤー）をその子クラスとして実装することが提唱されていました。
Haskellは関数型言語なので、クラスを作る代わりに、プレイヤーをレコード型で次のように宣言しました。
data Player = Player { playerName :: String,
playerHands :: [Card] }
また、プレイヤーの共通機能である「カードを一枚めくる」機能をplayerDrawCard関数としてくくり出しました。
playerDrawCard :: Bool -> [Card] -> Player -> ([Card], Player, String)
playerDrawCard flagShow deck player =
let
name = playerName player
hands = playerHands player
(newDeck, newHands) = drawCard deck hands
message = if flagShow then (messageForDraw name newHands) ++ "\n" ++ (messageForScore name newHands) ++ "\n"
else (messageForDrawHide name newHands) ++ "\n" ++ (messageForScoreHide name) ++ "\n"
in (newDeck, Player { playerName = name, playerHands = newHands}, message )
この関数は、めくったカードを表示するかどうかのフラグと、デッキ、そしてプレイヤーを引数にとります。そして、工夫した点としては、この関数自体は純粋関数とし、戻り値に、めくった結果表示されるべき文字列を含ませるようにしました。
実際にめくる時は、めくった結果を表示する必要があるため、純粋関数ではなくなってしまいます。(正格に言えば純粋関数ですが、IO monadを扱う関数になってしまう）それらは、main関数内で定義した次を呼ぶようにしました。
let playerDrawCardWithMessage = \(deck, player) -> do
let (deck', player', message) = playerDrawCard True deck player
putStrLn message
return (deck', player')
let playerDrawCardWithMessage' = \(deck, player) -> do
let (deck', player', message) = playerDrawCard False deck player
putStrLn message
return (deck', player')
上がめくったカードを表示する関数で、下がめくったカードを表示しない関数（ディーラーの2枚目のカードをめくる時にだけ使用）です。
プレイヤーの追加のカードのめくる処理について
ここが、今回一番工夫した点（！）ですが、ユーザープレイヤー、ディーラーともに、特定の条件を満たすまでカードをめくりつづける処理です。その条件は、
- ユーザー：バーストするか、「もう一枚引きますか？(y/n)」の問いでnを選択するまで
- ディーラー：バーストするか、得点が17以上になるまで
となっており、特にユーザーの方は入力を伴うので、IOが必要になります。それで結構悩んだのですが、結局のところ、条件を満たすまで繰り返す次の関数whileMを定義して、条件はユーザー、ディーラーごとに与えることで解決しました。
whileM :: (Monad m) => (a -> m a) -> a -> (a -> (m Bool)) -> m a
whileM f ini checker = do
b <- checker ini
if b
then f ini >>= \y -> whileM f y checker
else return ini
引数は、「繰り返す関数」「初期値」「条件」です。いわゆるJavaやRubyなどのwhile文みたい機能が欲しくて実装しました。（すでにありそうなメソッド名ですね、、。）
これを使って、ユーザーがカードを引いていく処理は
(deck, humanPlayer) <- whileM playerDrawCardWithMessage
(deck, humanPlayer) $ \(deck, player) -> do
if checkBust $ score $ playerHands player
then return False
else do
putStr "もう一枚引きますか？ (y/n):"
s <- getLine
if "Y" == map toUpper s
then return True
else putStrLn "" >> return False
となり、ディーラーがカードを引いていく処理は
(deck, comPlayer) <- whileM playerDrawCardWithMessage
(deck, comPlayer) $ \(deck, player) -> do
let s = score $ playerHands player
if checkBust s
then return False
else do
if s <= 16
then return True
else return False
のようにまとめられました。
最初の頃、この辺の処理がすごく長くなってしまい、しかも、ユーザーとディーラーで共通部分をうまくまとめられず同じようなコードが続いてしまっていたのですが、なんども書き直して、ようやくこの形になりました。
プログラム全文
module Card where
import Control.Monad
import System.Random
import Data.Char
data Suit = Spades | Hearts | Clubs | Diamonds deriving Enum
instance Show Suit where
show Spades = "スペード"
show Hearts = "ハート"
show Clubs = "クラブ"
show Diamonds = "ダイア"
data Card = Card { suit :: Suit, num :: Int }
instance Show Card where
show Card { suit = s, num = n } = (show s) ++ "の" ++ rank
where rank = case n of
11 -> "J"
12 -> "Q"
13 -> "K"
1 -> "A"
x -> (show $ x)
allCards = foldr (++) [] $ map (\x -> map (\y -> Card { suit = x, num = y }) [1..13]) [Hearts ..]
shuffle :: [a] -> IO [a]
shuffle [] = return []
shuffle list = do
n <- getStdRandom $ randomR (0, length list - 1) :: IO Int
list2 <- shuffle $ take n list ++ drop (n+1) list
return $ (list !! n) : list2
drawCard :: [a] -> [a] -> ([a],[a])
drawCard deck cards =
let x:xs = deck
in (xs, cards ++ [x])
scoreNaive :: [Card] -> Int
scoreNaive cards =
foldr (+) 0 $ map (\card ->
let n = num card in if n <= 10 then n else 10
) cards
scoreWithAce10 :: [Card] -> Int
scoreWithAce10 cards =
foldr (+) 0 $ map (\card ->
let n = num card in case n of
1 -> 11
x | x <= 10 -> x
_ -> 10
) cards
score :: [Card] -> Int
score cards =
let s1 = scoreNaive cards
s2 = scoreWithAce10 cards
in if s2 > 21 then s1 else s2
data Player = Player { playerName :: String,
playerHands :: [Card] }
messageForDraw :: String -> [Card] -> String
messageForDraw name cards =
name ++ " " ++ (show num) ++ "枚目のカードは" ++ (show newCard) ++ "です。"
where newCard = last cards
num = length cards
messageForDraw' :: String -> [Card] -> String
messageForDraw' name cards =
name ++ " " ++ (show num) ++ "枚目のカードは" ++ (show newCard) ++ "でした"
where newCard = last cards
num = length cards
messageForDrawHide :: String -> [Card] -> String
messageForDrawHide name cards =
name ++ " " ++ (show num) ++ "枚目のカードは秘密です。"
where num = length cards
messageForScore :: String -> [Card] -> String
messageForScore name cards =
name ++ "の現在の得点は" ++ (show $ score cards) ++ "です。"
messageForScoreHide :: String -> String
messageForScoreHide name =
name ++ "の現在の得点は秘密です。"
messageForFinalScore :: String -> [Card] -> String
messageForFinalScore name cards =
name ++ "の得点は" ++ (show $ score cards) ++ "です。" ++ bust
where bust = if (score cards) > 21 then (name ++ "はバーストしました") else ""
playerDrawCard :: Bool -> [Card] -> Player -> ([Card], Player, String)
playerDrawCard flagShow deck player =
let
name = playerName player
hands = playerHands player
(newDeck, newHands) = drawCard deck hands
message = if flagShow then (messageForDraw name newHands) ++ "\n" ++ (messageForScore name newHands) ++ "\n"
else (messageForDrawHide name newHands) ++ "\n" ++ (messageForScoreHide name) ++ "\n"
in (newDeck, Player { playerName = name, playerHands = newHands}, message )
whileM :: (Monad m) => (a -> m a) -> a -> (a -> (m Bool)) -> m a
whileM f ini checker = do
b <- checker ini
if b
then f ini >>= \y -> whileM f y checker
else return ini
data GameStatus = YouWin | YouLose | DrawGame | Playing
main :: IO()
main = do
putStrLn "★☆★☆★☆★☆★☆ ようこそブラックジャックへ ★☆★☆★☆★☆★☆"
deck <- shuffle allCards
let humanPlayer = Player { playerName = "あなた", playerHands = [] }
let comPlayer = Player { playerName = "ディーラー", playerHands = [] }
let playerDrawCardWithMessage = \(deck, player) -> do
let (deck', player', message) = playerDrawCard True deck player
putStrLn message
return (deck', player')
let playerDrawCardWithMessage' = \(deck, player) -> do
let (deck', player', message) = playerDrawCard False deck player
putStrLn message
return (deck', player')
(deck, humanPlayer) <- playerDrawCardWithMessage (deck, humanPlayer)
(deck, humanPlayer) <- playerDrawCardWithMessage (deck, humanPlayer)
(deck, comPlayer) <- playerDrawCardWithMessage (deck, comPlayer)
(deck, comPlayer) <- playerDrawCardWithMessage' (deck, comPlayer)
let checkBust = \s -> s > 21
(deck, humanPlayer) <- whileM playerDrawCardWithMessage
(deck, humanPlayer) $ \(deck, player) -> do
if checkBust $ score $ playerHands player
then return False
else do
putStr "もう一枚引きますか？ (y/n):"
s <- getLine
if "Y" == map toUpper s
then return True
else putStrLn "" >> return False
putStrLn $ (messageForDraw' (playerName comPlayer) (playerHands comPlayer)) ++ "\n"
++ (messageForScore (playerName comPlayer) (playerHands comPlayer)) ++ "\n"
let humanScore = score $ playerHands humanPlayer
(deck, comPlayer) <-
if humanScore > 21
then return $ (deck, comPlayer)
else whileM playerDrawCardWithMessage
(deck, comPlayer) $ \(deck, player) -> do
let s = score $ playerHands player
if checkBust s
then return False
else do
if s <= 16
then return True
else return False
result <- case humanScore of
x | 21 < x -> return $ YouLose
_ -> do
let comScore = score $ playerHands comPlayer
case comScore of
x | 21 < x -> return $ YouWin
x | humanScore < x -> return $ YouLose
x | humanScore > x -> return $ YouWin
otherwise -> return $ DrawGame
putStrLn $ messageForFinalScore (playerName humanPlayer) (playerHands humanPlayer)
putStrLn $ messageForFinalScore (playerName comPlayer) (playerHands comPlayer)
case result of
YouWin -> putStrLn "あなたの勝ちです！\n"
YouLose -> putStrLn "あなたの負けです！\n"
otherwise -> putStrLn "引き分けです！\n"
putStrLn "ブラックジャック終了！また遊んでね★"
return ()
あとがき
ブラックジャックの実装は、単純なFizzBuzzの計算などと違って、ゲーム性がある課題なので、プログラミングが俄然楽しくなりますね。Haskellらしいバインドがあまり使えなかってないので、もっと使えるように精進したいです。