Drezil/chemodiversity
1
1
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Simulation looks ok-ish. Needs incentive to foster productive enzymes

Browse Source
This commit is contained in:
Stefan Dresselhaus
2018-05-15 19:01:38 +02:00
parent cd16dbb39b
commit 8eeb837b9f
6 changed files with 92 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
src/ArbitraryEnzymeTree.hs
View File

@ -3,6 +3,7 @@
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
module ArbitraryEnzymeTree
( EnzymeTree
, getTreeSize
@ -12,6 +13,9 @@ module ArbitraryEnzymeTree
, treeFromList
, generateTreeFromList
, generateDotFromTree
, generateDotFromPoisonTree
, poisonTree
, makeHead
) where
import Test.QuickCheck
@ -89,3 +93,34 @@ generateDotFromTree name t = "digraph " <> name <> " {\n"
where
ts = fromString . show
wrap x = "\"" <> x <> "\""
generateDotFromPoisonTree :: (Show a, IsString b, Monoid b) => b -> Double -> EnzymeTree s (Double,a) -> b
generateDotFromPoisonTree name pl t = "digraph " <> name <> " {\n"
<> generateDotFromTree' t
<> "}\n"
where
generateDotFromTree' :: (Show a, IsString b, Monoid b) => EnzymeTree s (Double,a) -> b
generateDotFromTree' (EnzymeTree _ (d,c) ns) =
" " <> wrap (ts c) <> " -> { "
<> mconcat (intersperse " " (wrap . ts . snd . getElement <$> ns))
<> " };\n"
<> (if d > pl then " " <> wrap (ts c) <> " [style=filled, fillcolor=\"0," <> ts d <> ",0.9\"];\n" else "")
<> mconcat (generateDotFromTree' <$> ns)
where
ts :: (Show a, IsString b) => a -> b
ts = fromString . show
wrap x = "\"" <> x <> "\""
poisonTree :: [Double] -> EnzymeTree s a -> EnzymeTree s (Double, a)
poisonTree ds t@(EnzymeTree s _ _) = go Nothing 0 annotatedTree
where
annotatedTree = (,) <$> treeFromList s ds <*> t
go :: Maybe Double -> Int -> EnzymeTree t (Double, a) -> EnzymeTree t (Double, a)
go Nothing i parent@(EnzymeTree s' (p,a) childs) = EnzymeTree s' (p/5, a) $ (\(_,ts) -> go (Just $ p/5 ) (i+1) ts) <$> zip [1..] childs
go (Just pe) i this@(EnzymeTree s' (p,a) childs) = EnzymeTree s' (p',a) $ (\(j,ts) -> go (Just . min 1 $ j*p') (i+1) ts) <$> zip [1..] childs
where
p' = max pe (p / i')
i' = fromIntegral $ 6 - min i 5 -- 100% effective poision only at level xx or deeper
makeHead :: a -> EnzymeTree s a -> EnzymeTree s a
makeHead c (EnzymeTree s a ts) = EnzymeTree s c ts

25
src/Environment.hs
View File

@ -4,6 +4,7 @@ import Data.Functor ((<$>))
import Control.Applicative ((<*>))
import Control.Monad (forM_)
import Control.Monad.Reader
import Control.Parallel.Strategies
import Data.List (permutations, subsequences)
import Numeric.LinearAlgebra
import Text.Printf
@ -78,8 +79,8 @@ makeSimpleEnzyme a b = Enzyme (show a ++ " -> " ++ show b) [] ((a,-1),(b,1)) Not
-- | In the environment we have predators that impact the fitness of our plants and
-- may be resistant to some compounds the plant produces. They can also differ in
-- their intensity.
data Predator = Predator { resistance :: [Compound]
-- ^ list of components this predator is resistant to
data Predator = Predator { irresistance :: [Compound]
-- ^ list of components this predator is not resistant to
, fitnessImpact :: Amount
-- ^ impact on the fitness of a plant
-- (~ agressiveness of the herbivore)
@ -150,7 +151,7 @@ fitness p = do
products <- produceCompounds p nutrients -- produce compounds
survivalRate <- deterPredators products -- defeat predators with produced compounds
let sumEnzymes = sum $ (\(_,q,a) -> fromIntegral q*a) <$> genome p -- amount of enzymes * activation = resources "wasted"
costOfEnzymes = 0.95 ** sumEnzymes
costOfEnzymes = 0.99 ** sumEnzymes
return $ survivalRate * costOfEnzymes
-- can also be written as, but above is more clear.
-- fitness p = absorbNutrients p >>= produceCompounds p >>= deterPredators
@ -179,10 +180,10 @@ deterPredators cs = do
ts <- asks toxicCompounds
let
deter :: Predator -> Double
-- multiply (toxicity of t with 100% effectiveness at l| for all toxins t | and t not in p's resistance-list)
deter p = product [1 - min 1 (cs ! fromEnum t / l) | (t,l) <- ts, t `notElem` resistance p]
-- multiply (toxicity of t with 100% effectiveness at l| for all toxins t | and t not in p's irresistance-list)
deter p = product [1 - min 1 (cs ! fromEnum t / l) | (t,l) <- ts, t `elem` irresistance p]
-- multiply (probability of occurence * intensity of destruction / probability to deter predator | for all predators)
return . product $ [min 1 ((1-prob) * fitnessImpact p / deter p) | (p,prob) <- ps]
return $ product ([min 1 ((1-prob) * fitnessImpact p / deter p) | (p,prob) <- ps] `using` parList rdeepseq)
-- Mating & Creation of diversity
-- ------------------------------
@ -208,26 +209,26 @@ haploMate (Plant genes abs) = do
. deleteGene r5
$ genes
deleteGene :: [Double] -> Genome -> Genome
deleteGene (r:rs) ((e,1,a):gs) = if a < 0.1 && r < 0.5 then deleteGene rs gs else (e,1,a):deleteGene rs gs
deleteGene (r:rs) ((e,q,a):gs) = if a < 0.1 && r < 0.5 then (e,q-1,a):deleteGene rs gs else (e,q,a):deleteGene rs gs
deleteGene (r:rs) ((e,1,a):gs) = if r < 0.1 then deleteGene rs gs else (e,1,a):deleteGene rs gs
deleteGene (r:rs) ((e,q,a):gs) = if r < 0.1 then (e,q-1,a):deleteGene rs gs else (e,q,a):deleteGene rs gs
deleteGene _ [] = []
duplicateGene :: [Double] -> Genome -> Genome
duplicateGene (r:rs) ((e,q,a):gs) = if r < 0.05 then (e,q+1,a):duplicateGene rs gs else (e,q,a):duplicateGene rs gs
duplicateGene (r:rs) ((e,q,a):gs) = if r < 0.1 then (e,1,a):(e,q,a):duplicateGene rs gs else (e,q,a):duplicateGene rs gs
duplicateGene _ [] = []
addGene :: [Double] -> [Int] -> Genome -> Genome
addGene (r:rs) (s:ss) g = if r < 0.01 then (enzymes !! s,1,1):g else g
addGene (r:rs) (s:ss) g = if r < 0.05 then (enzymes !! s,1,1):g else g
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 _ [] = []
mutateGene :: [Double] -> [Int] -> Genome -> Genome
mutateGene (r:rs) (s:ss) ((e,1,a):gs) = if r < 0.05 then (enzymes !! s,1,a):mutateGene rs ss gs
mutateGene (r:rs) (s:ss) ((e,1,a):gs) = if r < 0.01 then ((enzymes !! s),1,a):mutateGene rs ss gs
else (e,1,a):mutateGene rs ss gs
mutateGene (r:rs) (s:ss) ((e,q,a):gs) = if r < 0.05 then (e,q-1,a):(enzymes !! s,1,a):mutateGene rs ss gs
mutateGene (r:rs) (s:ss) ((e,q,a):gs) = if r < 0.01 then (e,q-1,a):((enzymes !! s),1,a):mutateGene rs ss gs
else (e,q,a):mutateGene rs ss gs
mutateGene (r:rs) (s:ss) [] = []
return $ Plant genes' abs

6
src/Lib.hs
View File

@ -1,6 +0,0 @@
module Lib
( someFunc
) where
someFunc :: IO ()
someFunc = putStrLn "someFunc"