better fitness
This commit is contained in:
parent
8eeb837b9f
commit
ee008ba920
15
app/Main.hs
15
app/Main.hs
@ -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')
|
||||||
|
@ -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
|
||||||
-- ------------------------------
|
-- ------------------------------
|
||||||
|
Loading…
Reference in New Issue
Block a user