module Moo.GeneticAlgorithm.Random
(
getRandomR
, getRandom
, getNormal2
, getNormal
, randomSample
, shuffle
, withProbability
, getBool, getInt, getWord, getInt64, getWord64, getDouble
, runRandom, evalRandom, newPureMT
, Rand, Random, PureMT
) where
import Control.Monad (liftM)
import Control.Monad.Mersenne.Random
import Data.Complex (Complex (..))
import System.Random (RandomGen, Random(..))
import System.Random.Mersenne.Pure64
import qualified System.Random.Shuffle as S
getRandomR :: Random a => (a, a) -> Rand a
getRandomR range = Rand $ \s -> let (r, s') = randomR range s in R r s'
getRandom :: Random a => Rand a
getRandom = Rand $ \g -> let (r, g') = random g in R r g'
getNormal2 :: Rand (Double, Double)
getNormal2 = do
u <- getDouble
v <- getDouble
let (c :+ s) = exp (0 :+ (2*pi*v))
let r = sqrt $ (2) * log u
return (r*c, r*s)
getNormal :: Rand Double
getNormal = fst `liftM` getNormal2
randomSample :: Int -> [a] -> Rand [a]
randomSample n xs =
Rand $ \g -> case select g n (length xs) xs [] of (xs', g') -> R xs' g'
where
select rng _ _ [] acc = (reverse acc, rng)
select rng n m xs acc
| n <= 0 = (reverse acc, rng)
| otherwise =
let (k, rng') = randomR (0, m n) rng
(x:rest) = drop k xs
in select rng' (n1) (mk1) rest (x:acc)
shuffle :: [a] -> Rand [a]
shuffle xs = Rand $ \g ->
let (xs', g') = randomShuffle xs (length xs) g in R xs' g'
randomShuffle :: RandomGen gen => [a] -> Int -> gen -> ([a], gen)
randomShuffle elements len g =
let (rs, g') = rseq len g
in (S.shuffle elements rs, g')
where
rseq :: RandomGen gen => Int -> gen -> ([Int], gen)
rseq n g = second lastGen . unzip $ rseq' (n 1) g
where
rseq' :: RandomGen gen => Int -> gen -> [(Int, gen)]
rseq' i gen
| i <= 0 = []
| otherwise = let (j, gen') = randomR (0, i) gen
in (j, gen') : rseq' (i 1) gen'
second :: (b -> c) -> (a, b) -> (a, c)
second f (x,y) = (x, f y)
lastGen [] = g
lastGen (lst:[]) = lst
lastGen gens = lastGen (drop 1 gens)
withProbability :: Double -> (a -> Rand a) -> (a -> Rand a)
withProbability p modify x = do
t <- getDouble
if t < p
then modify x
else return x