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 n (xs,ys)
| n <= 0 = return (xs,ys)
| otherwise =
let len = min (length xs) (length ys)
in do
pos <- getRandomR (0, lenn)
let (hxs, txs) = splitAt pos xs
let (hys, tys) = splitAt pos ys
(rxs, rys) <- nPointCrossover (n1) (tys, txs)
return (hxs ++ rxs, hys ++ rys)
onePointCrossover :: Double -> CrossoverOp a
onePointCrossover _ [] = return ([],[])
onePointCrossover _ [celibate] = return ([],[celibate])
onePointCrossover p (g1:g2:rest) = do
(h1,h2) <- withProbability p (nPointCrossover 1) (g1, g2)
return ([h1,h2], rest)
twoPointCrossover :: Double -> CrossoverOp a
twoPointCrossover _ [] = return ([], [])
twoPointCrossover _ [celibate] = return ([],[celibate])
twoPointCrossover p (g1:g2:rest) = do
(h1,h2) <- withProbability p (nPointCrossover 2) (g1,g2)
return ([h1,h2], rest)
uniformCrossover :: Double -> CrossoverOp a
uniformCrossover _ [] = return ([], [])
uniformCrossover _ [celibate] = return ([],[celibate])
uniformCrossover p (g1:g2:rest) = do
(h1, h2) <- unzip `liftM` mapM swap (zip g1 g2)
return ([h1,h2], rest)
where
swap = withProbability p (\(a,b) -> return (b,a))