Skip to content

Instantly share code, notes, and snippets.

@seliopou
Created July 17, 2013 16:10
Show Gist options
  • Save seliopou/6022010 to your computer and use it in GitHub Desktop.
Save seliopou/6022010 to your computer and use it in GitHub Desktop.
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