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

Tree generates arbitrary compounds (needs rename -.-)

Browse Source
This commit is contained in:
Stefan Dresselhaus
2018-05-07 00:44:12 +02:00
parent 723df072c1
commit cd16dbb39b
6 changed files with 185 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
src/Arbitrary.hs → src/ArbitraryEnzymeTree.hs
View File

@ -2,12 +2,24 @@
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveGeneric #-}
module Arbitrary where
{-# LANGUAGE OverloadedStrings #-}
module ArbitraryEnzymeTree
( EnzymeTree
, getTreeSize
, getElement
, getShape
, getSubTrees
, treeFromList
, generateTreeFromList
, generateDotFromTree
) where
import Test.QuickCheck
import GHC.Generics (Generic(..))
import GHC.Generics (Generic())
import Text.Pretty.Simple
import Data.List
import Data.String (IsString(..))
import Data.Monoid
data TreeShape = Root
{ treeSize :: Int
@ -46,9 +58,34 @@ getTreeSize (EnzymeTree (Root a _) _ _) = a
getShape :: EnzymeTree s a -> TreeShape
getShape (EnzymeTree s _ _) = s
getElement :: EnzymeTree s a -> a
getElement (EnzymeTree _ e _) = e
getSubTrees :: EnzymeTree s a -> [EnzymeTree TreeShape a]
getSubTrees (EnzymeTree _ _ s) = s
treeFromList :: TreeShape -> [a] -> EnzymeTree s a
treeFromList (Root n ns) (a:as) = EnzymeTree (Root n ns) a (unfoldr go (ns,as))
where
go :: ([TreeShape],[a]) -> Maybe (EnzymeTree s a,([TreeShape],[a]))
go (n:ns,as) = Just (treeFromList n (take (treeSize n) as), (ns, drop (treeSize n) as))
go ([],_) = Nothing
generateTreeFromList :: Int -> [a] -> IO (EnzymeTree s a)
generateTreeFromList s a = flip treeFromList a . getShape <$> generate (resize s arbitrary :: Gen (EnzymeTree s ()))
generateDotFromTree :: (Show a, IsString b, Monoid b) => b -> EnzymeTree s a -> b
generateDotFromTree name t = "digraph " <> name <> " {\n"
<> generateDotFromTree' t
<> "}\n"
where
generateDotFromTree' :: (Show a, IsString b, Monoid b) => EnzymeTree s a -> b
generateDotFromTree' (EnzymeTree _ num ns) =
" " <> wrap (ts num) <> " -> { "
<> mconcat (intersperse " " (wrap . ts . getElement <$> ns))
<> " };\n"
<> mconcat (generateDotFromTree' <$> ns)
where
ts = fromString . show
wrap x = "\"" <> x <> "\""

42
src/Environment.hs
View File

@ -1,9 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module Environment where
import Data.Functor ((<$>))
import Control.Applicative ((<*>))
import Control.Monad (forM_)
@ -30,17 +26,17 @@ data Component = PP
| FPP
deriving (Show, Enum, Bounded, Eq)
-- | Compounds are either direct nutrients, already processed components or GenericEnzymes
-- | Compounds are either direct nutrients, already processed components or GenericCompound
data Compound = Substrate Nutrient
| Produced Component
| GenericEnzyme Int
| GenericCompound Int
deriving (Show, Eq)
instance Enum Compound where
toEnum x
| x <= maxS = Substrate . toEnum $ x
| x - (maxS+1) <= maxP = Produced . toEnum $ x - (maxS + 1)
| otherwise = GenericEnzyme $ x - (maxS + 1) - (maxP + 1)
| otherwise = GenericCompound $ x - (maxS + 1) - (maxP + 1)
where
maxS = fromEnum (maxBound :: Nutrient)
maxP = fromEnum (maxBound :: Component)
@ -49,7 +45,7 @@ instance Enum Compound where
fromEnum (Produced x) = fromEnum x + maxS + 1
where
maxS = fromEnum (maxBound :: Nutrient)
fromEnum (GenericEnzyme x) = x + maxS + maxP + 2
fromEnum (GenericCompound x) = x + maxS + maxP + 2
where
maxS = fromEnum (maxBound :: Nutrient)
maxP = fromEnum (maxBound :: Component)
@ -153,7 +149,7 @@ fitness p = do
nutrients <- absorbNutrients p -- absorb soil
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"
let sumEnzymes = sum $ (\(_,q,a) -> fromIntegral q*a) <$> genome p -- amount of enzymes * activation = resources "wasted"
costOfEnzymes = 0.95 ** sumEnzymes
return $ survivalRate * costOfEnzymes
-- can also be written as, but above is more clear.
@ -161,11 +157,11 @@ fitness p = do
produceCompounds :: Plant -> [(Nutrient, Amount)] -> World (Vector Amount)
produceCompounds (Plant genes _) substrate = do
numIter <- metabolismIteration <$> ask
numCompounds <- maxCompound <$> ask
numIter <- asks metabolismIteration
numCompounds <- asks maxCompound
let
initialAmount = (assoc (numCompounds+1) 0 ((\(n,a) -> (fromEnum $ Substrate n,a)) <$> substrate)) :: Vector Amount
enzymes = (\(e,q,a) -> (synthesis e,(fromIntegral q)*a)) <$> genes -- [(((Component,Amount),(Component,Amount)),q*a)], Amount got * by quantity & activation
initialAmount = assoc (numCompounds+1) 0 ((\(n,a) -> (fromEnum $ Substrate n,a)) <$> substrate) :: Vector Amount
enzymes = (\(e,q,a) -> (synthesis e,fromIntegral q*a)) <$> genes -- [(((Component,Amount),(Component,Amount)),q*a)], Amount got * by quantity & activation
positions = concat $ (\(((i,ia),(o,oa)),f) -> [((fromEnum i,fromEnum i),f*ia),((fromEnum o,fromEnum o),f*ia),((fromEnum o,fromEnum i),f*oa),((fromEnum i,fromEnum o),f*oa)]) <$> enzymes -- [((row,column),amount)]
mat = accum (konst 0 (numCompounds+1,numCompounds+1)) (+) positions --accumulate all entries into one matrix.
-- mat is now the rate of change in u'(t) = A u(t)
@ -179,14 +175,14 @@ produceCompounds (Plant genes _) substrate = do
deterPredators :: Vector Amount -> World Probability
deterPredators cs = do
ps <- predators <$> ask
ts <- toxicCompounds <$> ask
let
ps <- asks predators
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, not (t `elem` resistance p)]
deter p = product [1 - min 1 (cs ! fromEnum t / l) | (t,l) <- ts, t `notElem` resistance 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]
-- Mating & Creation of diversity
-- ------------------------------
@ -201,7 +197,7 @@ haploMate (Plant genes abs) = do
r3 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
r4 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
r5 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
enzymes <- possibleEnzymes <$> ask
enzymes <- asks possibleEnzymes
re1 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
re2 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
let
@ -221,17 +217,17 @@ haploMate (Plant genes abs) = do
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.01 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.05 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.05 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
@ -243,7 +239,7 @@ haploMate (Plant genes abs) = do
-- | Plant with no secondary metabolism with unlimited extraction from environment.
emptyPlant :: Plant
emptyPlant = Plant [] (soil <$> ask)
emptyPlant = Plant [] (asks soil)
getAmountOf :: Compound -> [(Compound, Amount)] -> Amount
getAmountOf c = sum . fmap snd . filter ((== c) . fst)