随机置换大型列表(超过1亿个元素)

时间:2012-08-24 17:02:54

标签: haskell

我不关心以“功能”的方式做到这一点。但我确实需要它在线性时间(不是O(n log n)),我真的更喜欢类型签名保持完整(即,不添加其他类型约束)。这是我到目前为止所做的,但我一直在堆栈溢出:

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.STRef
import System.Random

randomPermute :: RandomGen g => [a] -> g -> ([a],g)
randomPermute l rgen = runST $ newListArray (1,n) l >>= body rgen where
  n = length l
  body :: RandomGen g => g -> STArray s Int e -> ST s ([e],g)
  body rgen arr = do
    rgenRef <- newSTRef rgen
    let pick i j   = do vi <- readArray arr i
                        vj <- readArray arr j
                        writeArray arr j vi
                        return vj
        rand lo hi = do rgen <- readSTRef rgenRef
                        let (v,rgen') = randomR (lo,hi) rgen
                        writeSTRef rgenRef rgen'
                        return v
    rv <- forM [1..n] $ \i -> do
        j <- rand i n
        pick i j
    rgen <- readSTRef rgenRef
    return (rv,rgen)

ascCount x = sum $ map oneIfBig $ zip x $ tail x where
  oneIfBig (x,y) = if x<y then 0 else 1

main = do
  -- Using String types just for testing
  res <- getStdRandom $ randomPermute $ map show [1..1000000]
  putStrLn $ show $ ascCount res

现在我与命令式语言的交易告诉我应该有办法避免一起使用堆栈。但在Haskell,我似乎无法弄清楚如何。我找到了一些方法,如果我使用未装箱的数组。但就像我说的,我宁愿不添加额外的约束。有什么想法吗?

编辑:如果有人能向我解释上面的代码是如何消耗堆栈空间的话,我也很感激,以及为什么我不能简单地避免使用尾递归调用。我尝试在某些地方使用热切评估,但它没有帮助

2 个答案:

答案 0 :(得分:5)

随机列表置换可以在/ O(n)/(假设你有一个随机输入数组),通过向量包,使用backpermute操作完成。

backpermute :: Unbox a => Vector a -> Vector Int -> Vector a

/O(n)/
Yield the vector obtained by replacing each element i of the index vector by xs!i. This is equivalent to map (xs!) is but is often much more efficient.

 backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a>

您可以通过a number of packages.

创建有效的随机向量

答案 1 :(得分:0)

我想我自己找到了一个线性时间解决方案,所以我想我应该在这里添加它。显然,从forM或replicateM等monadic函数生成列表是一个坏主意。他们耗尽了堆栈空间。相反,我使用循环只是为了纯粹的命令式处理,然后将数组转换为循环外的列表。代码粘贴在下面。

如果有人感兴趣,有一个很棒的usenix帖子here以纯函数方式执行相同的操作,但使用O(n log n)时间。

randomPermute :: RandomGen g => [a] -> g -> ([a],g)
randomPermute x rgen = (body,rgen2) where
  (rgen1,rgen2) = split rgen
  body = elems $ runST $ do
    g   <- newSTRef rgen1
    arr <- newArray x
    let newInd st = do
          (i,rgen') <- liftM (randomR (st,n-1)) (readSTRef g)
          writeSTRef g rgen'
          return i
    forM_ [0..n-1] $ \i -> do
      j <- newInd i
      p <- readArray arr i
      q <- readArray arr j
      writeArray arr j p
      writeArray arr i q
    unsafeFreeze arr
  n = length x
  newArray :: [a] -> ST s (STArray s Int a)
  newArray x = newListArray (0,length x-1) x