better fitness

This commit is contained in:
Nicole Dresselhaus 2018-05-23 13:07:34 +02:00
parent 8eeb837b9f
commit ee008ba920
Signed by: Drezil
GPG Key ID: 057D94F356F41E25
2 changed files with 25 additions and 8 deletions

View File

@ -86,12 +86,13 @@ loop loopAmount = loop' loopAmount 0
putStrLn "" putStrLn ""
putStrLn $ "Generation " ++ show curLoop ++ " of " ++ show loopAmount ++ ":" putStrLn $ "Generation " ++ show curLoop ++ " of " ++ show loopAmount ++ ":"
newPlants <- flip runReaderT e $ do 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 let fps = zip plants fs -- gives us plants & their fitness in a tuple
sumFitness = sum fs sumFitness = sum fs
pe <- asks possibleEnzymes pe <- asks possibleEnzymes
tc <- fmap fst <$> asks toxicCompounds tc <- asks toxicCompounds
liftIO $ printPopulation tc pe fps liftIO $ printPopulation tc pe fps
liftIO $ hFlush stdout
-- generate 100 new plants. -- generate 100 new plants.
sequence . flip fmap [1..100] $ \_ -> do sequence . flip fmap [1..100] $ \_ -> do
parent' <- liftIO $ randomRIO (0,sumFitness) parent' <- liftIO $ randomRIO (0,sumFitness)
@ -140,7 +141,7 @@ main = do
generatePredators :: Double -> EnzymeTree s (Double,Compound) -> IO [Predator] generatePredators :: Double -> EnzymeTree s (Double,Compound) -> IO [Predator]
generatePredators threshold t = do generatePredators threshold t = do
ps <- mapM generatePredators' $ getSubTrees t 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 where
generatePredators' :: (EnzymeTree s (Double, Compound)) -> IO [Predator] generatePredators' :: (EnzymeTree s (Double, Compound)) -> IO [Predator]
generatePredators' t = do -- not fully resistant to t, but fully resistant to everything in ts 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 $ "Compounds: " ++ show ((toEnum <$> [0..maxComp]) :: [Compound])
putStrLn $ "Toxic: " ++ show toxic putStrLn $ "Toxic: " ++ show toxic
printPopulation :: [Compound] -> [Enzyme] -> [(Plant,Double)] -> IO () printPopulation :: [(Compound, Amount)] -> [Enzyme] -> [(Plant,Double)] -> IO ()
printPopulation toxins es ps = do printPopulation toxins es ps = do
let padded i str = take i $ str ++ repeat ' ' let padded i str = take i $ str ++ repeat ' '
putStr $ padded 50 "Population:" putStr $ padded 50 "Population:"
forM_ ps $ \(_,f) -> putStr (printColor f '█') forM_ ps $ \(_,f) -> putStr (printColor f '█')
putStrLn colorOff putStrLn colorOff
forM_ es $ \e -> do forM_ es $ \e -> do
putStr $ if (fst . snd . synthesis $ e) `elem` toxins then "\ESC[31m" ++ padded 50 (show (enzymeName e)) ++ "\ESC[0m" putStr $ case Data.List.find (\(t,_) -> (t==) . fst . snd . synthesis $ e) toxins of
else padded 50 (show (enzymeName e)) 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 forM_ ps $ \(Plant g _,_) -> do
let curE = sum $ map (\(_,q,a) -> fromIntegral q*a) let curE = sum $ map (\(_,q,a) -> fromIntegral q*a)
. filter (\(e',_,_) -> e == e') . filter (\(e',_,_) -> e == e')

View File

@ -151,7 +151,15 @@ fitness p = do
products <- produceCompounds p nutrients -- produce compounds products <- produceCompounds p nutrients -- produce compounds
survivalRate <- deterPredators products -- defeat predators with produced 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" 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 return $ survivalRate * costOfEnzymes
-- can also be written as, but above is more clear. -- can also be written as, but above is more clear.
-- fitness p = absorbNutrients p >>= produceCompounds p >>= deterPredators -- fitness p = absorbNutrients p >>= produceCompounds p >>= deterPredators
@ -174,16 +182,22 @@ produceCompounds (Plant genes _) substrate = do
return final 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 :: Vector Amount -> World Probability
deterPredators cs = do deterPredators cs = do
ps <- asks predators ps <- asks predators
ts <- asks toxicCompounds ts <- asks toxicCompounds
ds <- liftIO $ randoms <$> newStdGen
let 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 deter :: Predator -> Double
-- multiply (toxicity of t with 100% effectiveness at l| for all toxins t | and t not in p's irresistance-list) -- 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] 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) -- 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 -- Mating & Creation of diversity
-- ------------------------------ -- ------------------------------