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