such progress, much wow.
This commit is contained in:
Stefan Dresselhaus
66
app/Main.hs
66
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
|
||||
|
||||
Reference in New Issue
Block a user