Random Code, Permutations, and unsafePerformIO
module Permutation | |
( permute -- :: RandomGen g => [a] -> g -> ([a], g) | |
, permuteST -- :: RandomGen g => [a] -> g -> ST s ([a], g) | |
, permuteIO -- :: [a] -> IO [a] | |
, unsafePermute -- :: [a] -> [a] | |
) where | |
import Control.Monad ( foldM ) | |
-- N.B. Unsafe operations have been deprecated in the original module and have | |
-- been moved to Control.Monad.ST.Unsafe. | |
import Control.Monad.ST hiding ( unsafeIOToST ) | |
import Control.Monad.ST.Unsafe ( unsafeIOToST ) | |
import Data.Array.MArray | |
import Data.Array.ST | |
import System.IO.Unsafe ( unsafePerformIO ) | |
import System.Random | |
permute :: RandomGen g => [a] -> g -> ([a], g) | |
permute g xs = runST (permuteST g xs) | |
{-# NOINLINE unsafePermute #-} | |
unsafePermute :: [a] -> [a] | |
unsafePermute xs = unsafePerformIO (permuteIO xs) | |
permuteIO :: [a] -> IO [a] | |
permuteIO xs = do | |
stdGen <- getStdGen | |
(xs', _) <- stToIO (permuteST xs stdGen) | |
return xs' | |
permuteST :: RandomGen g => [a] -> g -> ST s ([a], g) | |
permuteST xs gen = do | |
let len = length xs | |
array <- newListArray (0, len - 1) xs | |
let rswap g i = let (j, g) = randomR (i, len - 1) g | |
in swap array i j >> return g | |
gen' <- foldM rswap gen [0..len -1] | |
xs' <- getElems array | |
return (xs', gen') | |
swap :: (Ix i) => STArray s i e -> i -> i -> ST s () | |
swap a i j = do | |
e1 <- readArray a j | |
e2 <- readArray a i | |
writeArray a i e1 | |
writeArray a j e2 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment