From 93fe5900158194c60e00edc20b91c2440ea8c77c Mon Sep 17 00:00:00 2001 From: groscoe Date: Sun, 21 Oct 2018 13:58:02 -0300 Subject: [PATCH] Added more operators. --- src/Algorithm/Evolutionary/Operators/Mutation.hs | 10 +++++++++- src/Algorithm/Evolutionary/Operators/Recombination.hs | 9 ++++++++- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/src/Algorithm/Evolutionary/Operators/Mutation.hs b/src/Algorithm/Evolutionary/Operators/Mutation.hs index db354c0..f7132d3 100644 --- a/src/Algorithm/Evolutionary/Operators/Mutation.hs +++ b/src/Algorithm/Evolutionary/Operators/Mutation.hs @@ -1,5 +1,6 @@ module Algorithm.Evolutionary.Operators.Mutation ( - swapAlleles + swapAlleles, + flipBit ) where import Control.Monad.Random.Class @@ -18,3 +19,10 @@ swap i j = swap' (i-1) (j-1) zipWith (\x y -> if x == f then xs !! s else if x == s then xs !! f else y) [0..] xs + + +flipBit :: MonadRandom m => Double -> [Bool] -> m [Bool] +flipBit mutationProbability = mapM (flipIfSmallerThan mutationProbability) + where flipIfSmallerThan x bit = do + r <- getRandomR (0, 0.1) + pure $ if r <= x then not bit else bit diff --git a/src/Algorithm/Evolutionary/Operators/Recombination.hs b/src/Algorithm/Evolutionary/Operators/Recombination.hs index fc595bd..236acb9 100644 --- a/src/Algorithm/Evolutionary/Operators/Recombination.hs +++ b/src/Algorithm/Evolutionary/Operators/Recombination.hs @@ -1,5 +1,6 @@ module Algorithm.Evolutionary.Operators.Recombination ( - cutAndCrossFill + cutAndCrossFill, + crossover ) where cutAndCrossFill :: Eq a => Int -> [a] -> [a] -> ([a], [a]) @@ -10,3 +11,9 @@ cutAndCrossFill n i1 i2 = r1 = take m $ filter (not . (`elem` l1)) i2 r2 = take m $ filter (not . (`elem` l2)) i1 in (l1 ++ r1, l2 ++ r2) + +crossover :: Int -> [a] -> [a] -> ([a], [a]) +crossover point xs ys = + let (x1, x2) = splitAt point xs + (y1, y2) = splitAt point ys + in (x1 ++ y2, y1 ++ x2)