no diversity. needs static tests.
This commit is contained in:
Stefan Dresselhaus
123
app/Main.hs
123
app/Main.hs
@ -13,33 +13,32 @@ import System.IO
|
||||
|
||||
import ArbitraryEnzymeTree
|
||||
import Environment
|
||||
import Evaluation
|
||||
|
||||
-- Example definitions
|
||||
-- -------------------
|
||||
|
||||
-- Enzymes
|
||||
|
||||
pps :: Enzyme -- uses Phosphor from Substrate to produce PP
|
||||
pps = Enzyme "PPS" [(Substrate Phosphor,1)] ((Substrate Phosphor,-1),(Produced PP,1)) Nothing
|
||||
|
||||
fpps :: Enzyme -- PP -> FPP
|
||||
fpps = makeSimpleEnzyme (Produced PP) (Produced FPP)
|
||||
-- pps :: Enzyme -- uses Phosphor from Substrate to produce PP
|
||||
-- pps = Enzyme "PPS" [(Substrate Phosphor,1)] ((Substrate Phosphor,-1),(Produced PP,1)) Nothing
|
||||
--
|
||||
-- fpps :: Enzyme -- PP -> FPP
|
||||
-- fpps = makeSimpleEnzyme (Produced PP) (Produced FPP)
|
||||
|
||||
-- Environment
|
||||
|
||||
exampleEnvironment :: Int -> [Enzyme] -> [(Predator,Probability)] -> [(Compound,Amount)] -> Environment
|
||||
exampleEnvironment addedC es pred tox =
|
||||
Environment
|
||||
{ soil = [ (Nitrate, 2)
|
||||
, (Phosphor, 3)
|
||||
, (Photosynthesis, 10)
|
||||
{ soil = [ (PPM, 10)
|
||||
]
|
||||
, predators = pred -- [ (greenfly, 0.1) ]
|
||||
, metabolismIteration = 100
|
||||
, 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
|
||||
}
|
||||
@ -47,29 +46,29 @@ exampleEnvironment addedC es pred tox =
|
||||
|
||||
-- Plants
|
||||
|
||||
examplePlants :: [Plant]
|
||||
examplePlants = (\g -> Plant g defaultAbsorption) <$> genomes
|
||||
where
|
||||
enzymes = [pps, fpps]
|
||||
quantity = [1,2] :: [Quantity]
|
||||
activation = [0.7, 0.9, 1]
|
||||
|
||||
genomes = do
|
||||
e <- permutations enzymes
|
||||
e' <- subsequences e
|
||||
q <- quantity
|
||||
a <- activation
|
||||
return $ (,,) <$> e' <*> [q] <*> [a]
|
||||
|
||||
defaultAbsorption = fmap ( limit Phosphor 2
|
||||
. limit Nitrate 1
|
||||
. limit Sulfur 0
|
||||
) <$> asks soil
|
||||
-- custom absorbtion with helper-function:
|
||||
limit :: Nutrient -> Amount -> (Nutrient, Amount) -> (Nutrient, Amount)
|
||||
limit n a (n', a')
|
||||
| n == n' = (n, min a a') -- if we should limit, then we do ;)
|
||||
| otherwise = (n', a')
|
||||
-- examplePlants :: [Plant]
|
||||
-- examplePlants = (\g -> Plant g defaultAbsorption) <$> genomes
|
||||
-- where
|
||||
-- enzymes = [pps, fpps]
|
||||
-- quantity = [1,2] :: [Quantity]
|
||||
-- activation = [0.7, 0.9, 1]
|
||||
--
|
||||
-- genomes = do
|
||||
-- e <- permutations enzymes
|
||||
-- e' <- subsequences e
|
||||
-- q <- quantity
|
||||
-- a <- activation
|
||||
-- return $ (,,) <$> e' <*> [q] <*> [a]
|
||||
--
|
||||
-- defaultAbsorption = fmap ( limit Phosphor 2
|
||||
-- . limit Nitrate 1
|
||||
-- . limit Sulfur 0
|
||||
-- ) <$> asks soil
|
||||
-- -- custom absorbtion with helper-function:
|
||||
-- limit :: Nutrient -> Amount -> (Nutrient, Amount) -> (Nutrient, Amount)
|
||||
-- limit n a (n', a')
|
||||
-- | n == n' = (n, min a a') -- if we should limit, then we do ;)
|
||||
-- | otherwise = (n', a')
|
||||
|
||||
-- Running the simulation
|
||||
-- ----------------------
|
||||
@ -88,21 +87,25 @@ loop loopAmount ps env = loop' loopAmount 0 ps env
|
||||
toxins :: [(Compound, Amount)]
|
||||
toxins = toxicCompounds env
|
||||
padded i str = take i $ str ++ repeat ' '
|
||||
printEvery = 1
|
||||
printEvery = 10
|
||||
addedConstFitness = 0.1
|
||||
loop' :: Int -> Int -> [Plant] -> Environment -> IO ()
|
||||
loop' loopAmount curLoop plants e = unless (loopAmount == curLoop) $ do
|
||||
loop' loopAmount curLoop plants e = unless (loopAmount+1 == curLoop) $ do
|
||||
when (curLoop `mod` printEvery == 0) $ do
|
||||
putStr "\ESC[2J\ESC[H"
|
||||
printEnvironment e
|
||||
putStrLn ""
|
||||
putStrLn $ "Generation " ++ show curLoop ++ " of " ++ show loopAmount ++ ":"
|
||||
newPlants <- flip runReaderT e $ do
|
||||
! fs <- fmap (+0.01) <$> fitness plants -- fitness should be at least 0.01 for mating to work
|
||||
(!fs,cs) <- unzip . fmap (\(f,c) -> (f,c)) <$> fitness plants
|
||||
let fps = zip plants fs -- gives us plants & their fitness in a tuple
|
||||
sumFitness = sum fs
|
||||
when (curLoop `mod` printEvery == 0) $ do
|
||||
liftIO $ printPopulation stringe fps
|
||||
liftIO $ hFlush stdout
|
||||
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)
|
||||
hFlush stdout
|
||||
threadDelay $ 100*1000 -- sleep x*1000ns (=x ~ ms)
|
||||
-- generate x new plants.
|
||||
np <- asks (numPlants . settings)
|
||||
sequence . flip fmap [1..np] $ \_ -> do
|
||||
@ -117,16 +120,13 @@ loop loopAmount ps env = loop' loopAmount 0 ps env
|
||||
| otherwise = findParent (x-f) ps
|
||||
parent = findParent parent' fps
|
||||
haploMate parent
|
||||
hFlush stdout
|
||||
when (curLoop `mod` printEvery == 0) $ do
|
||||
threadDelay $ 100*1000 -- sleep x*1000ns (=x ~ ms)
|
||||
loop' loopAmount (curLoop+1) newPlants e
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
hSetBuffering stdin NoBuffering
|
||||
--hSetBuffering stdout NoBuffering
|
||||
randomCompounds <- makeHead (Substrate Photosynthesis) <$> generateTreeFromList 30 (toEnum <$> [(maxCompoundWithoutGeneric+1)..] :: [Compound]) -- generate roughly x compounds
|
||||
randomCompounds <- makeHead (Substrate PPM) <$> generateTreeFromList 20 (toEnum <$> [(maxCompoundWithoutGeneric+1)..] :: [Compound]) -- generate roughly x compounds
|
||||
ds <- randoms <$> newStdGen
|
||||
probs <- randomRs (0.2,0.7) <$> newStdGen
|
||||
let poisonedTree = poisonTree ds randomCompounds
|
||||
@ -134,14 +134,26 @@ main = do
|
||||
predators <- generatePredators 0.5 poisonedTree
|
||||
let env = exampleEnvironment (getTreeSize randomCompounds) (generateEnzymeFromTree randomCompounds) (zip predators probs) poisonCompounds
|
||||
emptyPlants = replicate (numPlants . settings $ env) emptyPlant
|
||||
enzs <- randomRs (0,length (possibleEnzymes env) - 1) <$> newStdGen
|
||||
let startPlants = randomGenome 10 enzs (possibleEnzymes env) emptyPlants
|
||||
printEnvironment env
|
||||
writeFile "poison.twopi" $ generateDotFromPoisonTree "poison" 0.5 poisonedTree
|
||||
putStr "\ESC[?1049h"
|
||||
loop 200 emptyPlants env
|
||||
loop 2000 startPlants env
|
||||
putStrLn "Simulation ended. Press key to exit."
|
||||
_ <- getChar
|
||||
putStr "\ESC[?1049l"
|
||||
|
||||
randomGenome :: Int -> [Int] -> [Enzyme] -> [Plant] -> [Plant]
|
||||
randomGenome num inds enzs [] = []
|
||||
randomGenome num inds enzs (p:ps) = p { genome = genes} : randomGenome num r enzs ps
|
||||
where
|
||||
i' = take num inds
|
||||
r = drop num inds
|
||||
enzymes = (enzs!!) <$> i'
|
||||
genes = (\e -> (e,1,1)) <$> enzymes
|
||||
|
||||
|
||||
generatePredators :: Double -> EnzymeTree s (Double,Compound) -> IO [Predator]
|
||||
generatePredators threshold t = do
|
||||
ps <- mapM generatePredators' $ getSubTrees t
|
||||
@ -152,7 +164,7 @@ generatePredators threshold t = do
|
||||
let comps = foldMap (\(a,b) -> [(a,b) | a > threshold]) t
|
||||
amount <- randomRIO (0,length comps + 1) :: IO Int
|
||||
forM [1..amount] $ \_ -> do
|
||||
impact <- randomRIO (0.1,0.2)
|
||||
impact <- randomRIO (0.2,0.7)
|
||||
rands <- randoms <$> newStdGen
|
||||
let unresists = foldMap (\((a,b),r) -> [b | r*2 < a]) $ zip comps rands
|
||||
return $ Predator unresists impact 1
|
||||
@ -168,27 +180,28 @@ printEnvironment (Environment soil pred metaIter maxComp toxic possEnz settings)
|
||||
putStrLn $ "Toxic: " ++ show toxic
|
||||
putStrLn $ "Settings: " ++ show settings
|
||||
|
||||
printPopulation :: [(Enzyme,String)] -> [(Plant,Double)] -> IO ()
|
||||
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 '█')
|
||||
forM_ ps $ \(_,f,_) -> putStr (printColor f '█')
|
||||
putStrLn colorOff
|
||||
forM_ es $ \(e,s) -> do
|
||||
putStr s
|
||||
forM_ ps $ \(Plant g _,_) -> do
|
||||
forM_ ps $ \(Plant g _,_,cs) -> do
|
||||
let curE = sum $ map (\(_,q,a) -> fromIntegral q*a)
|
||||
. filter (\(e',_,_) -> e == e')
|
||||
$ g
|
||||
plot x
|
||||
| x > 2 = "O"
|
||||
| x > 1 = "+"
|
||||
| x > 0.7 = "ö"
|
||||
| x > 0.5 = "o"
|
||||
| x > 0 = "."
|
||||
| otherwise = "_"
|
||||
putStr (plot curE)
|
||||
putStrLn ""
|
||||
| x > 2 = 'O'
|
||||
| x > 1 = '+'
|
||||
| x > 0.7 = 'ö'
|
||||
| x > 0.5 = 'o'
|
||||
| x > 0 = '.'
|
||||
| otherwise = '_'
|
||||
amount = min 2 $ cs ! fromEnum (fst . snd . synthesis $ e)
|
||||
putStr $ printColor (amount/2) (plot curE)
|
||||
putStrLn colorOff
|
||||
|
||||
printColor :: Double -> Char -> String
|
||||
printColor x c
|
||||
|
||||
Reference in New Issue
Block a user