implement mutateGenomeAddGene

2 files changed, 90 insertions, 35 deletions

diff --git a/src/Genome.hs b/src/Genome.hs
index 500512c..927005e 100644
--- a/src/Genome.hs
+++ b/src/Genome.hs
@@ -8,6 +8,7 @@ module Genome
 
   , mutateGenomeAddInternal
   , mutateGenomeRemoveInternal
+  , mutateGenomeAddGene 
   ) where
 
 
@@ -111,8 +112,6 @@ validn g (Output x)
   | (inRange (0, numOutput g - 1) x) = Output x
   | otherwise = error "out of range Output!"
 
-
-
 incrementNeuron :: Genome -> NeuronIndex -> NeuronIndex
 incrementNeuron g (Input x)
   | (x >= numInput g - 1) = validn g (Internal 0)
@@ -124,7 +123,6 @@ incrementNeuron g (Output x)
   | (x >= numOutput g - 1) = error "cannot increment past the end of outputs!"
   | otherwise = validn g (Output $ x+1)
 
-
 decrementNeuron :: Genome -> NeuronIndex -> NeuronIndex
 decrementNeuron g (Input x)
   | (x <= 0) = error "cannot decrement past the first Input!"
@@ -139,3 +137,30 @@ decrementNeuron g (Output x)
 isInternal :: NeuronIndex -> Bool
 isInternal (Internal _) = True
 isInternal _ = False
+
+
+-- add a new, random gene
+mutateGenomeAddGene :: RandomGen a => Genome -> a -> (Genome, a)
+mutateGenomeAddGene g r =
+  let
+    (so, r') = randomSource g r
+    (si, r'') = randomSink g r'
+    (w, r''') = randomR (-4, 4) r''
+    gene = Gene so si w
+  in (g {genes = gene:(genes g)}, r''')
+
+    
+
+randomSource :: RandomGen a => Genome -> a -> (NeuronIndex, a)
+randomSource g r =
+  let
+    (idx, r') = randomR (0, numInput g + numInternal g - 1) r
+    result = if idx < numInput g then Input idx else Internal $ idx - numInput g
+  in (result, r')
+
+randomSink :: RandomGen a => Genome -> a -> (NeuronIndex, a)
+randomSink g r =
+  let
+    (idx, r') = randomR (0, numInternal g + numOutput g - 1) r
+    result = if idx < numInternal g then Internal idx else Output $ idx - numInput g
+  in (result, r')
diff --git a/test/GenomeTest.hs b/test/GenomeTest.hs
index 8448133..d775467 100644
--- a/test/GenomeTest.hs
+++ b/test/GenomeTest.hs
@@ -2,9 +2,11 @@ module GenomeTest (suite) where
 
 import Test.Tasty
 import Test.Tasty.HUnit
-import qualified Mind as M
+import Mind (NeuronIndex (..))
 import Genome
 import System.Random
+import Data.Ix
+
 
 suite :: TestTree
 suite = testGroup "genome tests" $
@@ -18,7 +20,7 @@ mutationTests = testGroup "mutations" $
     let
       rand = mkStdGen 1 -- randomR generates sequence (1, 2, 0, ...)
       genome = Genome { numInput = 2, numInternal = 1, numOutput = 5, genes = [] }
-      sourceGene = Gene { source = M.Input 0, sink = M.Output 1, weight = 4 }
+      sourceGene = Gene { source = Input 0, sink = Output 1, weight = 4 }
       mutatedGenes = fst $ foldl
         (\(list, r) g ->
           let (g', r') = mutateGeneSource genome g r
@@ -28,15 +30,15 @@ mutationTests = testGroup "mutations" $
         (replicate 3 sourceGene)
     in
       mutatedGenes @?=
-      [ Gene { source = M.Input 1, sink = M.Output 1, weight = 4 }
-      , Gene { source = M.Internal 0, sink = M.Output 1, weight = 4 }
-      , Gene { source = M.Input 0, sink = M.Output 1, weight = 4 }
+      [ Gene { source = Input 1, sink = Output 1, weight = 4 }
+      , Gene { source = Internal 0, sink = Output 1, weight = 4 }
+      , Gene { source = Input 0, sink = Output 1, weight = 4 }
       ]
   , testCase "mutating the sink of a gene" $
     let
       rand = mkStdGen 1 -- randomR generates sequence (1, 2, 0, ...)
       genome = Genome { numInput = 2, numInternal = 1, numOutput = 2, genes = [] }
-      sourceGene = Gene { source = M.Input 0, sink = M.Output 1, weight = 4 }
+      sourceGene = Gene { source = Input 0, sink = Output 1, weight = 4 }
       mutatedGenes = fst $ foldl
         (\(list, r) g ->
           let (g', r') = mutateGeneSink genome g r
@@ -46,15 +48,15 @@ mutationTests = testGroup "mutations" $
         (replicate 3 sourceGene)
     in
       mutatedGenes @?=
-      [ Gene { source = M.Input 0, sink = M.Output 0, weight = 4 }
-      , Gene { source = M.Input 0, sink = M.Output 1, weight = 4 }
-      , Gene { source = M.Input 0, sink = M.Internal 0, weight = 4 }
+      [ Gene { source = Input 0, sink = Output 0, weight = 4 }
+      , Gene { source = Input 0, sink = Output 1, weight = 4 }
+      , Gene { source = Input 0, sink = Internal 0, weight = 4 }
       ]
   , testCase "mutating the weight of a gene" $
     let
       rand = mkStdGen 0 -- randomR generates sequence (7.572357,-1.4116564,-7.2413177, ...)
       genome = Genome { numInput = 2, numInternal = 1, numOutput = 2, genes = [] }
-      sourceGene = Gene { source = M.Input 0, sink = M.Output 1, weight = 4 }
+      sourceGene = Gene { source = Input 0, sink = Output 1, weight = 4 }
       mutatedGenes = fst $ foldl
         (\(list, r) g ->
           let (g', r') = mutateGeneWeight genome g r
@@ -63,9 +65,9 @@ mutationTests = testGroup "mutations" $
         ([], rand)
         (replicate 3 sourceGene)
       expected =
-        [ Gene { source = M.Input 0, sink = M.Output 1, weight = 7.572357}
-        , Gene { source = M.Input 0, sink = M.Output 1, weight = -1.4116564 }
-        , Gene { source = M.Input 0, sink = M.Output 1, weight = -7.2413177  }
+        [ Gene { source = Input 0, sink = Output 1, weight = 7.572357}
+        , Gene { source = Input 0, sink = Output 1, weight = -1.4116564 }
+        , Gene { source = Input 0, sink = Output 1, weight = -7.2413177  }
         ]
       approxEqual a b = abs (a-b) < 0.0001
     in do
@@ -82,9 +84,9 @@ mutationTests = testGroup "mutations" $
         , numInternal = 2
         , numOutput = 1
         , genes =
-          [ Gene { source = M.Input 0, sink = M.Internal 0, weight = 1.0 }
-          , Gene { source = M.Internal 0, sink = M.Internal 1, weight = 1.0 }
-          , Gene { source = M.Internal 1, sink = M.Output 0, weight = 1.0 }
+          [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 }
+          , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 }
+          , Gene { source = Internal 1, sink = Output 0, weight = 1.0 }
           ]
         }
       r = mkStdGen 5
@@ -103,10 +105,10 @@ mutationTests = testGroup "mutations" $
         , numInternal = 3
         , numOutput = 1
         , genes =
-          [ Gene { source = M.Input 0, sink = M.Internal 0, weight = 1.0 }
-          , Gene { source = M.Internal 0, sink = M.Internal 1, weight = 1.0 }
-          , Gene { source = M.Internal 1, sink = M.Internal 2, weight = 1.0 }
-          , Gene { source = M.Internal 2, sink = M.Output 0, weight = 1.0 }
+          [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 }
+          , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 }
+          , Gene { source = Internal 1, sink = Internal 2, weight = 1.0 }
+          , Gene { source = Internal 2, sink = Output 0, weight = 1.0 }
           ]
         }
       (genome', r') = mutateGenomeRemoveInternal genome r
@@ -126,23 +128,51 @@ mutationTests = testGroup "mutations" $
       (numOutput genome''') @?= (numOutput genome)
 
       (genes genome') @?=
-        [ Gene { source = M.Input 0, sink = M.Internal 0, weight = 1.0 }
-        , Gene { source = M.Internal 0, sink = M.Internal 1, weight = 1.0 }
-        , Gene { source = M.Internal 0, sink = M.Internal 1, weight = 1.0 }
-        , Gene { source = M.Internal 1, sink = M.Output 0, weight = 1.0 }
+        [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 }
+        , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 }
+        , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 }
+        , Gene { source = Internal 1, sink = Output 0, weight = 1.0 }
         ]
 
       (genes genome'') @?=
-        [ Gene { source = M.Input 0, sink = M.Internal 0, weight = 1.0 }
-        , Gene { source = M.Internal 0, sink = M.Internal 1, weight = 1.0 }
-        , Gene { source = M.Internal 1, sink = M.Output 0, weight = 1.0 }
-        , Gene { source = M.Internal 1, sink = M.Output 0, weight = 1.0 }
+        [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 }
+        , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 }
+        , Gene { source = Internal 1, sink = Output 0, weight = 1.0 }
+        , Gene { source = Internal 1, sink = Output 0, weight = 1.0 }
         ]
 
       (genes genome''') @?=
-        [ Gene { source = M.Input 0, sink = M.Internal 0, weight = 1.0 }
-        , Gene { source = M.Input 0, sink = M.Internal 0, weight = 1.0 }
-        , Gene { source = M.Internal 0, sink = M.Internal 1, weight = 1.0 }
-        , Gene { source = M.Internal 1, sink = M.Output 0, weight = 1.0 }
+        [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 }
+        , Gene { source = Input 0, sink = Internal 0, weight = 1.0 }
+        , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 }
+        , Gene { source = Internal 1, sink = Output 0, weight = 1.0 }
         ]
+  , testCase "add new gene" $
+    let 
+      genome = Genome 
+        { numInput = 1
+        , numInternal = 2
+        , numOutput = 1
+        , genes = []
+        }
+      r = mkStdGen 5
+      (genome', _) = mutateGenomeAddGene genome r
+      new = last $ genes genome'
+      -- checking sources
+      validSource (Input x) = inRange (0, numInput genome') x
+      validSource (Internal x) = inRange (0, numInternal genome') x
+      validSource (Output _) = False
+      -- checking sinks
+      validSink (Input _) = False
+      validSink (Internal x) = inRange(0, numInternal genome') x
+      validSink (Output x) = inRange(0, numOutput genome') x
+      w = weight new
+    in do
+      (numInput genome') @?= (numInput genome)
+      (numInternal genome') @?= (numInternal genome)
+      (numOutput genome') @?= (numOutput genome)
+      (length $ genes genome') @?= 1 + (length $ genes genome)
+      validSource (source new) @?= True
+      validSink (sink new) @?= True
+      (w >= -4) && (w <= 4) @?= True
   ]