module Moo.GeneticAlgorithm.Crossover
(
onePointCrossover
, twoPointCrossover
, uniformCrossover
, noCrossover
, doCrossovers
, doNCrossovers
) where
import Moo.GeneticAlgorithm.Random
import Moo.GeneticAlgorithm.Types
import Moo.GeneticAlgorithm.Utilities
import Control.Monad (liftM)
nPointCrossover :: Int -> ([a], [a]) -> Rand ([a], [a])
nPointCrossover :: Int -> ([a], [a]) -> Rand ([a], [a])
nPointCrossover Int
n ([a]
xs,[a]
ys)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([a], [a]) -> Rand ([a], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
xs,[a]
ys)
| Bool
otherwise =
let len :: Int
len = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys)
in do
Int
pos <- (Int, Int) -> Rand Int
forall a. Random a => (a, a) -> Rand a
getRandomR (Int
0, Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)
let ([a]
hxs, [a]
txs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pos [a]
xs
let ([a]
hys, [a]
tys) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pos [a]
ys
([a]
rxs, [a]
rys) <- Int -> ([a], [a]) -> Rand ([a], [a])
forall a. Int -> ([a], [a]) -> Rand ([a], [a])
nPointCrossover (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([a]
tys, [a]
txs)
([a], [a]) -> Rand ([a], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
hxs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rxs, [a]
hys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rys)
onePointCrossover :: Double -> CrossoverOp a
onePointCrossover :: Double -> CrossoverOp a
onePointCrossover Double
_ [] = ([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
onePointCrossover Double
_ [Genome a
celibate] = ([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[Genome a
celibate])
onePointCrossover Double
p (Genome a
g1:Genome a
g2:[Genome a]
rest) = do
(Genome a
h1,Genome a
h2) <- Double
-> ((Genome a, Genome a) -> Rand (Genome a, Genome a))
-> (Genome a, Genome a)
-> Rand (Genome a, Genome a)
forall a. Double -> (a -> Rand a) -> a -> Rand a
withProbability Double
p (Int -> (Genome a, Genome a) -> Rand (Genome a, Genome a)
forall a. Int -> ([a], [a]) -> Rand ([a], [a])
nPointCrossover Int
1) (Genome a
g1, Genome a
g2)
([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome a
h1,Genome a
h2], [Genome a]
rest)
twoPointCrossover :: Double -> CrossoverOp a
twoPointCrossover :: Double -> CrossoverOp a
twoPointCrossover Double
_ [] = ([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
twoPointCrossover Double
_ [Genome a
celibate] = ([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[Genome a
celibate])
twoPointCrossover Double
p (Genome a
g1:Genome a
g2:[Genome a]
rest) = do
(Genome a
h1,Genome a
h2) <- Double
-> ((Genome a, Genome a) -> Rand (Genome a, Genome a))
-> (Genome a, Genome a)
-> Rand (Genome a, Genome a)
forall a. Double -> (a -> Rand a) -> a -> Rand a
withProbability Double
p (Int -> (Genome a, Genome a) -> Rand (Genome a, Genome a)
forall a. Int -> ([a], [a]) -> Rand ([a], [a])
nPointCrossover Int
2) (Genome a
g1,Genome a
g2)
([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome a
h1,Genome a
h2], [Genome a]
rest)
uniformCrossover :: Double -> CrossoverOp a
uniformCrossover :: Double -> CrossoverOp a
uniformCrossover Double
_ [] = ([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
uniformCrossover Double
_ [Genome a
celibate] = ([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[Genome a
celibate])
uniformCrossover Double
p (Genome a
g1:Genome a
g2:[Genome a]
rest) = do
(Genome a
h1, Genome a
h2) <- [(a, a)] -> (Genome a, Genome a)
forall a b. [(a, b)] -> ([a], [b])
unzip ([(a, a)] -> (Genome a, Genome a))
-> RandT PureMT Identity [(a, a)]
-> RandT PureMT Identity (Genome a, Genome a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ((a, a) -> RandT PureMT Identity (a, a))
-> [(a, a)] -> RandT PureMT Identity [(a, 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, a)
forall b. (b, b) -> Rand (b, b)
swap (Genome a -> Genome a -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip Genome a
g1 Genome a
g2)
([Genome a], [Genome a])
-> RandT PureMT Identity ([Genome a], [Genome a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Genome a
h1,Genome a
h2], [Genome a]
rest)
where
swap :: (b, b) -> Rand (b, b)
swap = Double -> ((b, b) -> Rand (b, b)) -> (b, b) -> Rand (b, b)
forall a. Double -> (a -> Rand a) -> a -> Rand a
withProbability Double
p (\(b
a,b
b) -> (b, b) -> Rand (b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b,b
a))