such progress, much wow.

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' :: Int -> Int -> [Plant] -> Simulation -> IO ()
-    loop' loopAmount curLoop plants e = unless (loopAmount+1 == curLoop) $ do
+    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) 
+            putStrLn $ "Population statistics           (mean,variance):"
-                                         ++ " DistC = " ++ (padded 50 . show . meanOfDistinctCompounds $ cs)
+            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
+  --let env              = exampleEnvironment (getTreeSize randomCompounds) (generateEnzymeFromTree randomCompounds) (zip predators probs) poisonCompounds
-      emptyPlants      = replicate (numPlants . settings $ env) emptyPlant
+  (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:"
+      n = length ps
-  forM_ ps $ \(_,f,_) -> putStr (printColor f '█')
+      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

package.yaml

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

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
+  preds <- fromEnv predators
-  randPred <- asks (predatorsRandom . settings)
+  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
+  numIter <- fromEnv metabolismIteration
-  numCompounds <- asks maxCompound
+  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)

src/Evaluation.hs

@@ -1,6 +1,10 @@
-module Evaluation ( varianceOfProducedCompounds
+module Evaluation
-                  , meanOfDistinctCompounds
+  ( sumProducedCompounds
-                  ) where
+  , 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
+-- | sum of produced compounds ignoring everything defined as 'Nutrient'.
-varianceOfProducedCompounds comps = F.fold F.variance $ sumElements <$> comps
+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
+numDistinctCompounds :: Functor f => f (LA.Vector Amount) -> f Amount
-meanOfDistinctCompounds comps = F.fold F.mean $ sumElements . LA.cmap (\x -> if abs x < eps then 0 else 1) <$> comps
+--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

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