packages feed

lostcities-0.1: Utils.hs

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