1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
module Genome
( Gene (..)
, Genome (..)
, mutateGeneSource
, mutateGeneSink
, mutateGeneWeight
, mutateGene
, mutateGenomeAddInternal
) 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'
-- add new internal neuron
mutateGenomeAddInternal :: RandomGen a => Genome -> a -> (Genome, a)
mutateGenomeAddInternal genome r = (genome { numInternal = 1 + numInternal genome }, r)
-- remove an internal neuron, decrementing sources and incrementing sinks
mutateGenomeRemoveInternal :: RandomGen a => Genome -> a -> (Genome, a)
mutateGenomeRemoveInternal = undefined
|
