imlement mutateGenomeRemoveNeuron

3 files changed, 126 insertions, 15 deletions

diff --git a/src/Genome.hs b/src/Genome.hs
index c3fc361..500512c 100644
--- a/src/Genome.hs
+++ b/src/Genome.hs
@@ -7,11 +7,13 @@ module Genome
   , mutateGene
 
   , mutateGenomeAddInternal
+  , mutateGenomeRemoveInternal
   ) where
 
 
 import Mind (NeuronIndex (..))
 import System.Random
+import Data.Ix
 
 
 data Gene = Gene { source :: NeuronIndex, sink :: NeuronIndex, weight :: Float } deriving (Eq, Show)
@@ -21,8 +23,8 @@ data Genome = Genome { numInput :: Int, numInternal :: Int, numOutput :: Int, ge
 -- choose a random list element
 randomChoice :: RandomGen a => [b] -> a -> (b, a)
 randomChoice xs r =
-  let (index, r') = randomR (0, length xs - 1) r
-  in (xs !! index, r')
+  let (idx, r') = randomR (0, length xs - 1) r
+  in (xs !! idx, r')
 
 
 -- pick a new random source for the gene
@@ -31,12 +33,12 @@ mutateGeneSource genome g r =
   let 
     nInput = numInput genome
     nInternal = numInternal genome
-    index :: Int
-    (index, r') = randomR (0, nInput+nInternal-1) r
+    idx :: Int
+    (idx, r') = randomR (0, nInput+nInternal-1) r
     source' = 
-      if index < nInput
-        then Input index
-        else Internal $ index - nInput
+      if idx < nInput
+        then Input idx
+        else Internal $ idx - nInput
   in ( g { source = source' }, r')
 
 
@@ -46,11 +48,11 @@ mutateGeneSink genome g r =
   let
     nInternal = numInternal genome
     nOutput = numOutput genome
-    index :: Int
-    (index, r') = randomR (0, nInternal+nOutput-1) r
-    sink' = if index < nInternal
-      then Internal index
-      else Output $ index - nInternal
+    idx :: Int
+    (idx, r') = randomR (0, nInternal+nOutput-1) r
+    sink' = if idx < nInternal
+      then Internal idx
+      else Output $ idx - nInternal
   in ( g { sink = sink' }, r' )
 
 
@@ -61,7 +63,7 @@ mutateGeneWeight _ g r =
   let
     w = 2 * (abs $ weight g)
     (weight', r') = randomR (negate w, w) r
-  in ( g { weight = weight' }, r' )
+ in ( g { weight = weight' }, r' )
 
 
 -- randomly mutate gene (modify source, sink, or weight
@@ -77,4 +79,63 @@ mutateGenomeAddInternal genome r = (genome { numInternal = 1 + numInternal genom
 
 -- remove an internal neuron, decrementing sources and incrementing sinks
 mutateGenomeRemoveInternal :: RandomGen a => Genome -> a -> (Genome, a)
-mutateGenomeRemoveInternal = undefined
+mutateGenomeRemoveInternal g r =
+  let
+    (idx, r') = randomR (0, numInternal g - 1) r
+    remove = Internal idx 
+    genes' = map
+      (\(Gene so si w) ->
+        let
+          so' = if (isInternal so) && (so >= remove)
+            then decrementNeuron g so else so
+          si' = if (si < remove) || (not $ isInternal si) then si
+            else if si == remove
+              then
+                let si'' = incrementNeuron g si
+                in if isInternal si'' then si else si''
+              else decrementNeuron g si 
+        in Gene {source=so', sink=si', weight=w}
+      )
+      (genes g)
+  in
+    (g { numInternal = (numInternal g - 1), genes = genes' }, r')
+
+validn :: Genome -> NeuronIndex -> NeuronIndex
+validn g (Input x)
+  | (inRange (0, numInput g - 1) x) = Input x
+  | otherwise = error "out of range Input!"
+validn g (Internal x)
+  | (inRange (0, numInternal g - 1) x) = Internal x
+  | otherwise = error "out of range Internal!"
+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)
+  | otherwise = validn g (Input $ x+1)
+incrementNeuron g (Internal x)
+  | (x >= numInternal g - 1) = validn g (Output 0)
+  | otherwise = validn g (Internal $ x+1)
+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!"
+  | otherwise = validn g (Input $ x-1)
+decrementNeuron g (Internal x)
+  | (x <= 0) = validn g (Input $ numInput g - 1)
+  | otherwise = validn g (Internal $ x-1)
+decrementNeuron g (Output x)
+  | (x <= 0) = validn g (Internal $ numInternal g - 1)
+  | otherwise = validn g (Output $ x-1)
+
+isInternal :: NeuronIndex -> Bool
+isInternal (Internal _) = True
+isInternal _ = False
diff --git a/src/Mind.hs b/src/Mind.hs
index d686e24..010d83b 100644
--- a/src/Mind.hs
+++ b/src/Mind.hs
@@ -14,7 +14,7 @@ import Data.Ix
 import Data.Maybe
 
 -- index different neuron types
-data NeuronIndex = Input Int | Internal Int | Output Int deriving (Show, Eq)
+data NeuronIndex = Input Int | Internal Int | Output Int deriving (Show, Eq, Ord)
 
 getNeuronIndex :: NeuronIndex -> Int
 getNeuronIndex (Input i)    = i
diff --git a/test/GenomeTest.hs b/test/GenomeTest.hs
index 56499a1..8448133 100644
--- a/test/GenomeTest.hs
+++ b/test/GenomeTest.hs
@@ -95,4 +95,54 @@ mutationTests = testGroup "mutations" $
       (numInternal genome') @?= (1 + numInternal genome)
       (numOutput genome') @?= (numOutput genome)
       (genes genome') @?= (genes genome)
+  , testCase "remove internal neuron" $
+    let 
+      r = mkStdGen 1 -- randomR (0, 2) produces (1, 2, 0, ...)
+      genome = Genome 
+        { numInput = 1
+        , 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 }
+          ]
+        }
+      (genome', r') = mutateGenomeRemoveInternal genome r
+      (genome'', r'') = mutateGenomeRemoveInternal genome r'
+      (genome''', _) = mutateGenomeRemoveInternal genome r''
+    in do
+      (numInput genome') @?= (numInput genome)
+      (numInput genome'') @?= (numInput genome)
+      (numInput genome''') @?= (numInput genome)
+
+      (numInternal genome') @?= (numInternal genome - 1)
+      (numInternal genome'') @?= (numInternal genome - 1)
+      (numInternal genome''') @?= (numInternal genome - 1)
+
+      (numOutput genome') @?= (numOutput genome)
+      (numOutput genome'') @?= (numOutput genome)
+      (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 }
+        ]
+
+      (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 }
+        ]
+
+      (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 }
+        ]
   ]