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

such progress, much wow.

Browse Source
This commit is contained in:
Nicole Dresselhaus 2018-06-08 02:16:17 +02:00
parent 8befc7c94d
commit f2ca0b1834
Signed by: Drezil
GPG Key ID: 057D94F356F41E25
5 changed files with 163 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
app/Main.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Text.Printf
@ -8,8 +9,12 @@ import Data.List
import System.Random
import Control.Concurrent
import Control.Parallel.Strategies
import Control.Monad.Writer
import qualified Debug.Trace as Debug
import qualified Control.Foldl as F
import System.IO
import Data.Aeson
import qualified Data.ByteString as BS
import ArbitraryEnzymeTree
import Environment
@ -38,9 +43,9 @@ exampleEnvironment addedC es pred tox =
, maxCompound = maxCompoundWithoutGeneric + addedC
, toxicCompounds = tox --[(Produced FPP,0.1)] ++ tox
, possibleEnzymes = es -- [pps,fpps] ++ es
, settings = Settings { automimicry = True
, settings = Settings { automimicry = False
, predatorsRandom = False
, numPlants = 150
, numPlants = 50
}
}
@ -63,7 +68,7 @@ exampleEnvironment addedC es pred tox =
-- defaultAbsorption = fmap ( limit Phosphor 2
-- . limit Nitrate 1
-- . limit Sulfur 0
-- ) <$> asks soil
-- ) <$> fromEnv soil
-- -- custom absorbtion with helper-function:
-- limit :: Nutrient -> Amount -> (Nutrient, Amount) -> (Nutrient, Amount)
-- limit n a (n', a')
@ -73,7 +78,7 @@ exampleEnvironment addedC es pred tox =
-- Running the simulation
-- ----------------------
loop :: Int -> [Plant] -> Environment -> IO ()
loop :: Int -> [Plant] -> Simulation -> IO ()
loop loopAmount ps env = loop' loopAmount 0 ps env
where
@ -83,30 +88,39 @@ loop loopAmount ps env = loop' loopAmount 0 ps env
Just (_,toxicity) -> (e,"\ESC[38;5;" ++ show (16 + 36*5 + 6*floor (5*(1-toxicity)) + 0) ++ "m" -- yellow -> red rainbow for tocixity 0 -> 1
++ padded 50 (show (enzymeName e)) ++ "\ESC[0m")
Nothing -> (e, padded 50 (show (enzymeName e)))
) <$> possibleEnzymes env
) <$> possibleEnzymes (snd env)
toxins :: [(Compound, Amount)]
toxins = toxicCompounds env
toxins = toxicCompounds (snd env)
padded i str = take i $ str ++ repeat ' '
printEvery = 10
loop' :: Int -> Int -> [Plant] -> Environment -> IO ()
loop' loopAmount curLoop plants e = unless (loopAmount+1 == curLoop) $ do
loop' :: Int -> Int -> [Plant] -> Simulation -> IO ()
loop' loopAmount curLoop plants s = unless (loopAmount+1 == curLoop) $ do
when (curLoop `mod` printEvery == 0) $ do
putStr "\ESC[2J\ESC[H"
printEnvironment e
printEnvironment (snd env)
putStrLn ""
putStrLn $ "Generation " ++ show curLoop ++ " of " ++ show loopAmount ++ ":"
newPlants <- flip runReaderT e $ do
newPlants <- simulate s $ do
(!fs,cs) <- unzip <$> fitness plants
let fps = zip plants fs -- gives us plants & their fitness in a tuple
sumFitness = sum fs
spc = meanAndVar `from` sumProducedCompounds $ cs
ndc = meanAndVar `from` numDistinctCompounds $ cs
fns = meanAndVar `from` id $ fs
when (curLoop `mod` printEvery == 0) $ liftIO $ do
printPopulation stringe (zip3 plants fs cs)
putStrLn $ "Population statistics: VarC = " ++ (padded 50 . show . varianceOfProducedCompounds $ cs)
++ " DistC = " ++ (padded 50 . show . meanOfDistinctCompounds $ cs)
putStrLn $ "Population statistics (mean,variance):"
putStrLn $ "Amount of Components produced = " ++ (padded 50 . show $ spc)
putStrLn $ "Number of distinct Components = " ++ (padded 50 . show $ ndc)
putStrLn $ "Fitness = " ++ (padded 50 . show $ fns)
hFlush stdout
threadDelay $ 100*1000 -- sleep x*1000ns (=x ~ ms)
threadDelay $ 10*1000 -- sleep x*1000ns (=x ~ ms)
tell $ show curLoop
++ "," ++ show (fst spc) ++ "," ++ show (snd spc)
++ "," ++ show (fst ndc) ++ "," ++ show (snd ndc)
++ "," ++ show (fst fns) ++ "," ++ show (snd fns)
-- generate x new plants.
np <- asks (numPlants . settings)
np <- fromEnv (numPlants . settings)
sequence . flip fmap [1..np] $ \_ -> do
parent' <- liftIO $ randomRIO (0,sumFitness)
let
@ -119,26 +133,29 @@ loop loopAmount ps env = loop' loopAmount 0 ps env
| otherwise = findParent (x-f) ps
parent = findParent parent' fps
haploMate parent
loop' loopAmount (curLoop+1) newPlants e
loop' loopAmount (curLoop+1) newPlants s
main :: IO ()
main = do
hSetBuffering stdin NoBuffering
--hSetBuffering stdout NoBuffering
randomCompounds <- makeHead (Substrate PPM) <$> generateTreeFromList 40 (toEnum <$> [(maxCompoundWithoutGeneric+1)..] :: [Compound]) -- generate roughly x compounds
randomCompounds <- makeHead (Substrate PPM) <$> generateTreeFromList 30 (toEnum <$> [(maxCompoundWithoutGeneric+1)..] :: [Compound]) -- generate roughly x compounds
ds <- randoms <$> newStdGen
probs <- randomRs (0.2,0.7) <$> newStdGen
--probs <- randomRs (0.2,0.7) <$> newStdGen
let poisonedTree = poisonTree ds randomCompounds
poisonCompounds = foldMap (\(a,b) -> [(b,a) | a > 0.5]) poisonedTree
predators <- generatePredators 0.5 poisonedTree
let env = exampleEnvironment (getTreeSize randomCompounds) (generateEnzymeFromTree randomCompounds) (zip predators probs) poisonCompounds
emptyPlants = replicate (numPlants . settings $ env) emptyPlant
--let env = exampleEnvironment (getTreeSize randomCompounds) (generateEnzymeFromTree randomCompounds) (zip predators probs) poisonCompounds
(Just env) <- decodeStrict' <$> BS.readFile "environment2.json"
let emptyPlants = replicate (numPlants . settings $ env) emptyPlant
enzs <- randomRs (0,length (possibleEnzymes env) - 1) <$> newStdGen
let startPlants = randomGenome 1 enzs (possibleEnzymes env) emptyPlants
printEnvironment env
writeFile "poison.twopi" $ generateDotFromPoisonTree "poison" 0.5 poisonedTree
--writeFile "environment.json" . encode $ env
putStr "\ESC[?1049h"
loop 2000 startPlants env
logfile <- openFile "simulation.log" WriteMode
loop 2000 startPlants (logfile,env)
putStrLn "Simulation ended. Press key to exit."
_ <- getChar
putStr "\ESC[?1049l"
@ -182,8 +199,12 @@ printEnvironment (Environment soil pred metaIter maxComp toxic possEnz settings)
printPopulation :: [(Enzyme,String)] -> [(Plant,Double,Vector Amount)] -> IO ()
printPopulation es ps = do
let padded i str = take i $ str ++ repeat ' '
putStr $ padded 50 "Population:"
forM_ ps $ \(_,f,_) -> putStr (printColor f '█')
n = length ps
fitnesses = (\(_,f,_) -> f) <$> ps
meanFitness = sum fitnesses / fromIntegral n
maxFitness = maximum fitnesses
putStr $ padded 50 ("Population: (fitness: mean " ++ padded 5 (show meanFitness) ++ ", max: " ++ padded 5 (show maxFitness) ++ ")")
forM_ ps $ \(_,f,_) -> putStr (printColor (f/maxFitness) '█')
putStrLn colorOff
forM_ es $ \(e,s) -> do
putStr s
@ -204,6 +225,7 @@ printPopulation es ps = do
printColor :: Double -> Char -> String
printColor x c
| x > 1 = "Error: " ++ show x
| x*x < 0.5 = "\ESC[38;5;" ++ show (16 + 36*5 + 6*floor (5*2*x') + 0) ++ "m" ++ [c] ++ ""
| otherwise = "\ESC[38;5;" ++ show (16 + 36*floor (5*2*(1-x')) + 6*5 + 0) ++ "m" ++ [c] ++ ""
-- 32 bit

2
package.yaml
View File

@ -28,6 +28,8 @@ dependencies:
- pretty-simple
- parallel
- foldl
- aeson
- bytestring
library:
source-dirs: src

75
src/Environment.hs
View File

@ -1,14 +1,24 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Environment where
import Data.Functor ((<$>))
import Control.Applicative ((<*>))
import Control.Monad (forM_)
import Control.Monad.Reader
import Control.Monad.Writer.Strict
import Control.Parallel.Strategies
import Data.List (permutations, subsequences)
import Numeric.LinearAlgebra
import Text.Printf
import System.Random
import System.IO
import Data.Aeson
import GHC.Generics
import WriterIO
type Probability = Double
type Quantity = Int
@ -17,18 +27,27 @@ type Amount = Double
-- | Nutrients are the basis for any reaction and are found in the environment of the plant.
data Nutrient = PPM
deriving (Show, Enum, Bounded, Eq)
deriving (Show, Enum, Bounded, Eq, Generic)
instance FromJSON Nutrient
instance ToJSON Nutrient
-- | Fixed, non-generic Components
data Component = PP
| FPP
deriving (Show, Enum, Bounded, Eq)
deriving (Show, Enum, Bounded, Eq, Generic)
instance FromJSON Component
instance ToJSON Component
-- | Compounds are either direct nutrients, already processed components or GenericCompound
data Compound = Substrate Nutrient
| Produced Component
| GenericCompound Int
deriving (Show, Eq)
deriving (Show, Eq, Generic)
instance FromJSON Compound
instance ToJSON Compound
instance Enum Compound where
toEnum x
@ -64,7 +83,10 @@ data Enzyme = Enzyme
-- ^ in case of competition for nutrients this denotes the priority
-- Nothing = max possible
}
deriving (Show, Eq)
deriving (Show, Eq, Generic)
instance FromJSON Enzyme
instance ToJSON Enzyme
-- | conviniently make an Enzyme using 1 of the first compund to produce 1 of the second
makeSimpleEnzyme :: Compound -> Compound -> Enzyme
@ -84,14 +106,20 @@ data Predator = Predator { irresistance :: [Compound]
, numAttacks :: Amount
-- ^ Avarage number of attacks in a generation of appearance
-- (~ mean of poisson-distribution)
} deriving (Show, Eq)
} deriving (Show, Eq, Generic)
instance FromJSON Predator
instance ToJSON Predator
-- | Settings to enable/disable parts of the simulation
data Settings = Settings { automimicry :: Bool -- ^ do we have automimicry-protection?
, predatorsRandom :: Bool -- ^ do predators always appear or according to their random distribution?
, numPlants :: Int -- ^ number of plants in starting population
}
deriving (Show, Eq)
deriving (Show, Eq, Generic)
instance FromJSON Settings
instance ToJSON Settings
-- | The environment itself.
@ -116,13 +144,26 @@ data Environment =
, possibleEnzymes :: [Enzyme]
-- ^ All enzymes that can be created by genetic manipulation in this setting.
, settings :: Settings
} deriving (Show, Eq)
} deriving (Show, Eq, Generic)
instance FromJSON Environment
instance ToJSON Environment
-- helper function. Allows for [0..maxCompoundWithoutGeneric] :: [Compound] with all non-generic Compounds
maxCompoundWithoutGeneric :: Int
maxCompoundWithoutGeneric = fromEnum (maxBound :: Nutrient) + fromEnum (maxBound :: Component) + 1
type World a = ReaderT Environment IO a
type Simulation = (Handle, Environment)
type World a = WriterIOT (ReaderT Simulation IO) a
instance HasHandle (WriterIOT (ReaderT Simulation IO)) where
getHandle = asks fst
fromEnv :: (Environment -> a) -> World a
fromEnv f = asks $ f . snd
simulate :: Simulation -> World a -> IO a
simulate (log, e) = fmap fst . flip runReaderT (log,e) . runWriterT . getWriterT
-- Plants
-- ------
@ -158,15 +199,15 @@ fitness ps = do
nutrients <- mapM absorbNutrients ps -- absorb soil
products <- sequenceA $ zipWith produceCompounds ps nutrients -- produce compounds
ds <- liftIO $ randoms <$> newStdGen
preds <- asks predators
randPred <- asks (predatorsRandom . settings)
preds <- fromEnv predators
randPred <- fromEnv (predatorsRandom . settings)
let
appearingPredators = if randPred then
fmap (fst . fst) . filter (\((_,p),r) -> p > r) $ zip preds ds -- assign one probability to each predator, filter those who appear, throw random data away again.
-- appearingPredators is now a sublist of preds without the probability.
else
fst <$> preds -- else just forget about probabilities
automimicry <- asks (automimicry . settings)
automimicry <- fromEnv (automimicry . settings)
popDefense <- if automimicry then
forM appearingPredators $ \p -> do
as <- mapM (dieToPredator p) products -- how good can an individual deter p
@ -176,7 +217,7 @@ fitness ps = do
dieRate <- mapM (dieToPredators (zip appearingPredators popDefense)) products -- defeat predators with produced compounds
let sumEnzymes = sum . fmap (\(_,q,a) -> fromIntegral q*a) . genome <$> ps -- amount of enzymes * activation = resources "wasted"
staticCostOfEnzymes = (\x -> 1 - 0.02*x) <$> sumEnzymes -- static cost of creating enzymes
nutrientsAvailable <- fmap snd <$> asks soil
nutrientsAvailable <- fmap snd <$> fromEnv soil
let nutrientsLeft = (\p -> [p ! i | i <- [0..fromEnum (maxBound :: Nutrient)]]) <$> products
nutrientRatio = minimum . zipWith (flip (/)) nutrientsAvailable <$> nutrientsLeft
costOfEnzymes = max 0 <$> zipWith (\s n -> s-n*0.1) staticCostOfEnzymes nutrientRatio -- cost to keep enzymes are static costs + amount of nutrient sucked out of the primary cycle
@ -186,8 +227,8 @@ fitness ps = do
produceCompounds :: Plant -> [(Nutrient, Amount)] -> World (Vector Amount)
produceCompounds (Plant genes _) substrate = do
numIter <- asks metabolismIteration
numCompounds <- asks maxCompound
numIter <- fromEnv metabolismIteration
numCompounds <- fromEnv 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
@ -218,7 +259,7 @@ dieToPredators appearingPredators compounds = do
dieToPredator :: Predator -> Vector Amount -> World Double
dieToPredator p comps = do
toxins <- asks toxicCompounds
toxins <- fromEnv toxicCompounds
return $ product [1 - min 1 (comps ! fromEnum t * l) | (t,l) <- toxins, t `elem` irresistance p]
-- Mating & Creation of diversity
@ -239,7 +280,7 @@ haploMate (Plant genes abs) = do
r3 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
r4 <- liftIO digen
r5 <- liftIO digen
enzymes <- asks possibleEnzymes
enzymes <- fromEnv possibleEnzymes
re1 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
re2 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
let
@ -288,7 +329,7 @@ haploMate (Plant genes abs) = do
-- | Plant with no secondary metabolism with unlimited extraction from environment.
emptyPlant :: Plant
emptyPlant = Plant [] (asks soil)
emptyPlant = Plant [] (fromEnv soil)
getAmountOf :: Compound -> [(Compound, Amount)] -> Amount
getAmountOf c = sum . fmap snd . filter ((== c) . fst)

40
src/Evaluation.hs
View File

@ -1,6 +1,10 @@
module Evaluation ( varianceOfProducedCompounds
, meanOfDistinctCompounds
) where
module Evaluation
( sumProducedCompounds
, numDistinctCompounds
, sumCompounds
, from
, meanAndVar
) where
import Control.Foldl as F
import Numeric.LinearAlgebra as LA
@ -10,11 +14,31 @@ import Environment
eps :: Amount
eps = 0.01
varianceOfProducedCompounds :: [LA.Vector Amount] -> Double
varianceOfProducedCompounds comps = F.fold F.variance $ sumElements <$> comps
-- | sum of produced compounds ignoring everything defined as 'Nutrient'.
sumProducedCompounds :: Functor f => f (LA.Vector Amount) -> f Amount
-- sumProducedCompounds :: [LA.Vector Amount] -> [Amount]
-- cut off numNutrients from the start of the vector and then sum.
sumProducedCompounds = fmap $ (\v -> sumElements . LA.subVector numNutrients (size v - numNutrients) $ v)
where
numNutrients = fromEnum (maxBound :: Nutrient) + 1 --enum starts at 0, subVector-indexing at 1
-- | sum of all compounds
sumCompounds :: Functor f => f (LA.Vector Amount) -> f Amount
--sumCompounds :: [LA.Vector Amount] -> [Amount]
sumCompounds = fmap sumElements
-- | count compound as active if it is over eps.
meanOfDistinctCompounds :: [LA.Vector Amount] -> Double
meanOfDistinctCompounds comps = F.fold F.mean $ sumElements . LA.cmap (\x -> if abs x < eps then 0 else 1) <$> comps
numDistinctCompounds :: Functor f => f (LA.Vector Amount) -> f Amount
--numDistinctCompounds :: [LA.Vector Amount] -> [Amount]
numDistinctCompounds comps = sumElements . LA.cmap (\x -> if abs x < eps then 0 else 1) <$> comps
-- TODO: Mean enzyme-activity?
-- | helper function for Foldl-Package.
--
-- Usage: @F.mean `from` sumCompounds $ v@ where v is a Set/List/Vector/... of Vector of Compounds.
infixr 9 `from`
from :: Foldable f => F.Fold a b -> (c -> f a) -> c -> b
from f w b = F.fold f (w b)
-- | helper to get mean and variance in a single pass.
meanAndVar :: F.Fold Amount (Amount,Amount)
meanAndVar = (,) <$> F.mean <*> F.variance

27
src/WriterIO.hs Normal file
View File

@ -0,0 +1,27 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
module WriterIO (
WriterIOT(..)
, HasHandle(..)
) where
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer.Strict
import System.IO
newtype WriterIOT m a = WriterIOT { getWriterT :: WriterT () m a }
deriving (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadReader r, MonadState s)
class HasHandle m where
getHandle :: m Handle
instance (MonadIO m, HasHandle (WriterIOT m)) => MonadWriter String (WriterIOT m) where
tell w = do
h <- getHandle
liftIO $ hPutStrLn h w
listen = fmap (\a -> (a,error "cannot read from already written stuff"))
pass = fmap fst