module GEP.Rmonad (
GEPMonad,
nextF,
nextR,
nextRDifferent,
nextRList,
nextRListUnique,
nextRListPairs,
generatePairs,
runRmonad
) where
import System.Random.Mersenne.Pure64
import Control.Monad.Mersenne.Random
type GEPMonad a = Rand a
nextF :: Double
-> Rand Double
nextF up = do x <- getDouble
return (x*up)
nextR :: Int
-> Rand Int
nextR up = do x <- getInt
return (1 + ((abs x) `mod` up))
nextRList :: Int
-> Int
-> Rand [Int]
nextRList 0 _ = do return []
nextRList n up = do val <- nextR up
vals <- nextRList (n1) up
return (val:vals)
removeNth :: [a] -> Int -> [a]
removeNth [] _ = []
removeNth (_:xs) 0 = (xs)
removeNth (x:xs) n = x:(removeNth xs (n1))
shuffle :: [Int] -> Rand [Int]
shuffle [] = do return []
shuffle x = do val <- nextR $ (length x)
rest <- shuffle $ (removeNth x (val1))
return ((x !! (val1)):rest)
pairify :: [Int] -> [(Int,Int)]
pairify [] = []
pairify (_:[]) = []
pairify (x:y:xs) = ((x,y):(pairify xs))
generatePairs :: Int -> Rand [(Int,Int)]
generatePairs 0 = do return []
generatePairs 1 = do return []
generatePairs n = do vals <- shuffle $! [1..n]
return $ (pairify vals)
nextRListUnique :: Int -> [Int] -> Int -> Rand [Int]
nextRListUnique 0 l _ = do return l
nextRListUnique n l up = do val <- nextR up
let t = foldr (||) False (map (\i -> i==val) l)
if t == True
then do ret <- nextRListUnique n l up
return ret
else do ret <- nextRListUnique (n1) (val:l) up
return ret
nextRListPairs :: Int -> Int -> Rand [(Int,Int)]
nextRListPairs 0 _ = do return []
nextRListPairs n up = do val1 <- nextR up
val2 <- nextRDifferent up val1
rest <- nextRListPairs (n1) up
return $ ((val1,val2):rest)
nextRDifferent :: Int
-> Int
-> Rand Int
nextRDifferent up x = do x' <- nextR up
if x' == x
then do x'' <- nextRDifferent up x
return x''
else return x'
runRmonad :: Rand a -> PureMT -> (a, PureMT)
runRmonad = runRandom