{- 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)