add mutateGenome

1 files changed, 27 insertions, 0 deletions

diff --git a/src/Genome.hs b/src/Genome.hs
index e0091b9..cb90ed1 100644
--- a/src/Genome.hs
+++ b/src/Genome.hs
@@ -10,6 +10,8 @@ module Genome
   , mutateGenomeRemoveInternal
   , mutateGenomeAddGene 
   , mutateGenomeRemoveGene 
+
+  , mutateGenome
   ) where
 
 
@@ -172,3 +174,28 @@ mutateGenomeRemoveGene g r =
     (idx, r') = randomR (0, (length $ genes g) - 1) r
     (front, _:back) = splitAt idx (genes g)
   in (g {genes = front ++ back}, r')
+
+
+-- mutate a random gene
+mutateGenomeMutateGene :: RandomGen a => Genome -> a -> (Genome, a)
+mutateGenomeMutateGene g r =
+  let
+    (idx, r') = randomR (0, length (genes g) - 1) r
+    gene = (genes g) !! idx
+    (gene', r'') = mutateGene g gene r'
+    (front, _:back) = splitAt idx (genes g)
+  in (g {genes = front ++ (gene':back)}, r'')
+
+
+-- mutate a genome
+mutateGenome :: RandomGen a => Genome -> a -> (Genome, a)
+mutateGenome g r =
+  let 
+    (f, r') = randomChoice (concat 
+      [ replicate 9 mutateGenomeMutateGene
+      , replicate 2 mutateGenomeAddGene
+      , replicate 2 mutateGenomeRemoveGene
+      , [mutateGenomeAddInternal, mutateGenomeRemoveInternal]
+      ]
+      ) r
+  in f g r'