Haskellで大富豪を作ろう (2)ターンを進めよう

前回までの記事

• Haskellで大富豪を作ろう (1)トランプを用意しカードを配ろう - Just $ A sandbox

第ニ回 ターンを進めよう

実際にゲームとして動かすために, まずはいわゆるメインループにあたる部分を作ろう.

ゲームに必要な変数を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:完成してから思ったのはこれは少し失敗だった. 入力値のエラーチェック等が激しく面倒なので多少無理してもブラウザで動くものにすればよかった

Haskellで大富豪を作ろう (3)カードの組を判定しよう

前回までの記事

• Haskellで大富豪を作ろう (1)トランプを用意しカードを配ろう - Just $ A sandbox
• Haskellで大富豪を作ろう (2)ターンを進めよう - Just $ A sandbox

第三回 カードの組を判定しよう

前回はカードを捨てられるようになったので, 次は同じ数字は組として一緒に出せるようにしよう.
ところで, 例えば同じカードが3枚あればそのうち好きな1枚または2枚を出すこともできるので, 何を組にして出すかはユーザーに選択させるようにしよう.

また, 左から何枚目のカードを捨てるというのは分かりにくいので, どの数字を捨てるかを入力させることにしよう.

結果として, 自分のターンには,

1. 何の数字のカードを出すか選択
2. 同じ数字のカードが1枚しかない場合はそれを出す. 2枚以上ある場合はカードを表示して, どのカードを出すかを選択させる

の操作を行うことにした.

player :: StateT Game IO [Card]
player = do
  ds <- use (decks . ix 0)
  lift $ print $ groupBy sameNum ds
  lift $ putStrLn "出すカードを選択してください. (ジョーカーはJ)"
  str <- lift getLine
  case pickWith str ds of
    Just ps -> process ds ps
    Nothing -> do
      lift $ putStrLn "正しいカードNoを選択してください."
      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)
          return ps
        False -> whichToDiscard ds ps

次回は大富豪として遊べるようになるために, カードの出し方やパスといった基本的なルールを組み込もう.

実行例

Let's play 大富豪!
あなたの番です.
[[♣3,♥3],[♠5],[♥7,♣7],[♥8],[♦K,♣K],[♦2,♥2,♠2],[Joker 0],[Joker 1]]
出すカードを選択してください. (ジョーカーはJ)
> 3
0:♣3 1:♥3
どのカードを出しますか? (複数の場合はスペースで区切る)
> 0 1
場札:[♣3,♥3]
CPU1さんの番です.
場札:♠3
CPU2さんの番です.
場札:♦3
CPU3さんの番です.
場札:♠4
あなたの番です.
[[♠5],[♥7,♣7],[♥8],[♦K,♣K],[♦2,♥2,♠2],[Joker 0],[Joker 1]]
出すカードを選択してください. (ジョーカーはJ)
> J
0:Joker 0 1:Joker 1
どのカードを出しますか? (複数の場合はスペースで区切る)
> 0
場札:[Joker 0]
CPU1さんの番です.
場札:♣4
CPU2さんの番です.
場札:♣5
CPU3さんの番です.
場札:♦4
あなたの番です.
[[♠5],[♥7,♣7],[♥8],[♦K,♣K],[♦2,♥2,♠2],[Joker 1]]
出すカードを選択してください. (ジョーカーはJ)

使用したパッケージ

• split: Combinator library for splitting lists. | Hackage
• random-shuffle: Random shuffle implementation. | Hackage

ソースコード

{-# LANGUAGE TemplateHaskell #-}
module Main where
 
import Control.Lens
import Control.Monad.State
import Data.Char
import Data.List
import qualified Data.IntMap as IM
import Data.List.Split (chunksOf)
import System.Random.Shuffle (shuffleM)
 
-- (3) カードの組を判定しよう
 
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
 
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
  }
 
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 $ groupBy sameNum ds
      lift $ putStrLn "出すカードを選択してください. (ジョーカーはJ)"
      str <- lift getLine
      case pickWith str ds of
        Just ps -> process ds ps
        Nothing -> do
          lift $ putStrLn "正しいカードNoを選択してください."
          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)
              return ps
            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 <- words <$> lift getLine
          case pickThese str ps of
            Just cs -> do
              decks %= IM.insert 0 (ds \\ cs)
              return cs
            Nothing -> whichToDiscard ds ps
 
    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
 
    pickWith :: String -> [Card] -> Maybe [Card]
    pickWith "J" ds = Just $ filter isJoker ds
    pickWith str ds = filter (isSameNumber (read str)) <$> check where
      check = if all isDigit str && 1 <= read str && read str <= 13
                  then Just ds else Nothing
 
    pickThese :: [String] -> [Card] -> Maybe [Card]
    pickThese ss ps = fmap snd . filter (\(i,_) -> i `elem` fmap read ss) . zip [0..] <$> check where
      check = if all (all isDigit) ss && all (\s -> 0 <= read s && read s <= length ps - 1) ss
                 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
 
    sameNum :: Card -> Card -> Bool
    sameNum (Card _ k) (Card _ l) = k == l
    sameNum (Joker k) (Joker l) = k == l
    sameNum _ _ = False
 
main = do
  putStrLn "Let's play 大富豪!"
 
  let pl = 4
  d <- deal pl
  runStateT game $ Game (IM.fromList $ zip [0..pl-1] d) 0 pl