diff options
author | sanine <sanine.not@pm.me> | 2023-11-29 02:59:51 -0600 |
---|---|---|
committer | sanine <sanine.not@pm.me> | 2023-11-29 02:59:51 -0600 |
commit | a506d45e16922bbda123f92dad55959694ccc2df (patch) | |
tree | 22df35c21398f907f0018c1452d0ffaa00f45cae /src/Genome.hs | |
parent | e8d7a5237c666a40e14f3709289329fd8c2cb7d2 (diff) |
implement individual gene mutation functions
Diffstat (limited to 'src/Genome.hs')
-rw-r--r-- | src/Genome.hs | 69 |
1 files changed, 69 insertions, 0 deletions
diff --git a/src/Genome.hs b/src/Genome.hs new file mode 100644 index 0000000..4fb063c --- /dev/null +++ b/src/Genome.hs @@ -0,0 +1,69 @@ +module Genome + ( Gene (..) + , Genome (..) + , mutateGeneSource + , mutateGeneSink + , mutateGeneWeight + , mutateGene + ) where + + +import Mind (NeuronIndex (..)) +import System.Random + + +data Gene = Gene { source :: NeuronIndex, sink :: NeuronIndex, weight :: Float } deriving (Eq, Show) +data Genome = Genome { numInput :: Int, numInternal :: Int, numOutput :: Int, genes :: [Gene] } deriving (Eq, Show) + + +-- 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') + + +-- pick a new random source for the gene +mutateGeneSource :: RandomGen a => Genome -> Gene -> a -> (Gene, a) +mutateGeneSource genome g r = + let + nInput = numInput genome + nInternal = numInternal genome + index :: Int + (index, r') = randomR (0, nInput+nInternal-1) r + source' = + if index < nInput + then Input index + else Internal $ index - nInput + in ( g { source = source' }, r') + + +-- pick a new random sink for the gene +mutateGeneSink :: RandomGen a => Genome -> Gene -> a -> (Gene, a) +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 + in ( g { sink = sink' }, r' ) + + +-- pick a new random weight, in the range (-w, w) +-- where w is twice the absolute value of the current weight +mutateGeneWeight :: RandomGen a => Genome -> Gene -> a -> (Gene, a) +mutateGeneWeight _ g r = + let + w = 2 * (abs $ weight g) + (weight', r') = randomR (negate w, w) r + in ( g { weight = weight' }, r' ) + + +-- randomly mutate gene (modify source, sink, or weight +mutateGene :: RandomGen a => Genome -> Gene -> a -> (Gene, a) +mutateGene genome g r = + let (f, r') = randomChoice [mutateGeneSource, mutateGeneSink, mutateGeneWeight] r + in f genome g r' |