diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Genome.hs | 89 | ||||
| -rw-r--r-- | src/Mind.hs | 2 |
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 |