From f2ca0b18349a5de8db59f5bf8002f2fbcdb89683 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Fri, 8 Jun 2018 02:16:17 +0200 Subject: [PATCH] such progress, much wow. --- app/Main.hs | 66 ++++++++++++++++++++++++++-------------- package.yaml | 2 ++ src/Environment.hs | 75 +++++++++++++++++++++++++++++++++++----------- src/Evaluation.hs | 40 ++++++++++++++++++++----- src/WriterIO.hs | 27 +++++++++++++++++ 5 files changed, 163 insertions(+), 47 deletions(-) create mode 100644 src/WriterIO.hs diff --git a/app/Main.hs b/app/Main.hs index f798183..1207f53 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/package.yaml b/package.yaml index 6bf64cc..f6e9b31 100644 --- a/package.yaml +++ b/package.yaml @@ -28,6 +28,8 @@ dependencies: - pretty-simple - parallel - foldl +- aeson +- bytestring library: source-dirs: src diff --git a/src/Environment.hs b/src/Environment.hs index 10293a5..3b283c5 100644 --- a/src/Environment.hs +++ b/src/Environment.hs @@ -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) diff --git a/src/Evaluation.hs b/src/Evaluation.hs index fc8deaf..923d1e7 100644 --- a/src/Evaluation.hs +++ b/src/Evaluation.hs @@ -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 diff --git a/src/WriterIO.hs b/src/WriterIO.hs new file mode 100644 index 0000000..3af3e70 --- /dev/null +++ b/src/WriterIO.hs @@ -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