diff options
| -rw-r--r-- | src/Genome.hs | 31 | ||||
| -rw-r--r-- | test/GenomeTest.hs | 94 |
2 files changed, 90 insertions, 35 deletions
diff --git a/src/Genome.hs b/src/Genome.hs index 500512c..927005e 100644 --- a/src/Genome.hs +++ b/src/Genome.hs @@ -8,6 +8,7 @@ module Genome , mutateGenomeAddInternal , mutateGenomeRemoveInternal + , mutateGenomeAddGene ) where @@ -111,8 +112,6 @@ 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) @@ -124,7 +123,6 @@ 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!" @@ -139,3 +137,30 @@ decrementNeuron g (Output x) isInternal :: NeuronIndex -> Bool isInternal (Internal _) = True isInternal _ = False + + +-- add a new, random gene +mutateGenomeAddGene :: RandomGen a => Genome -> a -> (Genome, a) +mutateGenomeAddGene g r = + let + (so, r') = randomSource g r + (si, r'') = randomSink g r' + (w, r''') = randomR (-4, 4) r'' + gene = Gene so si w + in (g {genes = gene:(genes g)}, r''') + + + +randomSource :: RandomGen a => Genome -> a -> (NeuronIndex, a) +randomSource g r = + let + (idx, r') = randomR (0, numInput g + numInternal g - 1) r + result = if idx < numInput g then Input idx else Internal $ idx - numInput g + in (result, r') + +randomSink :: RandomGen a => Genome -> a -> (NeuronIndex, a) +randomSink g r = + let + (idx, r') = randomR (0, numInternal g + numOutput g - 1) r + result = if idx < numInternal g then Internal idx else Output $ idx - numInput g + in (result, r') diff --git a/test/GenomeTest.hs b/test/GenomeTest.hs index 8448133..d775467 100644 --- a/test/GenomeTest.hs +++ b/test/GenomeTest.hs @@ -2,9 +2,11 @@ module GenomeTest (suite) where import Test.Tasty import Test.Tasty.HUnit -import qualified Mind as M +import Mind (NeuronIndex (..)) import Genome import System.Random +import Data.Ix + suite :: TestTree suite = testGroup "genome tests" $ @@ -18,7 +20,7 @@ mutationTests = testGroup "mutations" $ 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 } + sourceGene = Gene { source = Input 0, sink = Output 1, weight = 4 } mutatedGenes = fst $ foldl (\(list, r) g -> let (g', r') = mutateGeneSource genome g r @@ -28,15 +30,15 @@ mutationTests = testGroup "mutations" $ (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 } + [ Gene { source = Input 1, sink = Output 1, weight = 4 } + , Gene { source = Internal 0, sink = Output 1, weight = 4 } + , Gene { source = Input 0, sink = 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 } + sourceGene = Gene { source = Input 0, sink = Output 1, weight = 4 } mutatedGenes = fst $ foldl (\(list, r) g -> let (g', r') = mutateGeneSink genome g r @@ -46,15 +48,15 @@ mutationTests = testGroup "mutations" $ (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 } + [ Gene { source = Input 0, sink = Output 0, weight = 4 } + , Gene { source = Input 0, sink = Output 1, weight = 4 } + , Gene { source = Input 0, sink = 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 } + sourceGene = Gene { source = Input 0, sink = Output 1, weight = 4 } mutatedGenes = fst $ foldl (\(list, r) g -> let (g', r') = mutateGeneWeight genome g r @@ -63,9 +65,9 @@ mutationTests = testGroup "mutations" $ ([], rand) (replicate 3 sourceGene) expected = - [ 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.Output 1, weight = -7.2413177 } + [ Gene { source = Input 0, sink = Output 1, weight = 7.572357} + , Gene { source = Input 0, sink = Output 1, weight = -1.4116564 } + , Gene { source = Input 0, sink = Output 1, weight = -7.2413177 } ] approxEqual a b = abs (a-b) < 0.0001 in do @@ -82,9 +84,9 @@ mutationTests = testGroup "mutations" $ , numInternal = 2 , 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.Output 0, weight = 1.0 } + [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 } + , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 } + , Gene { source = Internal 1, sink = Output 0, weight = 1.0 } ] } r = mkStdGen 5 @@ -103,10 +105,10 @@ mutationTests = testGroup "mutations" $ , 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 } + [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 } + , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 } + , Gene { source = Internal 1, sink = Internal 2, weight = 1.0 } + , Gene { source = Internal 2, sink = Output 0, weight = 1.0 } ] } (genome', r') = mutateGenomeRemoveInternal genome r @@ -126,23 +128,51 @@ mutationTests = testGroup "mutations" $ (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 } + [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 } + , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 } + , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 } + , Gene { source = Internal 1, sink = 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 } + [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 } + , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 } + , Gene { source = Internal 1, sink = Output 0, weight = 1.0 } + , Gene { source = Internal 1, sink = 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 } + [ Gene { source = Input 0, sink = Internal 0, weight = 1.0 } + , Gene { source = Input 0, sink = Internal 0, weight = 1.0 } + , Gene { source = Internal 0, sink = Internal 1, weight = 1.0 } + , Gene { source = Internal 1, sink = Output 0, weight = 1.0 } ] + , testCase "add new gene" $ + let + genome = Genome + { numInput = 1 + , numInternal = 2 + , numOutput = 1 + , genes = [] + } + r = mkStdGen 5 + (genome', _) = mutateGenomeAddGene genome r + new = last $ genes genome' + -- checking sources + validSource (Input x) = inRange (0, numInput genome') x + validSource (Internal x) = inRange (0, numInternal genome') x + validSource (Output _) = False + -- checking sinks + validSink (Input _) = False + validSink (Internal x) = inRange(0, numInternal genome') x + validSink (Output x) = inRange(0, numOutput genome') x + w = weight new + in do + (numInput genome') @?= (numInput genome) + (numInternal genome') @?= (numInternal genome) + (numOutput genome') @?= (numOutput genome) + (length $ genes genome') @?= 1 + (length $ genes genome) + validSource (source new) @?= True + validSink (sink new) @?= True + (w >= -4) && (w <= 4) @?= True ] |