module Moo.GeneticAlgorithm.Utilities
(
getRandomGenomes
, doCrossovers
, doNCrossovers
) where
import Moo.GeneticAlgorithm.Types
import Moo.GeneticAlgorithm.Random
import Control.Monad.Mersenne.Random
import Control.Monad (replicateM)
randomGenomes :: (Random a, Ord a)
=> PureMT
-> Int
-> [(a, a)]
-> ([Genome a], PureMT)
randomGenomes rng n ranges =
let sortRange (r1,r2) = (min r1 r2, max r1 r2)
ranges' = map sortRange ranges
in flip runRandom rng $
replicateM n $ mapM getRandomR ranges'
getRandomGenomes :: (Random a, Ord a)
=> Int
-> [(a, a)]
-> Rand ([Genome a])
getRandomGenomes n ranges =
Rand $ \rng ->
let (gs, rng') = randomGenomes rng n ranges
in R gs rng'
doCrossovers :: [Genome a] -> CrossoverOp a -> Rand [Genome a]
doCrossovers [] _ = return []
doCrossovers parents xover = do
(children', parents') <- xover parents
if null children'
then return []
else do
rest <- doCrossovers parents' xover
return $ children' ++ rest
doNCrossovers :: Int
-> [Genome a]
-> CrossoverOp a
-> Rand [Genome a]
doNCrossovers _ [] _ = return []
doNCrossovers n parents xover =
doAnotherNCrossovers n []
where
doAnotherNCrossovers i children
| i <= 0 = return . take n . concat $ children
| otherwise = do
(children', _) <- xover =<< shuffle parents
if (null children')
then doAnotherNCrossovers 0 children
else doAnotherNCrossovers (i length children') (children':children)