diff options
| -rw-r--r-- | src/Genome.hs | 89 | ||||
| -rw-r--r-- | src/Mind.hs | 2 | ||||
| -rw-r--r-- | test/GenomeTest.hs | 50 |
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 } + ] ] |