Algorithm 如何使这段Haskell代码更简洁？

作为练习，我正在尝试为Haskell的赌场游戏“战争”编写一个模拟

这是一个非常简单的游戏，有一些规则。用我所知道的任何一种命令式语言来写都是一个非常简单的问题，但是我正在努力用Haskell来写

到目前为止，我掌握的代码是：

 -- Simulation for the Casino War

import System.Random
import Data.Map

-------------------------------------------------------------------------------
-- stolen from the internet

fisherYatesStep :: RandomGen g => (Map Int a, g) -> (Int, a) -> (Map Int a, g)
fisherYatesStep (m, gen) (i, x) = ((insert j x . insert i (m ! j)) m, gen')
    where
        (j, gen') = randomR (0, i) gen

fisherYates :: RandomGen g => g -> [a] -> ([a], g)
fisherYates gen [] = ([], gen)
fisherYates gen l = toElems $ Prelude.foldl
        fisherYatesStep (initial (head l) gen) (numerate (tail l))
    where
        toElems (x, y) = (elems x, y)
        numerate = zip [1..]
        initial x gen = (singleton 0 x, gen)

-------------------------------------------------------------------------------

data State = Deal | Tie deriving Show

-- state: game state
-- # cards to deal
-- # cards to burn
-- cards on the table
-- indices for tied players
-- # players
-- players winning
-- dealer's winning
type GameState = (State, Int, Int, [Int], [Int], Int, [Int], Int)

gameRound :: GameState -> Int -> GameState
gameRound (Deal, toDeal, toBurn, inPlay, tied, numPlayers, pWins, dWins) card
    | toDeal > 0 =
        -- not enough card, deal a card
        (Deal, toDeal - 1, 0, card:inPlay, tied, numPlayers, pWins, dWins)
    | toDeal == 0 =
        -- enough cards in play now
        -- here should detemine whether or not there is any ties on the table,
        -- and go to the tie state
        let
            dealerCard = head inPlay
            p = zipWith (+) pWins $ (tail inPlay) >>=
                (\x -> if x < dealerCard then return (-1) else return 1)
            d = if dealerCard == (maximum inPlay) then dWins + 1 else dWins - 1
        in
            (Deal, numPlayers + 1, 0, [], tied, numPlayers, p, d)
gameRound (Tie, toDeal, toBurn, inPlay, tied, numPlayers, pWins, dWins) card
    -- i have no idea how to write the logic for the tie state AKA the "war" state
    | otherwise = (Tie, toDeal, toBurn, inPlay, tied, numPlayers, pWins, dWins)

-------------------------------------------------------------------------------

main = do
    rand <- newStdGen
    -- create the shuffled deck
    (deck, _) <- return $ fisherYates rand $ [2 .. 14] >>= (replicate 6)
    -- fold the state updating function over the deck
    putStrLn $ show $ Prelude.foldl gameRound
        (Deal, 7, 0, [], [], 6, [0 ..], 0) deck

-------------------------------------------------------------------------------

——赌场战争模拟
导入系统。随机
导入数据。映射
-------------------------------------------------------------------------------
--从网上偷来的
fisherYatesStep:：RandomGen g=>（映射Int a，g）->（Int，a）->（映射Int a，g）
鱼叉步骤（m，gen）（i，x）=（（插入j x.插入i（m！j））m，gen'）
哪里
（j，gen'）=randomR（0，i）gen
鱼腥味剂：：RandomGen g=>g->[a]->（[a]，g）
鱼叉酸盐代[]=（[]，代）
fisherYates gen l=toElems$Prelude.foldl
fisherYatesStep（首字母（首字母l）gen）（数字（尾字母l））
哪里
toElems（x，y）=（elems x，y）
numerate=zip[1..]
初始x世代=（单态0世代）
-------------------------------------------------------------------------------
数据状态=交易|领带衍生秀
--状态：游戏状态
--#要发的牌
--#要烧掉的卡片
--桌上的牌
--平手指数
--#球员
--赢家
--庄家的胜利
类型GameState=（State，Int，Int，[Int]，[Int]，Int，[Int]，Int）
游戏回合：：游戏状态->智力->游戏状态
gameRound（交易、toDeal、toBurn、inPlay、平局、numPlayers、pWins、dWins）卡
|今天上午>0=
--牌不够，发一张牌
（交易，今天的交易-1，0，卡片：显示，平局，多人，普金斯，德温）
|toDeal==0=
--现在已经有足够的牌了
--这里应该确定桌上是否有领带，
--然后去结州
让
dealerCard=显示中的头部
p=zipWith（+）pWins$（尾部在播放中）>>=
（\x->如果x

我理解为什么额外的工作必须用于创建随机数，但我很确定我缺少一些基本的构造或概念。保存一个状态集合，并在输入列表上运行分支逻辑，应该不会这么尴尬。我甚至想不出一个好方法来为桌上有领带的情况编写逻辑

我不是在要求完整的解决方案。如果有人能指出我做错了什么，或者一些相关的好的阅读材料，那就太好了

---

提前感谢。

维护应用程序状态的一种有用的设计模式是所谓的状态monad。您可以找到描述和一些介绍性示例。此外，您可能需要考虑使用名字段而不是元组的数据类型，用于<代码> GAMStAs/CODE >，例如：

data GameState = GameState { state :: State, 
                             toDeal :: Int
                           -- and so on
                           }

---

这将使使用更容易访问/更新单个字段

我突然想到“使用StateT”的建议可能有点不透明，所以我把它翻译成了一点行话，希望你能看到如何从那里开始。最好在游戏状态中包含牌组的状态<下面的代码>游戏回合只是用StateT行话重申了您的功能。前面的定义，

game

使用游戏状态的

deck

字段，持续减少，并包含整个游戏。我介绍IO操作，只是为了展示它是如何完成的，所以如果在ghci中调用main，您可以看到状态的连续性。您将IO动作“提升”到StateT机器中，使其与GET和put处于同一水平。请注意，在mose子类中，我们放置新状态，然后调用重复的操作，以便do块包含完整的递归操作。（平局，一副空牌立即结束游戏。）然后在

main

的最后一行，我们

runStateT

在这个自我更新的

game

上生成一个函数GameState->IO（GameState，（））；然后，我们用一个特定的开始状态（包括随机确定的数据组）将其输入，以获得IO操作，这是主要业务。（我不明白游戏应该如何运作，但我只是机械地移动东西来让大家理解这个想法。）

import Control.Monad.Trans.State
进口管制.Monad.Trans
导入系统。随机
导入数据。映射
数据阶段=交易|平局衍生秀
数据游戏状态=
游戏状态{stage:：stage
，toDeal:：Int
，toBurn：：Int
，inPlay:：[Int]
，并列：：[Int]
，numPlayers:：Int
，pWins:：[Int]
，dWins：：Int
，deck:：[Int]}衍生节目
--为“游戏”示例添加了牌组字段
键入GameRound m a=StateT GameState m a
main=do
兰德打印街
案例甲板圣
[]->lift$print“无卡”
（卡片：卡片）->
病例（今日st，st期）
（0，交易）->do put（第一个案例\u更新st卡）
游戏-完成放置（第二个案例更新st卡）
游戏
（u，Tie）->一定要提起$putStrLn“这是一个平局”
取消$print街
import Control.Monad.Trans.State
import Control.Monad.Trans
import System.Random
import Data.Map

data Stage = Deal | Tie deriving Show
data GameState = 
  GameState   { stage      :: Stage
              , toDeal     :: Int
              , toBurn     :: Int
              , inPlay     :: [Int]
              , tied       :: [Int]
              , numPlayers :: Int
              , pWins      :: [Int]
              , dWins      :: Int
              , deck      ::  [Int]} deriving Show
              -- deck field is added for the `game` example
type GameRound m a = StateT GameState m a

main = do
   rand <- newStdGen
   let deck = fst $ fisherYates rand $ concatMap (replicate 6) [2 .. 14] 
   let startState = GameState Deal 7 0 [] [] 6 [0 ..100] 0 deck
   runStateT game startState 

game  ::   GameRound IO ()
game = do
  st <- get
  lift $ putStrLn "Playing: " >> print st
  case deck st of 
    []            -> lift $ print "no cards"
    (card:cards)  -> 
      case (toDeal st, stage st) of 
        (0, Deal) ->  do put (first_case_update st card cards) 
                         game -- <-- recursive call with smaller deck
        (_, Deal) ->  do put (second_case_update st card cards)
                         game
        (_,  Tie) ->  do lift $ putStrLn "This is a tie"
                         lift $ print st

 where    -- state updates:
          -- I separate these out hoping this will make the needed sort 
          -- of 'logic' above clearer.
  first_case_update s card cards= 
     s { numPlayers = numPlayers s + 1
       , pWins = [if x < dealerCard  then -1 else  1 |
                    x <-  zipWith (+) (pWins s)  (tail (inPlay s)) ]
       , dWins = if dealerCard == maximum (inPlay s) 
                     then dWins s + 1 
                     else dWins s - 1
       , deck = cards }
            where  dealerCard = head (inPlay s)

  second_case_update s card cards = 
     s { toDeal = toDeal s - 1 
       , toBurn = 0 
       , inPlay = card : inPlay s
       , deck = cards}

--  a StateTified formulation of your gameRound
gameround  ::  Monad m => Int -> GameRound m ()
gameround card = do
  s <- get
  case (toDeal s, stage s) of 
    (0, Deal) -> 
        put $ s { toDeal = numPlayers s + 1
                , pWins = [if x < dealerCard  then -1 else  1 |
                             x <-  zipWith (+) (pWins s)  (tail (inPlay s)) ]
                , dWins = if dealerCard == maximum (inPlay s) 
                              then dWins s + 1 
                              else dWins s - 1}
                     where  dealerCard = head (inPlay s)
    (_, Deal) -> 
        put $ s { toDeal = toDeal s - 1 
                 , toBurn = 0 
                 , inPlay = card : inPlay s}
    (_,  Tie) -> return ()


fisherYatesStep :: RandomGen g => (Map Int a, g) -> (Int, a) -> (Map Int a, g)
fisherYatesStep (m, gen) (i, x) = ((insert j x . insert i (m ! j)) m, gen')
    where
        (j, gen') = randomR (0, i) gen

fisherYates :: RandomGen g => g -> [a] -> ([a], g)
fisherYates gen [] = ([], gen)
fisherYates gen l = toElems $ Prelude.foldl
        fisherYatesStep (initial (head l) gen) (numerate (tail l))
    where
        toElems (x, y) = (elems x, y)
        numerate = zip [1..]
        initial x gen = (singleton 0 x, gen)