From ee008ba9209c5f3c84a24a047920b6c057ddcb37 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 23 May 2018 13:07:34 +0200 Subject: [PATCH] better fitness --- app/Main.hs | 15 +++++++++------ src/Environment.hs | 18 ++++++++++++++++-- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 3d9bf30..a2609a3 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -86,12 +86,13 @@ loop loopAmount = loop' loopAmount 0 putStrLn "" putStrLn $ "Generation " ++ show curLoop ++ " of " ++ show loopAmount ++ ":" newPlants <- flip runReaderT e $ do - fs <- sequence (fitness <$> plants) + ! fs <- sequence (fitness <$> plants) let fps = zip plants fs -- gives us plants & their fitness in a tuple sumFitness = sum fs pe <- asks possibleEnzymes - tc <- fmap fst <$> asks toxicCompounds + tc <- asks toxicCompounds liftIO $ printPopulation tc pe fps + liftIO $ hFlush stdout -- generate 100 new plants. sequence . flip fmap [1..100] $ \_ -> do parent' <- liftIO $ randomRIO (0,sumFitness) @@ -140,7 +141,7 @@ main = do generatePredators :: Double -> EnzymeTree s (Double,Compound) -> IO [Predator] generatePredators threshold t = do ps <- mapM generatePredators' $ getSubTrees t - return $ concat ps + return $ filter ((/= []) . irresistance) $ concat ps -- filter out predators that are resistant to everything because this does not make sense in our model. where generatePredators' :: (EnzymeTree s (Double, Compound)) -> IO [Predator] generatePredators' t = do -- not fully resistant to t, but fully resistant to everything in ts @@ -162,15 +163,17 @@ printEnvironment (Environment soil pred metaIter maxComp toxic possEnz) = putStrLn $ "Compounds: " ++ show ((toEnum <$> [0..maxComp]) :: [Compound]) putStrLn $ "Toxic: " ++ show toxic -printPopulation :: [Compound] -> [Enzyme] -> [(Plant,Double)] -> IO () +printPopulation :: [(Compound, Amount)] -> [Enzyme] -> [(Plant,Double)] -> IO () printPopulation toxins es ps = do let padded i str = take i $ str ++ repeat ' ' putStr $ padded 50 "Population:" forM_ ps $ \(_,f) -> putStr (printColor f '█') putStrLn colorOff forM_ es $ \e -> do - putStr $ if (fst . snd . synthesis $ e) `elem` toxins then "\ESC[31m" ++ padded 50 (show (enzymeName e)) ++ "\ESC[0m" - else padded 50 (show (enzymeName e)) + putStr $ case Data.List.find (\(t,_) -> (t==) . fst . snd . synthesis $ e) toxins of + Just (_,toxicity) -> "\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 -> padded 50 (show (enzymeName e)) forM_ ps $ \(Plant g _,_) -> do let curE = sum $ map (\(_,q,a) -> fromIntegral q*a) . filter (\(e',_,_) -> e == e') diff --git a/src/Environment.hs b/src/Environment.hs index c241f92..36d0bd7 100644 --- a/src/Environment.hs +++ b/src/Environment.hs @@ -151,7 +151,15 @@ fitness p = do products <- produceCompounds p nutrients -- produce compounds survivalRate <- deterPredators products -- defeat predators with produced compounds let sumEnzymes = sum $ (\(_,q,a) -> fromIntegral q*a) <$> genome p -- amount of enzymes * activation = resources "wasted" - costOfEnzymes = 0.99 ** sumEnzymes + staticCostOfEnzymes = 1 - 0.01*sumEnzymes -- static cost of creating enzymes + -- primaryEnzymes = filter (\(e,_,_) -> case (fst.fst.synthesis) e of -- select enzymes which use substrate + -- Substrate _ -> True + -- otherwise -> False) + -- (genome p) + nutrientsAvailable <- fmap snd <$> asks soil + let nutrientsLeft = [products ! i | i <- [0..fromEnum (maxBound :: Nutrient)]] + nutrientRatio = minimum $ zipWith (/) nutrientsLeft nutrientsAvailable + costOfEnzymes = max 0 $ staticCostOfEnzymes - nutrientRatio * 0.1 -- cost to keep enzymes are static costs + amount of nutrient sucked out of the primary cycle return $ survivalRate * costOfEnzymes -- can also be written as, but above is more clear. -- fitness p = absorbNutrients p >>= produceCompounds p >>= deterPredators @@ -174,16 +182,22 @@ produceCompounds (Plant genes _) substrate = do return final +-- TODO: +-- - choose predators beforehand, then only apply those who appear in full force. +-- - dampen full-force due to auto-mimicry-effect. => Fitness would not depend on single plant. deterPredators :: Vector Amount -> World Probability deterPredators cs = do ps <- asks predators ts <- asks toxicCompounds + ds <- liftIO $ randoms <$> newStdGen let + appearingPredators = fmap fst . filter (\((_,p),r) -> p > r) $ zip ps ds -- assign one probability to each predator, filter those who appear, throw random data away again. + -- appearingPredators is now a sublist of ps. deter :: Predator -> Double -- multiply (toxicity of t with 100% effectiveness at l| for all toxins t | and t not in p's irresistance-list) deter p = product [1 - min 1 (cs ! fromEnum t / l) | (t,l) <- ts, t `elem` irresistance p] -- multiply (probability of occurence * intensity of destruction / probability to deter predator | for all predators) - return $ product ([min 1 ((1-prob) * fitnessImpact p / deter p) | (p,prob) <- ps] `using` parList rdeepseq) + return $ product ([min 1 ((1-prob) * fitnessImpact p / deter p) | (p,prob) <- appearingPredators]) -- Mating & Creation of diversity -- ------------------------------