Tree generates arbitrary compounds (needs rename -.-)

This commit is contained in:
Nicole Dresselhaus 2018-05-07 00:44:12 +02:00
parent 723df072c1
commit cd16dbb39b
Signed by: Drezil
GPG Key ID: 057D94F356F41E25
6 changed files with 185 additions and 35 deletions

View File

@ -1,6 +1,12 @@
.PHONY: run pdf ghci
INPUT = sketch.md.lhs
TWOPIS = $(wildcard *.twopi)
png: $(TWOPIS:.twopi=.png)
%.png : %.twopi
twopi -Tpng -Goverlap=scale -o $@ $<
pdf: $(INPUT)
pandoc -f markdown+lhs+smart+emoji -H make-code-footnotesize.tex \

View File

@ -1,8 +1,5 @@
{-# LANGUAGE TypeApplications #-}
module Main where
import Environment
import Text.Printf
import Control.Monad.Reader
import Numeric.LinearAlgebra
@ -12,6 +9,8 @@ import Control.Concurrent
import qualified Debug.Trace as Debug
import System.IO
import ArbitraryEnzymeTree
import Environment
-- Example definitions
-- -------------------
@ -31,8 +30,8 @@ greenfly = Predator [] 0.2 -- killed by any toxic Component
-- Environment
exampleEnvironment :: Environment
exampleEnvironment =
exampleEnvironment :: Int -> [Enzyme] -> Environment
exampleEnvironment addedC es =
Environment
{ soil = [ (Nitrate, 2)
, (Phosphor, 3)
@ -40,9 +39,9 @@ exampleEnvironment =
]
, predators = [ (greenfly, 0.1) ]
, metabolismIteration = 100
, maxCompound = maxCompoundWithoutGeneric
, maxCompound = maxCompoundWithoutGeneric + addedC
, toxicCompounds = [(Produced FPP,0.5)] --FPP kills 100% if produced amount above 0.2 units
, possibleEnzymes = [pps,fpps]
, possibleEnzymes = [pps,fpps] ++ es
}
-- Plants
@ -111,10 +110,12 @@ main :: IO ()
main = do
hSetBuffering stdin NoBuffering
hSetBuffering stdout NoBuffering
let emptyPlants = replicate 100 emptyPlant
printEnvironment exampleEnvironment
randomCompounds <- generateTreeFromList 10 (toEnum <$> [(maxCompoundWithoutGeneric+1)..] :: [Compound]) -- generate roughly 10 compounds
let env = exampleEnvironment (getTreeSize randomCompounds) (generateEnzymeFromTree randomCompounds)
emptyPlants = replicate 100 emptyPlant
printEnvironment env
putStr "\ESC[?1049h"
loop 100 emptyPlants exampleEnvironment
loop 100 emptyPlants env
putStrLn "Simulation ended. Press key to exit."
_ <- getChar
putStr "\ESC[?1049l"
@ -170,3 +171,10 @@ printColor x c
colorOff :: String
colorOff = "\ESC[0m"
generateEnzymeFromTree :: EnzymeTree s Compound -> [Enzyme]
generateEnzymeFromTree t = (makeSimpleEnzyme c . getElement <$> sts)
++ concatMap generateEnzymeFromTree sts
where
c = getElement t
sts = getSubTrees t

BIN
exampleGraph.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 MiB

103
exampleGraph.twopi Normal file
View File

@ -0,0 +1,103 @@
digraph test {
"Substrate Phosphor" -> { "Substrate Nitrate" "GenericEnzyme 15" "GenericEnzyme 37" "GenericEnzyme 55" "GenericEnzyme 75" };
"Substrate Nitrate" -> { "Substrate Photosynthesis" "GenericEnzyme 6" };
"Substrate Photosynthesis" -> { "Produced PP" "GenericEnzyme 1" };
"Produced PP" -> { "Produced FPP" "GenericEnzyme 0" };
"Produced FPP" -> { };
"GenericEnzyme 0" -> { };
"GenericEnzyme 1" -> { "GenericEnzyme 2" "GenericEnzyme 3" "GenericEnzyme 4" "GenericEnzyme 5" };
"GenericEnzyme 2" -> { };
"GenericEnzyme 3" -> { };
"GenericEnzyme 4" -> { };
"GenericEnzyme 5" -> { };
"GenericEnzyme 6" -> { "GenericEnzyme 7" "GenericEnzyme 9" "GenericEnzyme 10" "GenericEnzyme 11" "GenericEnzyme 13" "GenericEnzyme 14" };
"GenericEnzyme 7" -> { "GenericEnzyme 8" };
"GenericEnzyme 8" -> { };
"GenericEnzyme 9" -> { };
"GenericEnzyme 10" -> { };
"GenericEnzyme 11" -> { "GenericEnzyme 12" };
"GenericEnzyme 12" -> { };
"GenericEnzyme 13" -> { };
"GenericEnzyme 14" -> { };
"GenericEnzyme 15" -> { "GenericEnzyme 16" "GenericEnzyme 19" "GenericEnzyme 22" "GenericEnzyme 27" "GenericEnzyme 32" };
"GenericEnzyme 16" -> { "GenericEnzyme 17" "GenericEnzyme 18" };
"GenericEnzyme 17" -> { };
"GenericEnzyme 18" -> { };
"GenericEnzyme 19" -> { "GenericEnzyme 20" "GenericEnzyme 21" };
"GenericEnzyme 20" -> { };
"GenericEnzyme 21" -> { };
"GenericEnzyme 22" -> { "GenericEnzyme 23" "GenericEnzyme 24" "GenericEnzyme 26" };
"GenericEnzyme 23" -> { };
"GenericEnzyme 24" -> { "GenericEnzyme 25" };
"GenericEnzyme 25" -> { };
"GenericEnzyme 26" -> { };
"GenericEnzyme 27" -> { "GenericEnzyme 28" "GenericEnzyme 30" };
"GenericEnzyme 28" -> { "GenericEnzyme 29" };
"GenericEnzyme 29" -> { };
"GenericEnzyme 30" -> { "GenericEnzyme 31" };
"GenericEnzyme 31" -> { };
"GenericEnzyme 32" -> { "GenericEnzyme 33" "GenericEnzyme 34" };
"GenericEnzyme 33" -> { };
"GenericEnzyme 34" -> { "GenericEnzyme 35" };
"GenericEnzyme 35" -> { "GenericEnzyme 36" };
"GenericEnzyme 36" -> { };
"GenericEnzyme 37" -> { "GenericEnzyme 38" "GenericEnzyme 47" };
"GenericEnzyme 38" -> { "GenericEnzyme 39" "GenericEnzyme 40" "GenericEnzyme 43" "GenericEnzyme 46" };
"GenericEnzyme 39" -> { };
"GenericEnzyme 40" -> { "GenericEnzyme 41" };
"GenericEnzyme 41" -> { "GenericEnzyme 42" };
"GenericEnzyme 42" -> { };
"GenericEnzyme 43" -> { "GenericEnzyme 44" };
"GenericEnzyme 44" -> { "GenericEnzyme 45" };
"GenericEnzyme 45" -> { };
"GenericEnzyme 46" -> { };
"GenericEnzyme 47" -> { "GenericEnzyme 48" "GenericEnzyme 49" "GenericEnzyme 50" "GenericEnzyme 51" };
"GenericEnzyme 48" -> { };
"GenericEnzyme 49" -> { };
"GenericEnzyme 50" -> { };
"GenericEnzyme 51" -> { "GenericEnzyme 52" "GenericEnzyme 53" };
"GenericEnzyme 52" -> { };
"GenericEnzyme 53" -> { "GenericEnzyme 54" };
"GenericEnzyme 54" -> { };
"GenericEnzyme 55" -> { "GenericEnzyme 56" "GenericEnzyme 59" "GenericEnzyme 64" "GenericEnzyme 67" "GenericEnzyme 72" };
"GenericEnzyme 56" -> { "GenericEnzyme 57" "GenericEnzyme 58" };
"GenericEnzyme 57" -> { };
"GenericEnzyme 58" -> { };
"GenericEnzyme 59" -> { "GenericEnzyme 60" "GenericEnzyme 63" };
"GenericEnzyme 60" -> { "GenericEnzyme 61" "GenericEnzyme 62" };
"GenericEnzyme 61" -> { };
"GenericEnzyme 62" -> { };
"GenericEnzyme 63" -> { };
"GenericEnzyme 64" -> { "GenericEnzyme 65" "GenericEnzyme 66" };
"GenericEnzyme 65" -> { };
"GenericEnzyme 66" -> { };
"GenericEnzyme 67" -> { "GenericEnzyme 68" "GenericEnzyme 69" "GenericEnzyme 70" "GenericEnzyme 71" };
"GenericEnzyme 68" -> { };
"GenericEnzyme 69" -> { };
"GenericEnzyme 70" -> { };
"GenericEnzyme 71" -> { };
"GenericEnzyme 72" -> { "GenericEnzyme 73" "GenericEnzyme 74" };
"GenericEnzyme 73" -> { };
"GenericEnzyme 74" -> { };
"GenericEnzyme 75" -> { "GenericEnzyme 76" "GenericEnzyme 85" };
"GenericEnzyme 76" -> { "GenericEnzyme 77" "GenericEnzyme 78" "GenericEnzyme 79" "GenericEnzyme 80" "GenericEnzyme 82" "GenericEnzyme 84" };
"GenericEnzyme 77" -> { };
"GenericEnzyme 78" -> { };
"GenericEnzyme 79" -> { };
"GenericEnzyme 80" -> { "GenericEnzyme 81" };
"GenericEnzyme 81" -> { };
"GenericEnzyme 82" -> { "GenericEnzyme 83" };
"GenericEnzyme 83" -> { };
"GenericEnzyme 84" -> { };
"GenericEnzyme 85" -> { "GenericEnzyme 86" "GenericEnzyme 91" };
"GenericEnzyme 86" -> { "GenericEnzyme 87" "GenericEnzyme 88" "GenericEnzyme 89" };
"GenericEnzyme 87" -> { };
"GenericEnzyme 88" -> { };
"GenericEnzyme 89" -> { "GenericEnzyme 90" };
"GenericEnzyme 90" -> { };
"GenericEnzyme 91" -> { "GenericEnzyme 92" "GenericEnzyme 93" "GenericEnzyme 95" };
"GenericEnzyme 92" -> { };
"GenericEnzyme 93" -> { "GenericEnzyme 94" };
"GenericEnzyme 94" -> { };
"GenericEnzyme 95" -> { };
}

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 <> "\""

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)