将 MonadRandom 与堆栈中的 ST 计算相结合

Question

我正在尝试使用可变数组编写 Fisher-Yates 随机播放。到目前为止，我有以下代码：

module Main where

import Control.Monad.Random
import Control.Monad.Primitive
import Control.Monad.ST

import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV

fisherYates :: (MonadRandom m, PrimMonad m) => MV.MVector (PrimState m) a -> m ()
fisherYates v = forM_ [0 .. l - 1] (\i -> do j <- getRandomR (i, l)
                                             MV.swap v i j)
  where l = MV.length v - 1

shuffle :: MonadRandom m => V.Vector a -> m (V.Vector a)
shuffle v = _ -- don't know how to write this

main :: IO ()
main = print . evalRand (shuffle . V.generate 10 $ id) $ mkStdGen 42

但是，我完全不确定如何定义 shuffle，这意味着 'high-level wrapper' 围绕可变向量操作。似乎（至少从我的理解），我首先必须 'run' 随机 'part' 堆栈，保存状态，运行 ST 'part' 才能退出一个不变的向量，然后重新包装整个东西。此外，我知道我必须在某处使用 thaw，但我的尝试很短。有人可以告诉我我缺少什么，以及我如何做我想做的事吗？

Answer 1

我有两个建议给你：

Select 正确的 monad 嵌套。
将 monad 实现与算法逻辑分开。

您正在尝试运行随机 monad 最后并在内部使用 ST，因此您需要 ST 成为一种 monad 转换器。确定你的 monad 堆栈是什么样子的——哪个 monad 是转换器，哪个是内部 monad？最简单的做法是让 ST monad 成为 inner monad，让 random monad 成为 transformer（这很简单，因为你已经有了所有需要的包）。

现在制作一小组辅助函数。它不会在这里真正得到回报 - 复杂项目的回报很大。这是我想出的 monad 堆栈和助手：

{-# LANGUAGE RankNTypes #-}
module Main where

import System.Random (StdGen)
import Control.Monad.Random
import Control.Monad.Primitive
import Control.Monad.ST

import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV


type KozM s a = RandT StdGen (ST s) a

注意转换器是 RandT 和 ST s 的内部单子。

rnd :: (Int,Int) -> KozM s Int
rnd = getRandomR

swp :: MV.MVector s a -> Int -> Int -> KozM s ()
swp v i j = lift (MV.swap v i j)

freeze :: MV.MVector s a -> KozM s (V.Vector    a)
thaw   :: V.Vector     a -> KozM s (MV.MVector s a)
freeze = lift . V.freeze
thaw   = lift . V.thaw

变异向量所需的所有操作。现在我们只需要运行这个 monad 这样我们就可以以某种方式逃脱到另一个有用的上下文。我注意到您之前硬编码了一个 RNG (42) - 我使用了一个随机的，但无论哪个...

run :: (forall s. KozM s a) -> IO a -- Can be just `a` if you hard-code
                                    -- an RNG as done in the question
run m = do g <- newStdGen
           pure (runST (evalRandT m g))

终于可以用这个monad来实现f-y了：

fisherYates :: MV.MVector s a -> KozM s ()
fisherYates v = forM_ [0 .. l - 1] (\i -> do j <- rnd (i, l)
                                             swp v i j)
  where l = MV.length v - 1

在这一点上，您可能不会觉得自己学到了任何东西，希望运行功能对您有所帮助，但我明白您可能会觉得这变得冗长了。这里要注意的重要一点是，如果你处理上面的 monad 的管道，你的代码的其余部分会有多干净，所以你没有 lift 和模块限定符污染你可能复杂的东西的逻辑其实着手解决。

也就是说，这是令人印象深刻的洗牌：

shuffle :: V.Vector a -> KozM s (V.Vector a)
shuffle v = do
    vm <- thaw v
    fisherYates vm
    freeze vm

类型很重要。您之前曾在 shuffle 上调用过 evalRand，这意味着它会是某种 MonadRandom m 并且同时必须调用 runST - monad 逻辑和算法逻辑的混合只会伤害大脑.

主要无趣：

main :: IO ()
main = print =<< (run (shuffle (V.generate 10 id)) :: IO (V.Vector Int))

编辑：是的，您可以在保持方法更通用的同时做到这一点。在某些时候，您需要指定哪个 monad 运行，否则您不能有一个 main 来执行它，但是所有逻辑都可以使用 MonadRandom 和 PrimMonad。

{-# LANGUAGE RankNTypes #-}
module Main where

import System.Random (StdGen)
import Control.Monad.Random
import Control.Monad.Primitive
import Control.Monad.ST

import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
type KozM s a = RandT StdGen (ST s) a

rnd  :: MonadRandom m => (Int, Int) -> m Int
rnd = getRandomR

swp :: PrimMonad m => MV.MVector (PrimState m)  a -> Int -> Int -> m ()
swp v i j = MV.swap v i j

-- freeze :: MV.MVector s a -> KozM s (V.Vector    a)
-- thaw   :: V.Vector     a -> KozM s (MV.MVector s a)
freeze :: PrimMonad m => MV.MVector (PrimState m) a -> m (V.Vector a)
thaw :: PrimMonad m => V.Vector a -> m (MV.MVector (PrimState m) a)
freeze = V.freeze
thaw   = V.thaw


-- Some monad libraries, like monadlib, have a generalized `run` class method.
-- This doesn't exist, to the best of my knowledge, for the intersection of ST
-- and mtl.
run :: (forall s. KozM s a) -> IO a -- Can be just `a` if you hard-code
                                    -- an RNG as done in the question
run m = do g <- newStdGen
           pure (runST (evalRandT m g))

-- fisherYates :: MV.MVector s a -> KozM s ()
fisherYates :: (MonadRandom m, PrimMonad m) => MV.MVector (PrimState m) a -> m ()
fisherYates v = forM_ [0 .. l - 1] (\i -> do j <- rnd (i, l)
                                             swp v i j)
  where l = MV.length v - 1

shuffle :: (MonadRandom m, PrimMonad m) => V.Vector a -> m (V.Vector a)
shuffle v = do
    vm <- thaw v
    fisherYates vm
    freeze vm

main :: IO ()
main = print =<< (run (shuffle (V.generate 10 id)) :: IO (V.Vector Int))

将 MonadRandom 与堆栈中的 ST 计算相结合

Combining MonadRandom with ST computations in a stack

arrays

haskell

shuffle