我不关心以“功能”的方式做到这一点。但我确实需要它在线性时间(不是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,我似乎无法弄清楚如何。我找到了一些方法,如果我使用未装箱的数组。但就像我说的,我宁愿不添加额外的约束。有什么想法吗?
编辑:如果有人能向我解释上面的代码是如何消耗堆栈空间的话,我也很感激,以及为什么我不能简单地避免使用尾递归调用。我尝试在某些地方使用热切评估,但它没有帮助答案 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>
创建有效的随机向量
答案 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