Haskell: Shuffling deck

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)) 

Вот мой код, который я только что написал внутри RandS tate.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)' 

Я предполагаю, что проблема в том, что итерация принимает значение, применяет функцию к этому значению, функция применяется к результату, и так далее, возвращая бесконечный список результатов. Я передаю итерацию функции, которая принимает список, и возвращает карту, поэтому результат не может быть передан следующей итерации. Каким будет лучший способ подойти к этой проблеме (4)? Я также обеспокоен тем, что моя функция removeCard немного дергается, поскольку она просто помещает «удаленную» карту спереди, что я сделал, чтобы сделать shuffleDeck легче писать. В случае необходимости лучше всего подойти к этой проблеме (3)?

Спасибо, Джефф

Answer 1

Вы должны перестать пытаться runRandom внутри ваших функций. Вы должны использовать только runRandom, как только вы действительно хотите получить результат (например, для печати результата, так как вы не можете сделать это внутри монады). Попытка «убежать» от монады - бесполезная задача, и вы будете создавать только запутывающий и часто не функционирующий код. Окончательный вывод всех ваших функций будет находиться внутри монады, поэтому вам не нужно бежать в любом случае.

Обратите внимание, что

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

в точности эквивалентно

n <- randR (1, length deck) 

<- синтаксиса выполняет вычисления в монаде справа и «пут» его в имя переменной слева.

Перетасовка:

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. Вы не можете смешивать монады (или, по крайней мере, не так просто). Если вы хотите «выполнить» что-то типа RandState внутри IO, вам действительно нужно будет использовать runRandom здесь.

n <- randR (1, length deck) делает nInt, потому что 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