minor things before tests can start.

This commit is contained in:
Nicole Dresselhaus 2018-06-22 07:11:10 +02:00
parent f478f0ecb6
commit 383ba7507f
Signed by: Drezil
GPG Key ID: AC88BB432537313A
3 changed files with 44 additions and 18 deletions

View File

@ -51,6 +51,12 @@ exampleEnvironment addedC es pred tox =
, predatorBehaviour = AttackInterval 10 , predatorBehaviour = AttackInterval 10
, numPlants = 50 , numPlants = 50
, logEveryNIterations = 10 , logEveryNIterations = 10
, mutationRate = 0.01
, deletionDuplicationRate = 0.05
, geneAddRate = 0.005
, activationNoiseIntensity = 0.01
, staticEnzymeCost = 0.01
, nutrientImpact = 0.01
} }
} }
@ -252,7 +258,7 @@ main = do
let emptyPlants = replicate (numPlants . settings $ env) emptyPlant let emptyPlants = replicate (numPlants . settings $ env) emptyPlant
printEverything = verbose opts printEverything = verbose opts
enzs <- randomRs (0,length (possibleEnzymes env) - 1) <$> newStdGen enzs <- randomRs (0,length (possibleEnzymes env) - 1) <$> newStdGen
let startPlants = randomGenome 1 enzs (possibleEnzymes env) emptyPlants let startPlants = randomGenome 2 enzs (possibleEnzymes env) emptyPlants
--writeFile "poison.twopi" $ generateDotFromPoisonTree "poison" 0.5 poisonedTree --writeFile "poison.twopi" $ generateDotFromPoisonTree "poison" 0.5 poisonedTree
LBS.writeFile "environment.json" . encode $ env LBS.writeFile "environment.json" . encode $ env
when printEverything $ putStr "\ESC[?1049h" when printEverything $ putStr "\ESC[?1049h"
@ -272,7 +278,7 @@ randomGenome num inds enzs (p:ps) = p { genome = genes} : randomGenome num r enz
i' = take num inds i' = take num inds
r = drop num inds r = drop num inds
enzymes = (enzs!!) <$> i' enzymes = (enzs!!) <$> i'
genes = (\e -> (e,1,1)) <$> enzymes genes = (\e -> (e,1,0.5)) <$> enzymes
generatePredators :: Double -> EnzymeTree s (Double,Compound) -> IO [Predator] generatePredators :: Double -> EnzymeTree s (Double,Compound) -> IO [Predator]
@ -308,7 +314,7 @@ printPopulation endemic es ps = do
fitnesses = (\(_,f,_) -> f) <$> ps fitnesses = (\(_,f,_) -> f) <$> ps
meanFitness = sum fitnesses / fromIntegral n meanFitness = sum fitnesses / fromIntegral n
maxFitness = maximum fitnesses maxFitness = maximum fitnesses
putStr $ padded 50 ("Population: (fitness: mean " ++ padded 5 (show meanFitness) ++ ", max: " ++ padded 5 (show maxFitness) ++ ")") putStr $ padded 50 (" Population: (fitness: mean " ++ padded 5 (show meanFitness) ++ ", max: " ++ padded 5 (show maxFitness) ++ ")")
forM_ ps $ \(_,f,_) -> putStr (printColor (f/maxFitness) '█') forM_ ps $ \(_,f,_) -> putStr (printColor (f/maxFitness) '█')
putStrLn colorOff putStrLn colorOff
forM_ es $ \(e,s) -> do forM_ es $ \(e,s) -> do

View File

@ -495,8 +495,14 @@
"numPlants": 100, "numPlants": 100,
"predatorBehaviour": { "predatorBehaviour": {
"contents": 10, "contents": 10,
"tag": "AttackInterval" "tag": "AlwaysAttack"
} }
, "mutationRate": 0.01
, "deletionDuplicationRate": 0.05
, "geneAddRate": 0.005
, "activationNoiseIntensity": 0.01
, "staticEnzymeCost": 0.01
, "nutrientImpact": 0.01
}, },
"soil": [ "soil": [
[ [

View File

@ -120,10 +120,19 @@ instance FromJSON PredatorBehaviour
instance ToJSON PredatorBehaviour instance ToJSON PredatorBehaviour
-- | Settings to enable/disable parts of the simulation -- | Settings to enable/disable parts of the simulation
--
-- Fitness is usually seen as relative Fitness (probability of survival), thus [0..1].
data Settings = Settings { automimicry :: Bool -- ^ do we have automimicry-protection? data Settings = Settings { automimicry :: Bool -- ^ do we have automimicry-protection?
, predatorBehaviour :: PredatorBehaviour -- ^ do predators always appear or according to their random distribution? , predatorBehaviour :: PredatorBehaviour -- ^ do predators always appear or according to their random distribution?
, numPlants :: Int -- ^ number of plants in starting population , numPlants :: Int -- ^ number of plants in starting population
, logEveryNIterations :: Int -- ^ log status every @loopNumber `mod` logEveryNIterations == 0@ , logEveryNIterations :: Int -- ^ log status every @loopNumber `mod` logEveryNIterations == 0@
, deletionDuplicationRate :: Double -- ^ Rate at wich genes get deleted or duplicated (e.g. 0.05 = 5% chance a gene gets deleted/duplicated. Independent per gene)
, mutationRate :: Double -- ^ Rate at wich genes mutate to produce other enzymes. Independent per gene
, geneAddRate :: Double -- ^ Rate at wich genes from the primary metabolims mutate to produce enzymes of the secondary metabolims
, activationNoiseIntensity :: Double -- ^ Intensity of activation mutatation. Enzymes produced are @#Genes * Activation@. Activation is clipped between @0@ and @1@.
-- New activation is @activation +- activationNoiseIntensity*[0..1)@ (random)
, staticEnzymeCost :: Double -- ^ Penalty in Fitness per Enzyme created
, nutrientImpact :: Double -- ^ Penalty in Fitness for using nutrients (@nutrientImpact * Ratio(nutrientsUsed : nutrientsAvailable)@)
} }
deriving (Show, Eq, Generic) deriving (Show, Eq, Generic)
@ -228,12 +237,14 @@ fitness iter ps = do
else else
return $ repeat 1 return $ repeat 1
dieRate <- mapM (dieToPredators (zip appearingPredators popDefense)) products -- defeat predators with produced compounds dieRate <- mapM (dieToPredators (zip appearingPredators popDefense)) products -- defeat predators with produced compounds
sec <- fromEnv $ staticEnzymeCost . settings
ni <- fromEnv $ nutrientImpact . settings
let sumEnzymes = sum . fmap (\(_,q,a) -> fromIntegral q*a) . genome <$> ps -- amount of enzymes * activation = resources "wasted" let sumEnzymes = sum . fmap (\(_,q,a) -> fromIntegral q*a) . genome <$> ps -- amount of enzymes * activation = resources "wasted"
staticCostOfEnzymes = (*0.01) <$> sumEnzymes -- static cost of creating enzymes staticCostOfEnzymes = (*sec) <$> sumEnzymes -- static cost of creating enzymes
nutrientsAvailable <- fmap snd <$> fromEnv soil nutrientsAvailable <- fmap snd <$> fromEnv soil
let nutrientsLeft = (\p -> [p ! i | i <- [0..fromEnum (maxBound :: Nutrient)]]) <$> products let nutrientsLeft = (\p -> [p ! i | i <- [0..fromEnum (maxBound :: Nutrient)]]) <$> products
nutrientRatio = minimum . zipWith (flip (/)) nutrientsAvailable <$> nutrientsLeft nutrientRatio = minimum . zipWith (flip (/)) nutrientsAvailable <$> nutrientsLeft
costOfEnzymes = max 0 <$> zipWith (\s n -> 1-(s+n*0.1)) staticCostOfEnzymes nutrientRatio -- cost to keep enzymes are static costs + amount of nutrient sucked out of the primary cycle costOfEnzymes = max 0 <$> zipWith (\s n -> 1-(s+n*ni)) staticCostOfEnzymes nutrientRatio -- cost to keep enzymes are static costs + amount of nutrient sucked out of the primary cycle
survivalRate = (1-) <$> dieRate survivalRate = (1-) <$> dieRate
return $ zip (zipWith (*) survivalRate costOfEnzymes) products return $ zip (zipWith (*) survivalRate costOfEnzymes) products
@ -277,7 +288,6 @@ dieToPredator p comps = do
-- Mating & Creation of diversity -- Mating & Creation of diversity
-- ------------------------------ -- ------------------------------
-- | mate haploid -- | mate haploid
haploMate :: Plant -> World Plant haploMate :: Plant -> World Plant
haploMate (Plant genes abs) = do haploMate (Plant genes abs) = do
@ -293,6 +303,10 @@ haploMate (Plant genes abs) = do
r4 <- liftIO digen r4 <- liftIO digen
r5 <- liftIO digen r5 <- liftIO digen
enzymes <- fromEnv possibleEnzymes enzymes <- fromEnv possibleEnzymes
ddr <- fromEnv $ deletionDuplicationRate.settings
mr <- fromEnv $ mutationRate.settings
ani <- fromEnv $ activationNoiseIntensity.settings
gar <- fromEnv $ geneAddRate.settings
re1 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int]) re1 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
re2 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int]) re2 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
let let
@ -304,7 +318,7 @@ haploMate (Plant genes abs) = do
$ genes $ genes
deleteGene :: [(Double,Int)] -> Genome -> Genome deleteGene :: [(Double,Int)] -> Genome -> Genome
deleteGene _ [] = [] deleteGene _ [] = []
deleteGene ((r,i):rs) g = if r < 0.05 then deleteGene rs (stay ++ go' ++ stay') else g deleteGene ((r,i):rs) g = if r < ddr then deleteGene rs (stay ++ go' ++ stay') else g
where where
(stay, go:stay') = splitAt (i `mod` length g - 2) g (stay, go:stay') = splitAt (i `mod` length g - 2) g
go' = case go of go' = case go of
@ -313,15 +327,15 @@ haploMate (Plant genes abs) = do
duplicateGene :: [(Double,Int)] -> Genome -> Genome duplicateGene :: [(Double,Int)] -> Genome -> Genome
duplicateGene _ [] = [] duplicateGene _ [] = []
duplicateGene ((r,i):rs) g = if r < 0.05 then duplicateGene rs (stay ++ (e,q,a):(e,1,a):stay') else g duplicateGene ((r,i):rs) g = if r < ddr then duplicateGene rs (stay ++ (e,q,a):(e,1,a):stay') else g
where where
(stay, (e,q,a):stay') = splitAt (i `mod` length g - 2) g (stay, (e,q,a):stay') = splitAt (i `mod` length g - 2) g
addGene :: [Double] -> [Int] -> Genome -> Genome addGene :: [Double] -> [Int] -> Genome -> Genome
addGene (r:rs) (s:ss) g = if r < 0.005 then (enzymes !! s,1,0.5):g else g addGene (r:rs) (s:ss) g = if r < gar then (enzymes !! s,1,0.5):g else g
noiseActivation :: [Double] -> Genome -> Genome noiseActivation :: [Double] -> Genome -> Genome
noiseActivation (r:rs) ((e,q,a):gs) = (e,q,max 0 $ min 1 $ a-0.01+0.02*r):noiseActivation rs gs noiseActivation (r:rs) ((e,q,a):gs) = (e,q,max 0 $ min 1 $ a-ani+2*ani*r):noiseActivation rs gs
noiseActivation _ [] = [] noiseActivation _ [] = []
mutateGene :: [Double] -> [Int] -> Genome -> Genome mutateGene :: [Double] -> [Int] -> Genome -> Genome
@ -331,9 +345,9 @@ haploMate (Plant genes abs) = do
-- take q randoms from rs/ss, replace numMuts (<= q) with the enzymes in ss -- take q randoms from rs/ss, replace numMuts (<= q) with the enzymes in ss
(rs',rs'') = splitAt q rs (rs',rs'') = splitAt q rs
(ss',ss'') = splitAt q ss (ss',ss'') = splitAt q ss
numMuts = length . filter (<0.01) $ rs' numMuts = length . filter (<mr) $ rs'
newEnz = fmap ((\e' -> (e',1,a)).(enzymes!!).snd) newEnz = fmap ((\e' -> (e',1,a)).(enzymes!!).snd)
. filter ((<0.01).fst) . filter ((<mr).fst)
. zip rs' $ ss' . zip rs' $ ss'
g' = if q == numMuts then newEnz g' = if q == numMuts then newEnz
else (e,q-numMuts,a):newEnz else (e,q-numMuts,a):newEnz