Haskellで大富豪を作ろう (4)基本のルールと場の流れを作ろう
前回までの記事
- Haskellで大富豪を作ろう (1)トランプを用意しカードを配ろう - Just $ A sandbox
- Haskellで大富豪を作ろう (2)ターンを進めよう - Just $ A sandbox
- Haskellで大富豪を作ろう (3)カードの組を判定しよう - Just $ A sandbox
第四回 基本のルールと場の流れを作ろう
前回は同じ数字で組を作れるようになったので, いよいよちゃんとしたルールを作ろう.
まずは出せるカードは場にあるカードより強い数字で, 場にあるカード以上の枚数のものに限ることにしよう. (ついでに, 自分のターンには出せるカードの候補を表示しておくことにしよう)
自分のターンには, 入力された数に対して, それが正しい数字であって, 出せるカードである時にそれを出すという操作をする.
さらに, パスもできることにする.
出せるカードがない場合かパスを入力した場合はパスとして扱うことにする. このため, player, auto :: StateT Game IO [Card]の2つの函数は, パスかどうかを判断できる型に変更する.
パスかどうかを判断するにはもちろん今までのようにMaybeを使っても良いが, パスが宣言されるタイミングが2ヶ所あるので, パスを宣言するとそこで処理が終了することにすると書きやすい.
要はパスは例外処理として扱うと便利なので, 今回はパスをmtlにあるExceptモナドを使って実装しよう. (単に個人的に使ってみたかっただけともいう)
player :: ExceptT () (StateT Game IO) [Card]に対して, runExceptT player :: StateT Game IO (Either () [Card])
となるので, これを実行した結果がLeftの場合はパス, Rightの場合は[Card]がこのターンに出すカードということになる.
ちなみにplayer, autoの中ではExceptとStateの2つのモナドが重なっているので, Stateに対する処理はliftを使って持ち上げる必要がある.
player :: ExceptT () (StateT Game IO) [Card] player = do ds <- use (decks . ix 0) ls <- use layout lift $ lift $ putStrLn $ "手札: " ++ show (groupBy sameNumber ds) ps <- case (\l -> strongPairs l ds) <$> ls of Just ps -> (lift $ lift $ putStrLn $ "候補: " ++ show ps) >> return ps Nothing -> return $ concat $ fmap subsequences $ groupBy sameNumber ds when (length ps == 0) $ throwError () lift $ lift $ putStrLn "出すカードの数字を入力してください. (J: ジョーカー, P: パス)" str <- lift $ lift getLine when (str == "P") $ throwError () case contains str ps of Just ps' -> lift $ process ds ps' Nothing -> do lift $ lift $ putStrLn "正しい数字を入力してください." player
ここで, throwErrorが例外を出す所. throwErrorが実行されるとそこで処理が終わる.
ついでにパスが繰り返されると場が流れ, 最後にカードを出した人からスタートすることにした.
さらについでに, カードを組で出す場合, 出せる組を表示してそこから選ばせるようにした.
例えば"♠2, ♥2"をもっているとき, 2の出し方は"[♠2], [♥2], [♠2, ♥2]"の3通りの出し方があるのでユーザーはこの中から出し方を選択することにした. (こっちの方が入力が簡単なので)
実行例
Let's play 大富豪! あなたの番です. 手札: [[♦3,♠3],[♠4],[♦6,♠6],[♠7],[♦9],[♦10,♠10],[♠Q],[♦K,♥K],[♣A]] 出すカードの数字を入力してください. (J: ジョーカー, P: パス) > 3 0:[♦3] 1:[♠3] 2:[♦3,♠3] どのカードを出しますか? > 2 場札:[♦3,♠3] CPU1さんの番です. 場札:[♠5,♣5] CPU2さんの番です. 場札:[♦7,♣7] CPU3さんの番です. 場札:[♦Q,♥Q] あなたの番です. 手札: [[♠4],[♦6,♠6],[♠7],[♦9],[♦10,♠10],[♠Q],[♦K,♥K],[♣A]] 候補: [[♦K,♥K]] 出すカードの数字を入力してください. (J: ジョーカー, P: パス) > P パス CPU1さんの番です. パス CPU2さんの番です. 場札:[♣2,♠2] CPU3さんの番です. パス あなたの番です. 手札: [[♠4],[♦6,♠6],[♠7],[♦9],[♦10,♠10],[♠Q],[♦K,♥K],[♣A]] 候補: [] パス CPU1さんの番です. パス CPU2さんの番です. パス 場が流れました. CPU2さんの番です. 場札:[♥3] CPU3さんの番です. 場札:[♣4] あなたの番です.
ソースコード
{-# LANGUAGE TemplateHaskell #-} module Main where import Control.Lens import Control.Monad.State import Control.Monad.Except import Data.Char import Data.List import qualified Data.IntMap as IM import Data.List.Split (chunksOf) import System.Random.Shuffle (shuffleM) -- (4) 基本のルールと場の流れを作ろう data Suit = Spade | Club | Diamond | Heart deriving (Eq, Enum) data Number = N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10 | N11 | N12 | N13 | N1 | N2 deriving (Eq, Ord, Enum) data JokerNumber = J1 | J2 deriving (Eq, Ord, Enum, Show) data Card = Card Suit Number | Joker JokerNumber deriving Eq allCards :: [Card] allCards = [Card s n | s <- [Spade .. Heart], n <- [N3 .. N2]] ++ [Joker j | j <- [J1,J2]] isNormalCard :: Card -> Bool isNormalCard (Card _ _) = True isNormalCard _ = False isJoker :: Card -> Bool isJoker (Card _ _) = False isJoker _ = True sameNumber :: Card -> Card -> Bool sameNumber (Card _ k) (Card _ l) = k == l sameNumber (Joker k) (Joker l) = k == l sameNumber _ _ = False toNumber :: Int -> Number toNumber n | 3 <= n && n <= 13 = toEnum $ n - 3 | n == 1 || n == 2 = toEnum $ n + 10 | otherwise = toNumber (n `mod` 13) fromNumber :: Number -> Int fromNumber n | n <= N13 = fromEnum n + 3 | otherwise = fromEnum n - 10 instance Show Suit where show Spade = "♠" show Club = "♣" show Diamond = "♦" show Heart = "♥" instance Show Number where show N1 = "A" show N11 = "J" show N12 = "Q" show N13 = "K" show k = show $ fromNumber k instance Show Card where show (Card s n) = show s ++ show n show (Joker k) = "Joker " ++ show (fromEnum k) instance Ord Card where Joker j <= Joker j' = j <= j' Card _ _ <= Joker _ = True Joker _ <= Card _ _ = False Card _ k <= Card _ k' = k <= k' deal :: Int -> IO [[Card]] deal n = fmap (fmap sort . take n . chunksOf (length allCards `div` n)) $ shuffleM allCards data Game = Game { _decks :: IM.IntMap [Card], _turn :: Int, _players :: Int, _layout :: Maybe [Card], _passtimes :: Int } makeLenses ''Game strongPairs :: [Card] -> [Card] -> [[Card]] strongPairs lay hands = concat $ fmap combi $ filter (\h -> h !! 0 >= lay !! 0) $ filter (\h -> length h >= length lay) hands' where hands' = groupBy sameNumber hands combi us = filter (\h -> length h == length lay) $ subsequences us game :: StateT Game IO () game = do t <- use turn k <- case t == 0 of True -> (lift $ putStrLn $ "あなたの番です.") >> runExceptT player False -> (lift $ putStrLn $ "CPU" ++ show t ++ "さんの番です.") >> runExceptT auto case k of Left () -> do lift $ putStrLn $ "パス" passtimes += 1 Right l -> do lift $ putStrLn $ "場札:" ++ show l layout .= Just l passtimes .= 0 pt <- use passtimes when (pt >= 4) $ do lift $ putStrLn $ "場が流れました." layout .= Nothing turn -= 1 p <- use players turn %= nextTurn p game where nextTurn p t | t == p-1 = 0 | otherwise = t+1 player :: ExceptT () (StateT Game IO) [Card] player = do ds <- use (decks . ix 0) ls <- use layout lift $ lift $ putStrLn $ "手札: " ++ show (groupBy sameNumber ds) ps <- case (\l -> strongPairs l ds) <$> ls of Just ps -> (lift $ lift $ putStrLn $ "候補: " ++ show ps) >> return ps Nothing -> return $ concat $ fmap subsequences $ groupBy sameNumber ds when (length ps == 0) $ throwError () lift $ lift $ putStrLn "出すカードの数字を入力してください. (J: ジョーカー, P: パス)" str <- lift $ lift getLine when (str == "P") $ throwError () case contains str ps of Just ps' -> lift $ process ds ps' Nothing -> do lift $ lift $ putStrLn "正しい数字を入力してください." player where process :: [Card] -> [[Card]] -> StateT Game IO [Card] process ds ps = do case length ps == 1 of True -> do decks %= IM.insert 0 (ds \\ ps !! 0) return $ ps !! 0 False -> whichToDiscard ds ps whichToDiscard :: [Card] -> [[Card]] -> StateT Game IO [Card] whichToDiscard ds ps = do let psi = zip [0..] ps lift $ putStrLn $ unwords $ fmap (\(i,c) -> show i ++ ":" ++ show c) psi lift $ putStrLn "どのカードを出しますか?" str <- lift getLine case pick str ps of Just cs -> do decks %= IM.insert 0 (ds \\ cs) return cs Nothing -> whichToDiscard ds ps contains :: String -> [[Card]] -> Maybe [[Card]] contains "J" ds = Just $ filter (any isJoker) ds contains str ds = isEmpty $ filter (any (isSameNumber (read str))) <$> check where check = if all isDigit str && 1 <= read str && read str <= 13 then Just ds else Nothing isEmpty p = if p == Just [] then Nothing else p pick :: String -> [[Card]] -> Maybe [Card] pick ss ps = (!! read ss) <$> check where check = if (all isDigit) ss && (0 <= read ss && read ss <= length ps - 1) then Just ps else Nothing isSameNumber :: Int -> Card -> Bool isSameNumber n x = isNormalCard x && cardNumber x == n where cardNumber (Card _ n) = fromNumber n cardNumber _ = -1 auto :: ExceptT () (StateT Game IO) [Card] auto = do t <- use turn ls <- use layout ds <- use (decks . ix t) case (\l -> strongPairs l ds) <$> ls of Just [] -> throwError () Just ps -> do let ps' = ps !! 0 decks %= IM.insert t (ds \\ ps') return ps' Nothing -> return $ (groupBy sameNumber ds) !! 0 main = do putStrLn "Let's play 大富豪!" let pl = 4 d <- deal pl runStateT game $ Game (IM.fromList $ zip [0..pl-1] d) 0 pl Nothing 0
Haskellで大富豪を作ろう (2)ターンを進めよう
前回までの記事
第ニ回 ターンを進めよう
実際にゲームとして動かすために, まずはいわゆるメインループにあたる部分を作ろう.
ゲームに必要な変数をGame型として定義しておこう. (ついでにlensも使った)
とりあえず, ターンを進めるために, プレイヤーの手札, 今誰のターンかを表す変数(mod (プレイヤー数)), プレイヤーの数を持っておくことにしよう.
data Game = Game { _decks :: IM.IntMap [Card], _turn :: Int, _players :: Int } makeLenses ''Game
ターンのカウンターが0のとき自分, それ以外はコンピュータのターンとする.
自分のターンには数字を入力し, 入力nに対してn番目のカードを捨てる.
コンピュータは何も考えず左端のカードを捨てる.
game :: StateT Game IO ()
game = do
t <- use turn
case t == 0 of
True -> do
lift $ putStrLn $ "あなたの番です."
k <- player
lift $ putStrLn $ "場札:" ++ show k
False -> do
lift $ putStrLn $ "CPU" ++ show t ++ "さんの番です."
k <- auto
lift $ putStrLn $ "場札:" ++ show k
p <- use players
turn %= nextTurn p
game
where
player :: StateT Game IO Card
player = do
ds <- use (decks . ix 0)
lift $ print ds
lift $ putStrLn "捨てるカードNoを選択してください."
n <- fmap (read :: String -> Int) $ lift getLine
case 0 <= n && n <= length ds - 1 of
True -> do
decks %= IM.insert 0 (delete (ds !! n) ds)
return $ ds !! n
False -> do
lift $ putStrLn "正しいカードNoを選択してください."
player
auto :: StateT Game IO Card
auto = do
t <- use turn
ds <- use (decks . ix t)
decks %= IM.insert t (delete (ds !! 0) ds)
return $ ds !! 0
nextTurn p t | t == p-1 = 0
| otherwise = t+1
今はまだ1枚しか捨てられないが, 手札の中で「同じ数字で組を作る」ことができるようになれば, 実際の大富豪のように複数枚のカードを出せるようにできる.
というわけで次回はカードの組を作れるようにしよう.
実行例
Let's play 大富豪! あなたの番です. [♦3,♣3,♦4,♠5,♣6,♣7,♣8,♠10,♣10,♣J,♠2,♣2,Joker 1] 捨てるカードNoを選択してください. > 3 場札:♠5 CPU1さんの番です. 場札:♥3 CPU2さんの番です. 場札:♣4 CPU3さんの番です. 場札:♠3 あなたの番です. [♦3,♣3,♦4,♣6,♣7,♣8,♠10,♣10,♣J,♠2,♣2,Joker 1] 捨てるカードNoを選択してください.
使用したパッケージ
前回使用を宣言したものは省く.
なお2回目だけどインストールにはcabalじゃなくてstackとかを使うと便利.
ちなみにlensはStackageに登録されているのでコケることなく入ります.
- mtl: Monad classes, using functional dependencies | Hackage
- containers: Assorted concrete container types | Hackage
- lens: Lenses, Folds and Traversals | Hackage
ソースコード
{-# LANGUAGE TemplateHaskell #-} module Main where import Control.Lens import Control.Monad.State import Data.List import qualified Data.IntMap as IM import Data.List.Split (chunksOf) import System.Random.Shuffle (shuffleM) -- (2) ターンを進めよう data Suit = Spade | Club | Diamond | Heart deriving (Eq, Enum) data Number = N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10 | N11 | N12 | N13 | N1 | N2 deriving (Eq, Ord, Enum) data JokerNumber = J1 | J2 deriving (Eq, Ord, Enum, Show) data Card = Card Suit Number | Joker JokerNumber deriving Eq allCards :: [Card] allCards = [Card s n | s <- [Spade .. Heart], n <- [N3 .. N2]] ++ [Joker j | j <- [J1,J2]] instance Show Suit where show Spade = "♠" show Club = "♣" show Diamond = "♦" show Heart = "♥" instance Show Number where show N1 = "A" show N11 = "J" show N12 = "Q" show N13 = "K" show k | k <= N13 = show $ fromEnum k + 3 | otherwise = show $ fromEnum k - 10 instance Show Card where show (Card s n) = show s ++ show n show (Joker k) = "Joker " ++ show (fromEnum k) -- 大富豪式順序 instance Ord Card where Joker j <= Joker j' = j <= j' Card _ _ <= Joker _ = True Joker _ <= Card _ _ = False Card _ k <= Card _ k' = k <= k' deal :: Int -> IO [[Card]] deal n = fmap (fmap sort . take n . chunksOf (length allCards `div` n)) $ shuffleM allCards data Game = Game { _decks :: IM.IntMap [Card], _turn :: Int, _players :: Int } makeLenses ''Game game :: StateT Game IO () game = do t <- use turn case t == 0 of True -> do lift $ putStrLn $ "あなたの番です." k <- player lift $ putStrLn $ "場札:" ++ show k False -> do lift $ putStrLn $ "CPU" ++ show t ++ "さんの番です." k <- auto lift $ putStrLn $ "場札:" ++ show k p <- use players turn %= nextTurn p game where player :: StateT Game IO Card player = do ds <- use (decks . ix 0) lift $ print ds lift $ putStrLn "捨てるカードNoを選択してください." n <- fmap (read :: String -> Int) $ lift getLine case 0 <= n && n <= length ds - 1 of True -> do decks %= IM.insert 0 (delete (ds !! n) ds) return $ ds !! n False -> do lift $ putStrLn "正しいカードNoを選択してください." player auto :: StateT Game IO Card auto = do t <- use turn ds <- use (decks . ix t) decks %= IM.insert t (delete (ds !! 0) ds) return $ ds !! 0 nextTurn p t | t == p-1 = 0 | otherwise = t+1 main = do putStrLn "Let's play 大富豪!" let pl = 4 d <- deal pl runStateT game $ Game (IM.fromList $ zip [0..pl-1] d) 0 pl ```
Haskellで大富豪を作ろう (1)トランプを用意しカードを配ろう
まえがき
Haskellでなんか動くものを作ろうと思った.
規模と知名度等を考えて大富豪あたりが妥当なところかと思ったので, 今回はCUIの大富豪を作ろうということにした*1.
コード自体は完成しているので, 何回かに記事を分けて説明をつけて投稿していくつもり.
なおとにかく動くものを作りたいってことしか考えてなかったので完成したコードはあんまり綺麗じゃない模様.
第一回 トランプを用意しカードを配ろう
まずはトランプを用意しよう. 今回は4種類A~Kまでの通常のカードとジョーカー2枚を使用する.
これをまずはdata Cardとして定義する.
ついでに, 大富豪ではカードの強さ比較をすることが多いのでOrdのインスタンスにする.
このとき大富豪式に数字の強さを(3が弱く2が強くJokerが最強になるように)定義しておくと便利かもしれないということでそうした.
data Suit = Spade | Club | Diamond | Heart deriving (Eq, Enum, Show) data Number = N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10 | N11 | N12 | N13 | N1 | N2 deriving (Eq, Ord, Enum) data JokerNumber = J1 | J2 deriving (Eq, Ord, Enum, Show) data Card = Card Suit Number | Joker JokerNumber deriving (Eq, Show) instance Ord Card where Joker j <= Joker j' = j <= j' Card _ _ <= Joker _ = True Joker _ <= Card _ _ = False Card _ k <= Card _ k' = k <= k'
カードが用意できたら人数分配ろう.
今回は, n人参加する場合, 一人あたり54/n枚配り, 余ったカードはゲームに使用しないことにした.
deal :: Int -> IO [[Card]] deal n = fmap (take n . chunksOf (length allCards `div` n)) $ shuffleM allCards
実行例
Let's play 大富豪! [[Card Spade 3,Card Club K,Card Diamond A,Card Club J,Card Club 4,Card Heart 4,Card Heart A,Card Club Q,Card Spade A,Card Spade Q,Card Heart J,Card Spade 6,Card Heart K],[Card Club 9,Card Club 7,Card Club 2,Card Diamond 3,Card Club 10,Card Heart 9,Card Club 3,Card Spade 9,Card Club 5,Card Diamond 7,Card Diamond 8,Card Spade 4,Card Spade 8],[Card Heart 10,Card Diamond J,Joker J2,Card Heart 3,Joker J1,Card Club 6,Card Spade 7,Card Heart Q,Card Spade 10,Card Heart 5,Card Spade 5,Card Diamond 9,Card Diamond Q],[Card Club 8,Card Heart 8,Card Spade K,Card Heart 2,Card Diamond 10,Card Diamond 5,Card Heart 6,Card Diamond 4,Card Club A,Card Spade 2,Card Diamond 2,Card Heart 7,Card Spade J]]
使用したパッケージ
以下をインストールするとページ末尾のコードが動く.
なお関係ないけどインストールにはcabalじゃなくてstackとかを使うと便利.
- split: Combinator library for splitting lists. | Hackage
- random-shuffle: Random shuffle implementation. | Hackage
ソースコード
module Main where import Data.List import Data.List.Split (chunksOf) import System.Random.Shuffle (shuffleM) -- (1) トランプを用意しカードを配ろう data Suit = Spade | Club | Diamond | Heart deriving (Eq, Enum, Show) data Number = N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10 | N11 | N12 | N13 | N1 | N2 deriving (Eq, Ord, Enum) data JokerNumber = J1 | J2 deriving (Eq, Ord, Enum, Show) data Card = Card Suit Number | Joker JokerNumber deriving (Eq, Show) allCards :: [Card] allCards = [Card s n | s <- [Spade .. Heart], n <- [N3 .. N2]] ++ [Joker j | j <- [J1,J2]] instance Show Number where show N1 = "A" show N11 = "J" show N12 = "Q" show N13 = "K" show k | k <= N13 = show $ fromEnum k + 3 | otherwise = show $ fromEnum k - 10 -- 大富豪式順序 instance Ord Card where Joker j <= Joker j' = j <= j' Card _ _ <= Joker _ = True Joker _ <= Card _ _ = False Card _ k <= Card _ k' = k <= k' deal :: Int -> IO [[Card]] deal n = fmap (take n . chunksOf (length allCards `div` n)) $ shuffleM allCards main = do putStrLn "Let's play 大富豪!" print =<< deal 4
*1:完成してから思ったのはこれは少し失敗だった. 入力値のエラーチェック等が激しく面倒なので多少無理してもブラウザで動くものにすればよかった
