Haskell：洗牌套牌

Question

我正在一个实验室工作，我们在其中研究随机性和单子。

实验室的组成部分是：

1. 编写一个函数 randR，在给定范围内生成随机数
2. 编写一个函数 rollTwoDice 来模拟掷两个骰子
3. 编写一个 removeCard 函数，从 PlayingCards 列表中随机删除一张牌
4. 编写一个 shuffleDeck 函数，该函数将取出的卡牌放在牌堆前面，然后不断重复，直到牌堆完全洗牌。

我已经完成了 1、2 和 3，但我遇到了 4 的问题。

这是给定的代码：

RandState.hs

module RandState where
import UCState
import System.Random

-- In order to generate pseudo-random numbers, need to pass around generator
--  state in State monad
type RandState a = State StdGen a

-- runRandom runs a RandState monad, given an initial random number generator
runRandom :: RandState a -> StdGen -> a
runRandom (State f) s = res
    where (res, state) = f s

-- rand is a helper function that generates a random instance of any
--  type in the Random class, using the RandState monad.
rand :: Random a => RandState a
rand = do
    gen <- get
    let (x, gen') = random gen
    put gen'
    return x

UCState.hs

{- 
 - Simplified implementation of the State monad.  The real implementation
 - is in the Control.Monad.State module: using that is recommended for real 
 - programs.
 -}
module UCState where

data State s a = State { runState :: s -> (a, s) }

instance Monad (State s)
    where
        {-
         - return lifts a function x up into the state monad, turning it into
         -  a state function that just passes through the state it receives
         -}
        return x = State ( \s -> (x, s) )

        {- 
         - The >>= combinator combines two functions p and f, and 
         -  gives back a new function (Note: p is originally wrapped in the 
         -  State monad)
         -
         - p: a function that takes the initial state (from right at the start
         - of the monad chain), and gives back a new state and value, 
         - corresponding to the result of the chain up until this >>=
         - f: a function representing the rest of the chain of >>='s
         -}
        (State p) >>= f = State ( \initState -> 
                                  let (res, newState) = p initState
                                      (State g) = f res
                                  in g newState )

-- Get the state
get :: State s s  
get = State ( \s -> (s, s) )

-- Update the state
put :: s -> State s ()
put s = State ( \_ -> ((), s))

这是我的代码，我只是在 RandState.hs 中编写了它，因为我不知道如何导入它（帮助导入也很好，尽管此时我最关心的不是）：

randR :: Random a => (a, a) -> RandState a
randR (lo, hi) = do
    gen <- get
    let (x, gen') = randomR (lo, hi) gen
    put gen'
    return x

testRandR1 :: IO Bool
testRandR1 = do
    gen <- newStdGen
    let genR = runRandom (randR (1,5)) gen :: Int
    return (genR <=5 && genR >=1)

testRandR2 :: IO Bool
testRandR2 = do
    gen <- newStdGen
    let genR = runRandom (randR (10.0, 11.5)) gen :: Double
    return (genR <= 11.5 && genR >= 10.0)

rollTwoDice :: RandState Int
rollTwoDice = do
    gen <- get
    let (a, gen') = randomR (1, 6) gen :: (Int, StdGen)
    put gen'
    let (b, gen'') = randomR (1, 6) gen' :: (Int, StdGen)
    put gen''
    return $ a + b

testRollTwoDice :: IO Bool
testRollTwoDice = do
    gen <- newStdGen
    let genR = runRandom (rollTwoDice) gen
    return (genR <= 12 && genR >= 2)

-- Data types to represent playing cards
data CardValue = King | Queen | Jack | NumberCard Int
    deriving (Show, Eq)
data CardSuit = Hearts | Diamonds | Spades | Clubs
    deriving (Show, Eq)
data PlayingCard = PlayingCard CardSuit CardValue
    deriving (Show, Eq)

{-
 - fullCardDeck will be a deck of cards, 52 in total, with a King, a Queen, 
 - a Jack and NumberCards from 1 to 10 for each suit.
 -}
-- fullCardDeck and its definition were given in the lab
fullCardDeck :: [PlayingCard]
fullCardDeck = [ PlayingCard s v | s <- allsuits, v <- allvals ] where
        allvals = King : Queen : Jack : [ NumberCard i | i <- [1..10] ]
        allsuits = [Hearts, Diamonds, Spades, Clubs]

removeCard :: [a] -> RandState [a]
removeCard deck = do
    gen <- get
    let n = runRandom (randR(1, length (deck))) gen :: Int
    let (xs, ys) = splitAt (n-1) deck
    return $ head ys : xs ++ tail ys

shuffleDeck deck = do
    gen <- get
    let f deck = head $ runRandom (removeCard deck) gen
    return $ take (length(deck)) (iterate f deck)

shuffleDeck 不起作用。错误：

RandState.hs:88:31:
    Occurs check: cannot construct the infinite type: a0 = [a0]
    Expected type: [a0] -> [a0]
      Actual type: [a0] -> a0
    In the first argument of `iterate', namely `f'
    In the second argument of `take', namely `(iterate f deck)'
    In the second argument of `($)', namely `take 52 (iterate f deck)'

我想问题是 iterate 接受一个值，将一个函数应用于该值，将该函数应用于结果，等等，返回一个无限的结果列表。我正在处理一个迭代函数，该函数接受一个列表并返回一张卡片，因此结果不能传递给下一次迭代。解决这个问题（4）的更好方法是什么？我还担心我的 removeCard 函数有点笨拙，因为它只是将“已移除”的卡片放在前面，我这样做是为了让 shuffleDeck 更容易编写。如有必要，解决此问题 (3) 的更好方法是什么？

谢谢， 杰夫

Answer 1

你应该停止在你的函数中尝试runRandom。你应该只在你真正想要一个结果时使用runRandom（例如 - 打印结果，因为你不能在 monad 中这样做）。试图从 monad 中“逃脱”是一项徒劳的任务，您只会产生令人困惑且通常无法运行的代码。所有函数的最终输出都将在 monad 中，因此您无论如何都不需要转义。

注意

gen <- get
let n = runRandom (randR(1, length (deck))) gen :: Int

完全等价于

n <- randR (1, length deck)

<- 语法在右侧的 monad 中执行计算，并将其“放入”左侧的变量名中。

洗牌：

shuffleR [] = return []   
shuffleR xs = do      
  (y:ys) <- removeR xs  -- 1
  zs <- shuffleR ys     -- 2
  return (y:zs)         -- 3

函数是直接递归： 1）提取一个随机元素，2）洗牌剩下的，3）组合结果。

编辑：请求的额外信息：

randSum :: (Num b, Random b) => State StdGen b
randSum = do
  a <- randR (1,6) 
  b <- randR (1,6) 
  return $ a + b

编译得很好。从您对错误的描述来看，您正试图在 IO monad 中调用此函数。你不能混合单子（或者至少不那么简单）。如果你想在IO 内“执行”RandState 类型的东西，你确实必须在这里使用runRandom。

n <- randR (1, length deck) 使n 成为Int，因为length deck 具有Int 和randR :: Random a => (a, a) -> RandState a 类型，所以从上下文我们可以推断a ~ Int 并且类型统一为(Int, Int) -> RandState Int。

回顾一下

错误：

try = do
  a <- randomIO      :: IO Int
  b <- randR (0,10)  :: RandState Int
  return $ a + b     -- monads don't match!

对：

try = do
  a <- randomIO                                 :: IO Int
  let b = runRandom (randR (0,10)) (mkStdGen a) :: Int    -- 'execute' the randstate monad
  return $ a + b