diff options
| -rw-r--r-- | nerine.cabal | 5 | ||||
| -rw-r--r-- | package.yaml | 1 | ||||
| -rw-r--r-- | src/Genome.hs | 69 | ||||
| -rw-r--r-- | test/GenomeTest.hs | 72 | ||||
| -rw-r--r-- | test/Main.hs | 2 |
5 files changed, 149 insertions, 0 deletions
diff --git a/nerine.cabal b/nerine.cabal index 52b1c4a..7592604 100644 --- a/nerine.cabal +++ b/nerine.cabal @@ -25,6 +25,7 @@ source-repository head library exposed-modules: + Genome Lib Mind other-modules: @@ -36,6 +37,7 @@ library ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 + , random , tasty , tasty-hunit default-language: Haskell2010 @@ -52,6 +54,7 @@ executable nerine-exe build-depends: base >=4.7 && <5 , nerine + , random , tasty , tasty-hunit default-language: Haskell2010 @@ -60,6 +63,7 @@ test-suite nerine-test type: exitcode-stdio-1.0 main-is: Main.hs other-modules: + GenomeTest MindTest Paths_nerine autogen-modules: @@ -70,6 +74,7 @@ test-suite nerine-test build-depends: base >=4.7 && <5 , nerine + , random , tasty , tasty-hunit default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index bd8c0f2..f0d605b 100644 --- a/package.yaml +++ b/package.yaml @@ -23,6 +23,7 @@ dependencies: - base >= 4.7 && < 5 - tasty - tasty-hunit +- random ghc-options: - -Wall 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' diff --git a/test/GenomeTest.hs b/test/GenomeTest.hs new file mode 100644 index 0000000..0a27a94 --- /dev/null +++ b/test/GenomeTest.hs @@ -0,0 +1,72 @@ +module GenomeTest (suite) where + +import Test.Tasty +import Test.Tasty.HUnit +import qualified Mind as M +import Genome +import System.Random + +suite :: TestTree +suite = testGroup "genome tests" $ + [ mutationTests + ] + + +mutationTests :: TestTree +mutationTests = testGroup "mutations" $ + [ testCase "mutating the source of a gene" $ + let + rand = mkStdGen 1 -- randomR generates sequence (1, 2, 0, ...) + genome = Genome { numInput = 2, numInternal = 1, numOutput = 5, genes = [] } + sourceGene = Gene { source = M.Input 0, sink = M.Output 1, weight = 4 } + mutatedGenes = fst $ foldl + (\(list, r) g -> + let (g', r') = mutateGeneSource genome g r + in (list ++ [g'], r') + ) + ([], rand) + (replicate 3 sourceGene) + in + mutatedGenes @?= + [ Gene { source = M.Input 1, sink = M.Output 1, weight = 4 } + , Gene { source = M.Internal 0, sink = M.Output 1, weight = 4 } + , Gene { source = M.Input 0, sink = M.Output 1, weight = 4 } + ] + , testCase "mutating the sink of a gene" $ + let + rand = mkStdGen 1 -- randomR generates sequence (1, 2, 0, ...) + genome = Genome { numInput = 2, numInternal = 1, numOutput = 2, genes = [] } + sourceGene = Gene { source = M.Input 0, sink = M.Output 1, weight = 4 } + mutatedGenes = fst $ foldl + (\(list, r) g -> + let (g', r') = mutateGeneSink genome g r + in (list ++ [g'], r') + ) + ([], rand) + (replicate 3 sourceGene) + in + mutatedGenes @?= + [ Gene { source = M.Input 0, sink = M.Output 0, weight = 4 } + , Gene { source = M.Input 0, sink = M.Output 1, weight = 4 } + , Gene { source = M.Input 0, sink = M.Internal 0, weight = 4 } + ] + , testCase "mutating the weight of a gene" $ + let + rand = mkStdGen 0 -- randomR generates sequence (7.572357,-1.4116564,-7.2413177, ...) + genome = Genome { numInput = 2, numInternal = 1, numOutput = 2, genes = [] } + sourceGene = Gene { source = M.Input 0, sink = M.Output 1, weight = 4 } + mutatedGenes = fst $ foldl + (\(list, r) g -> + let (g', r') = mutateGeneWeight genome g r + in (list ++ [g'], r') + ) + ([], rand) + (replicate 3 sourceGene) + in + mutatedGenes @?= + [ Gene { source = M.Input 0, sink = M.Output 1, weight = 7.572357} + , Gene { source = M.Input 0, sink = M.Output 1, weight = -1.4116564 } + , Gene { source = M.Input 0, sink = M.Internal 1, weight = -7.2413177 } + ] + + ] diff --git a/test/Main.hs b/test/Main.hs index 8847a07..907bbdd 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -3,8 +3,10 @@ module Main (main) where import Test.Tasty import qualified MindTest +import qualified GenomeTest main :: IO () main = defaultMain $ testGroup "all tests" $ [ MindTest.suite + , GenomeTest.suite ] |