imlement mutateGenomeRemoveNeuron

2 files changed, 76 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