Added more operators.

groscoe · Oct 21, 2018 · 93fe590 · 93fe590
1 parent be5d870
commit 93fe590
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 2 deletions.
diff --git 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
@@ -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)