no diversity. needs static tests.
This commit is contained in:
Stefan Dresselhaus
@ -16,10 +16,7 @@ type Activation = Double
|
||||
type Amount = Double
|
||||
|
||||
-- | Nutrients are the basis for any reaction and are found in the environment of the plant.
|
||||
data Nutrient = Sulfur
|
||||
| Phosphor
|
||||
| Nitrate
|
||||
| Photosynthesis
|
||||
data Nutrient = PPM
|
||||
deriving (Show, Enum, Bounded, Eq)
|
||||
|
||||
-- | Fixed, non-generic Components
|
||||
@ -156,7 +153,7 @@ instance Eq Plant where
|
||||
|
||||
type Fitness = Double
|
||||
|
||||
fitness :: [Plant] -> World [Fitness]
|
||||
fitness :: [Plant] -> World [(Fitness, Vector Amount)]
|
||||
fitness ps = do
|
||||
nutrients <- mapM absorbNutrients ps -- absorb soil
|
||||
products <- sequenceA $ zipWith produceCompounds ps nutrients -- produce compounds
|
||||
@ -172,18 +169,20 @@ fitness ps = do
|
||||
automimicry <- asks (automimicry . settings)
|
||||
popDefense <- if automimicry then
|
||||
forM appearingPredators $ \p -> do
|
||||
as <- mapM (deterPredator p) products -- how good can an individual deter p
|
||||
as <- mapM (dieToPredator p) products -- how good can an individual deter p
|
||||
return $ sum as / fromIntegral (length as) -- how good can the population deter p on average
|
||||
else
|
||||
return $ repeat 1
|
||||
survivalRate <- mapM (deterPredators (zip appearingPredators popDefense)) products -- defeat predators with produced compounds
|
||||
dieRate <- mapM (dieToPredators (zip appearingPredators popDefense)) products -- defeat predators with produced compounds
|
||||
let sumEnzymes = sum . fmap (\(_,q,a) -> fromIntegral q*a) . genome <$> ps -- amount of enzymes * activation = resources "wasted"
|
||||
staticCostOfEnzymes = (\x -> 1 - 0.01*x) <$> sumEnzymes -- static cost of creating enzymes
|
||||
nutrientsAvailable <- fmap snd <$> asks soil
|
||||
let nutrientsLeft = (\p -> [p ! i | i <- [0..fromEnum (maxBound :: Nutrient)]]) <$> products
|
||||
nutrientRatio = minimum . zipWith (flip (/)) nutrientsAvailable <$> nutrientsLeft
|
||||
costOfEnzymes = max 0 <$> zipWith (\s n -> s-n*0.1) staticCostOfEnzymes nutrientRatio -- cost to keep enzymes are static costs + amount of nutrient sucked out of the primary cycle
|
||||
return $ zipWith (*) survivalRate costOfEnzymes
|
||||
costOfEnzymes = max 0 <$> zipWith (\s n -> s-n*0.01) staticCostOfEnzymes nutrientRatio -- cost to keep enzymes are static costs + amount of nutrient sucked out of the primary cycle
|
||||
survivalRate = (1-) <$> dieRate
|
||||
return $ (,) <$> zipWith (*) survivalRate costOfEnzymes
|
||||
<*> products
|
||||
|
||||
produceCompounds :: Plant -> [(Nutrient, Amount)] -> World (Vector Amount)
|
||||
produceCompounds (Plant genes _) substrate = do
|
||||
@ -207,16 +206,17 @@ produceCompounds (Plant genes _) substrate = do
|
||||
-- so F(D) is omitted
|
||||
-- A(d_hat) is ahat * numAttacks p, because ahat is only deterrence of the population
|
||||
-- and does not incorporate the number of attacks, which A(d_hat) in the paper does.
|
||||
deterPredators :: [(Predator, Double)] -> Vector Amount -> World Probability
|
||||
deterPredators appearingPredators compounds = do
|
||||
dieToPredators :: [(Predator, Double)] -> Vector Amount -> World Probability
|
||||
dieToPredators [] _ = return 0 -- if no predator, no dying.
|
||||
dieToPredators appearingPredators compounds = do
|
||||
deters <- forM appearingPredators $ \(p,ahat) -> do
|
||||
myDeter <- deterPredator p compounds
|
||||
return $ exp $ negate $ numAttacks p * ahat * myDeter -- exp due to assumption that number of attacks are poisson-distributed.
|
||||
myDeter <- dieToPredator p compounds
|
||||
return $ ahat * myDeter -- exp due to assumption that number of attacks are poisson-distributed.
|
||||
return $ product deters
|
||||
|
||||
|
||||
deterPredator :: Predator -> Vector Amount -> World Double
|
||||
deterPredator p comps = do
|
||||
dieToPredator :: Predator -> Vector Amount -> World Double
|
||||
dieToPredator p comps = do
|
||||
toxins <- asks toxicCompounds
|
||||
return $ product [1 - min 1 (comps ! fromEnum t * l) | (t,l) <- toxins, t `elem` irresistance p]
|
||||
|
||||
@ -227,12 +227,17 @@ deterPredator p comps = do
|
||||
-- | mate haploid
|
||||
haploMate :: Plant -> World Plant
|
||||
haploMate (Plant genes abs) = do
|
||||
let digen :: IO [(Double, Int)]
|
||||
digen = do
|
||||
ds <- randoms <$> newStdGen
|
||||
is <- randoms <$> newStdGen
|
||||
return $ zip ds is
|
||||
--generate some random infinite uniform distributed lists of doubles in [0,1)
|
||||
r1 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
|
||||
r1 <- liftIO digen
|
||||
r2 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
|
||||
r3 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
|
||||
r4 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
|
||||
r5 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
|
||||
r4 <- liftIO digen
|
||||
r5 <- liftIO digen
|
||||
enzymes <- asks possibleEnzymes
|
||||
re1 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
|
||||
re2 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
|
||||
@ -243,29 +248,36 @@ haploMate (Plant genes abs) = do
|
||||
. duplicateGene r4
|
||||
. deleteGene r5
|
||||
$ genes
|
||||
deleteGene :: [Double] -> Genome -> Genome
|
||||
deleteGene (r:rs) ((e,1,a):gs) = if r < 0.1 then deleteGene rs gs else (e,1,a):deleteGene rs gs
|
||||
deleteGene (r:rs) ((e,q,a):gs) = if r < 0.1 then (e,q-1,a):deleteGene rs gs else (e,q,a):deleteGene rs gs
|
||||
deleteGene :: [(Double,Int)] -> Genome -> Genome
|
||||
deleteGene _ [] = []
|
||||
deleteGene ((r,i):rs) g = if r < 0.05 then deleteGene rs (stay ++ go' ++ stay') else g
|
||||
where
|
||||
(stay, go:stay') = splitAt (i `mod` length g - 2) g
|
||||
go' = case go of
|
||||
(e,1,a) -> []
|
||||
(e,q,a) -> [(e,q-1,a)]
|
||||
|
||||
duplicateGene :: [Double] -> Genome -> Genome
|
||||
duplicateGene (r:rs) ((e,q,a):gs) = if r < 0.1 then (e,1,a):(e,q,a):duplicateGene rs gs else (e,q,a):duplicateGene rs gs
|
||||
duplicateGene :: [(Double,Int)] -> Genome -> Genome
|
||||
duplicateGene _ [] = []
|
||||
duplicateGene ((r,i):rs) g = if r < 0.05 then duplicateGene rs (stay ++ (e,q+1,a):stay') else g
|
||||
where
|
||||
(stay, (e,q,a):stay') = splitAt (i `mod` length g - 2) g
|
||||
|
||||
addGene :: [Double] -> [Int] -> Genome -> Genome
|
||||
addGene (r:rs) (s:ss) g = if r < 0.05 then (enzymes !! s,1,1):g else g
|
||||
addGene (r:rs) (s:ss) g = if r < 0.005 then (enzymes !! s,1,1):g else g
|
||||
|
||||
noiseActivation :: [Double] -> Genome -> Genome
|
||||
noiseActivation (r:rs) ((e,q,a):gs) = (e,q,max 0 $ min 1 $ a-0.01+0.02*r):noiseActivation rs gs
|
||||
noiseActivation _ [] = []
|
||||
|
||||
mutateGene :: [Double] -> [Int] -> Genome -> Genome
|
||||
mutateGene (r:rs) (s:ss) ((e,1,a):gs) = if r < 0.01 then ((enzymes !! s),1,a):mutateGene rs ss gs
|
||||
else (e,1,a):mutateGene rs ss gs
|
||||
|
||||
mutateGene (r:rs) (s:ss) ((e,q,a):gs) = if r < 0.01 then (e,q-1,a):((enzymes !! s),1,a):mutateGene rs ss gs
|
||||
else (e,q,a):mutateGene rs ss gs
|
||||
mutateGene (r:rs) (s:ss) [] = []
|
||||
mutateGene :: [(Double,Int)] -> [Int] -> Genome -> Genome
|
||||
mutateGene _ _ [] = []
|
||||
mutateGene ((r,i):rs) (s:ss) g = if r < 0.25 then mutateGene rs ss (stay ++ go' ++ stay') else g
|
||||
where
|
||||
(stay, go:stay') = splitAt (i `mod` length g - 2) g
|
||||
go' = case go of
|
||||
(e,1,a) -> [(enzymes !! s,1,a)]
|
||||
(e,q,a) -> [(e,q-1,a),(enzymes !! s,1,a)]
|
||||
return $ Plant genes' abs
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user