module Moo.GeneticAlgorithm.Utilities
(
getRandomGenomes
, doCrossovers
, doNCrossovers
) where
import Moo.GeneticAlgorithm.Types
import Moo.GeneticAlgorithm.Random
import Control.Monad (replicateM)
randomGenomes :: (Random a, Ord a)
=> PureMT
-> Int
-> [(a, a)]
-> ([Genome a], PureMT)
randomGenomes :: PureMT -> Int -> [(a, a)] -> ([Genome a], PureMT)
randomGenomes PureMT
rng Int
n [(a, a)]
ranges =
let sortRange :: (b, b) -> (b, b)
sortRange (b
r1,b
r2) = (b -> b -> b
forall a. Ord a => a -> a -> a
min b
r1 b
r2, b -> b -> b
forall a. Ord a => a -> a -> a
max b
r1 b
r2)
ranges' :: [(a, a)]
ranges' = ((a, a) -> (a, a)) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> (a, a)
forall b. Ord b => (b, b) -> (b, b)
sortRange [(a, a)]
ranges
in (Rand PureMT [Genome a] -> PureMT -> ([Genome a], PureMT))
-> PureMT -> Rand PureMT [Genome a] -> ([Genome a], PureMT)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rand PureMT [Genome a] -> PureMT -> ([Genome a], PureMT)
forall g a. Rand g a -> g -> (a, g)
runRand PureMT
rng (Rand PureMT [Genome a] -> ([Genome a], PureMT))
-> Rand PureMT [Genome a] -> ([Genome a], PureMT)
forall a b. (a -> b) -> a -> b
$
Int -> RandT PureMT Identity (Genome a) -> Rand PureMT [Genome a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (RandT PureMT Identity (Genome a) -> Rand PureMT [Genome a])
-> RandT PureMT Identity (Genome a) -> Rand PureMT [Genome a]
forall a b. (a -> b) -> a -> b
$ ((a, a) -> RandT PureMT Identity a)
-> [(a, a)] -> RandT PureMT Identity (Genome a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (a, a) -> RandT PureMT Identity a
forall a. Random a => (a, a) -> Rand a
getRandomR [(a, a)]
ranges'
getRandomGenomes :: (Random a, Ord a)
=> Int
-> [(a, a)]
-> Rand [Genome a]
getRandomGenomes :: Int -> [(a, a)] -> Rand [Genome a]
getRandomGenomes Int
n [(a, a)]
ranges =
(PureMT -> ([Genome a], PureMT)) -> Rand [Genome a]
forall g a. (g -> (a, g)) -> Rand g a
liftRand ((PureMT -> ([Genome a], PureMT)) -> Rand [Genome a])
-> (PureMT -> ([Genome a], PureMT)) -> Rand [Genome a]
forall a b. (a -> b) -> a -> b
$ \PureMT
rng -> PureMT -> Int -> [(a, a)] -> ([Genome a], PureMT)
forall a.
(Random a, Ord a) =>
PureMT -> Int -> [(a, a)] -> ([Genome a], PureMT)
randomGenomes PureMT
rng Int
n [(a, a)]
ranges
doCrossovers :: [Genome a] -> CrossoverOp a -> Rand [Genome a]
doCrossovers :: [Genome a] -> CrossoverOp a -> Rand [Genome a]
doCrossovers [] CrossoverOp a
_ = [Genome a] -> Rand [Genome a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
doCrossovers [Genome a]
parents CrossoverOp a
xover = do
([Genome a]
children', [Genome a]
parents') <- CrossoverOp a
xover [Genome a]
parents
if [Genome a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Genome a]
children'
then [Genome a] -> Rand [Genome a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Genome a]
parents'
else do
[Genome a]
rest <- [Genome a] -> CrossoverOp a -> Rand [Genome a]
forall a. [Genome a] -> CrossoverOp a -> Rand [Genome a]
doCrossovers [Genome a]
parents' CrossoverOp a
xover
[Genome a] -> Rand [Genome a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome a] -> Rand [Genome a]) -> [Genome a] -> Rand [Genome a]
forall a b. (a -> b) -> a -> b
$ [Genome a]
children' [Genome a] -> [Genome a] -> [Genome a]
forall a. [a] -> [a] -> [a]
++ [Genome a]
rest
doNCrossovers :: Int
-> [Genome a]
-> CrossoverOp a
-> Rand [Genome a]
doNCrossovers :: Int -> [Genome a] -> CrossoverOp a -> Rand [Genome a]
doNCrossovers Int
_ [] CrossoverOp a
_ = [Genome a] -> Rand [Genome a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
doNCrossovers Int
n [Genome a]
parents CrossoverOp a
xover =
Int -> [[Genome a]] -> Rand [Genome a]
doAnotherNCrossovers Int
n []
where
doAnotherNCrossovers :: Int -> [[Genome a]] -> Rand [Genome a]
doAnotherNCrossovers Int
i [[Genome a]]
children
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Genome a] -> Rand [Genome a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome a] -> Rand [Genome a])
-> ([[Genome a]] -> [Genome a]) -> [[Genome a]] -> Rand [Genome a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Genome a] -> [Genome a]
forall a. Int -> [a] -> [a]
take Int
n ([Genome a] -> [Genome a])
-> ([[Genome a]] -> [Genome a]) -> [[Genome a]] -> [Genome a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Genome a]] -> [Genome a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Genome a]] -> Rand [Genome a])
-> [[Genome a]] -> Rand [Genome a]
forall a b. (a -> b) -> a -> b
$ [[Genome a]]
children
| Bool
otherwise = do
([Genome a]
children', [Genome a]
_) <- CrossoverOp a
xover CrossoverOp a
-> Rand [Genome a]
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Genome a] -> Rand [Genome a]
forall a. [a] -> Rand [a]
shuffle [Genome a]
parents
if [Genome a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Genome a]
children'
then Int -> [[Genome a]] -> Rand [Genome a]
doAnotherNCrossovers Int
0 [[Genome a]]
children
else Int -> [[Genome a]] -> Rand [Genome a]
doAnotherNCrossovers (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Genome a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Genome a]
children') ([Genome a]
children'[Genome a] -> [[Genome a]] -> [[Genome a]]
forall a. a -> [a] -> [a]
:[[Genome a]]
children)