{-
Miscelaneous utility functions
Pedro Vasconcelos, 2009
-}
module Utils where
import Random
import Data.Array.MArray
import Data.Array.IO
--
-- Knuth-Fisher-Yates shuffling algorithm
--
shuffleIO :: [a] -> IO [a]
shuffleIO xs
= do { arr <- newListArray (0,n) [0..n] :: IO (IOUArray Int Int)
; sequence_ [do { j<-randomRIO (i,n)
; t1<-readArray arr i
; t2<-readArray arr j
; writeArray arr i t2
; writeArray arr j t1
} | i<-[0..n-1]]
; sequence [do j<-readArray arr i
return (xs!!j) | i<-[0..n]]
}
where n = length xs - 1
-- an auxilary function to shuffle a list randomly
shuffleRnd :: RandomGen g => g -> [a] -> ([a], g)
shuffleRnd g xs = shuffle' g xs (length xs)
where
shuffle' :: RandomGen g => g -> [a] -> Int -> ([a], g)
shuffle' g xs n
| n>0 = let (k, g') = randomR (0,n-1) g
(xs',x:xs'') = splitAt k xs
(ys,g'') = shuffle' g' (xs' ++ xs'') (n-1)
in (x:ys, g'')
| otherwise = ([],g)
-- randomly-generated list of shuffles
nshuffles :: RandomGen g => g -> Int -> [a] -> ([[a]], g)
nshuffles g n cards
| n>0 = let (first,g')= shuffleRnd g cards
(rest, g'') = nshuffles g' (n-1) cards
in (first:rest, g'')
| otherwise = ([], g)
-- deterministic shuffle
shuffle :: [a] -> [a]
shuffle [] = []
shuffle (x:xs) = x : shuffle (reverse xs)