compiles, but metrics need to be checked.
This commit is contained in:
parent
022b26e7a6
commit
62db90d3d9
28
app/Main.hs
28
app/Main.hs
@ -102,23 +102,23 @@ loop loopAmount ps env = loop' loopAmount 0 ps env
|
||||
putStrLn $ "Generation " ++ show curLoop ++ " of " ++ show loopAmount ++ ":"
|
||||
newPlants <- simulate s $ do
|
||||
(!fs,cs) <- unzip <$> fitness plants
|
||||
txns <- fmap (fromEnum . fst) <$> fromEnv toxicCompounds -- [Int] of id's of toxic compounds
|
||||
let fps = zip plants fs -- gives us plants & their fitness in a tuple
|
||||
sumFitness = sum fs
|
||||
-- $C_{\Sigma,mu}$: Durchschnittliche Menge an produzierten Stoffen
|
||||
-- $C_{\Sigma,sigma}$: Durchschnittliche Varianz an produzierten Stoffen
|
||||
(c_Sigma_mu, c_Sigma_sigma) = meanAndVar `from` sumProducedCompounds $ cs
|
||||
(c_sum_mu, c_sum_sigma) = meanAndVar `from` sumProducedCompounds $ cs
|
||||
-- - $C_{i,\mu}$: Durchschnittliche Anzahl produzierter Komponenten
|
||||
-- - $C_{i,\sigma}$: Zusätzlich: Betrachtung der Varianz dieser Komponenten innerhalb der Population
|
||||
-- (Z.B. Stoff A wird immer mit $0.5$ produziert, hat also keine Varianz,
|
||||
-- wogegen Stoff B *im Schnitt* mit $0.5$ produziert wird, aber dies eine extreme
|
||||
-- Varianz auslöst)
|
||||
-- c_mu_sigma :: [(Amount,Amount)]
|
||||
(c_i_mu,c_i_sigma) = unzip $ meanAndVar `from` id <$> byProducts cs
|
||||
-- - $C_d$: Durchschnittliche Anzahl distinkter Produzierter Stoffe (sprich
|
||||
-- nicht-endemisch, $#i | C_{i,\sigma} > \epsilon$ )
|
||||
isEndemic :: Vector Bool
|
||||
isEndemic = (> 0.01) <$> fromList c_i_sigma
|
||||
(c_d_mu, c_d_sigma) = meanAndVar `from` (countWith isEndemic) $ cs
|
||||
isEndemic = fromList $ (> 0.01) <$> c_i_sigma
|
||||
(c_d_mu, c_d_sigma) = meanAndVar `from` countWith isEndemic $ cs
|
||||
-- - $C_{\sigma,\{\mu/\sigma\}}$: Mittelwert/Varianz von $\C_{i,\sigma}$
|
||||
(c_sigma_mu, c_sigma_sigma) = meanAndVar `from` id $ c_i_sigma
|
||||
-- - $\mathbf{E}[C_{\Sigma,plant} - C_{\Sigma,mu}]$: Durchschnittliche Abweichung der produzierten
|
||||
@ -127,21 +127,20 @@ loop loopAmount ps env = loop' loopAmount 0 ps env
|
||||
-- mean and variance of fitness
|
||||
fns = meanAndVar `from` id $ fs
|
||||
-- - $P_\{\mu,\sigma\}$ Mittelwert/Varianz der Anteile der Stoffe in Pflanze i, die giftig sind
|
||||
toxs = meanAndVar `from` percentagePoisonous $ cs
|
||||
toxs = meanAndVar `from` percentagePoisonous txns $ cs
|
||||
when (curLoop `mod` printEvery == 0) $ liftIO $ do
|
||||
printPopulation stringe (zip3 plants fs cs)
|
||||
printPopulation (zip ((>0.01) <$> c_i_sigma) stringe) (zip3 plants fs cs)
|
||||
putStrLn $ "Population statistics (mean,variance):"
|
||||
putStrLn $ "Amount of Components produced = " ++ (padded 50 . show $ spc)
|
||||
putStrLn $ "Number of distinct Components = " ++ (padded 50 . show $ ndc)
|
||||
putStrLn $ "Amount of Components produced = " ++ (padded 50 . show $ (c_sum_mu,c_sum_sigma))
|
||||
putStrLn $ "Number of distinct Components = " ++ (padded 50 . show $ (c_d_mu, c_d_sigma))
|
||||
putStrLn $ "Fitness = " ++ (padded 50 . show $ fns)
|
||||
putStrLn $ show cstats
|
||||
putStrLn $ show cstats'
|
||||
hFlush stdout
|
||||
threadDelay $ 10*1000 -- sleep x*1000ns (=x ~ ms)
|
||||
tell $ show curLoop
|
||||
++ "," ++ show (fst spc) ++ "," ++ show (snd spc)
|
||||
++ "," ++ show (fst ndc) ++ "," ++ show (snd ndc)
|
||||
++ "," ++ show c_sum_mu ++ "," ++ show c_sum_sigma
|
||||
++ "," ++ show c_d_mu ++ "," ++ show c_d_sigma
|
||||
++ "," ++ show (fst fns) ++ "," ++ show (snd fns)
|
||||
++ "," ++ show (fst toxs) ++ "," ++ show (snd toxs)
|
||||
-- generate x new plants.
|
||||
np <- fromEnv (numPlants . settings)
|
||||
sequence . flip fmap [1..np] $ \_ -> do
|
||||
@ -222,7 +221,7 @@ printEnvironment (Environment soil pred metaIter maxComp toxic possEnz settings)
|
||||
putStrLn $ "Toxic: " ++ show toxic
|
||||
putStrLn $ "Settings: " ++ show settings
|
||||
|
||||
printPopulation :: [(Enzyme,String)] -> [(Plant,Double,Vector Amount)] -> IO ()
|
||||
printPopulation :: [(Bool,(Enzyme,String))] -> [(Plant,Double,Vector Amount)] -> IO ()
|
||||
printPopulation es ps = do
|
||||
let padded i str = take i $ str ++ repeat ' '
|
||||
n = length ps
|
||||
@ -232,7 +231,8 @@ printPopulation es ps = do
|
||||
putStr $ padded 50 ("Population: (fitness: mean " ++ padded 5 (show meanFitness) ++ ", max: " ++ padded 5 (show maxFitness) ++ ")")
|
||||
forM_ ps $ \(_,f,_) -> putStr (printColor (f/maxFitness) '█')
|
||||
putStrLn colorOff
|
||||
forM_ es $ \(e,s) -> do
|
||||
forM_ es $ \(b,(e,s)) -> do
|
||||
if b then putStr ">" else putStr " "
|
||||
putStr s
|
||||
forM_ ps $ \(Plant g _,_,cs) -> do
|
||||
let curE = sum $ map (\(_,q,a) -> fromIntegral q*a)
|
||||
|
@ -38,13 +38,13 @@ numDistinctCompounds :: Functor f => f (LA.Vector Amount) -> f Amount
|
||||
--numDistinctCompounds :: [LA.Vector Amount] -> [Amount]
|
||||
numDistinctCompounds comps = sumElements . LA.cmap (\x -> if abs x < eps then 0 else 1) <$> comps
|
||||
|
||||
countWith :: Functor f => (LA.Vector Bool) -> f (LA.Vector Amount) -> f Amount
|
||||
countWith :: Functor f => LA.Vector Bool -> f (LA.Vector Amount) -> f Amount
|
||||
countWith toSelect = fmap $ sumElements . LA.zipVectorWith (\selected _ -> if selected then 1 else 0) toSelect
|
||||
-- apply selection to set data to 1 or 0
|
||||
-- sum up 1 or 0s
|
||||
-- for all data
|
||||
|
||||
sumWith :: Functor f => (LA.Vector Bool) -> f (LA.Vector Amount) -> f Amount
|
||||
sumWith :: Functor f => LA.Vector Bool -> f (LA.Vector Amount) -> f Amount
|
||||
sumWith toSelect = fmap $ sumElements . LA.zipVectorWith (\selected d -> if selected then d else 0) toSelect
|
||||
-- apply selection to set data to 1 or 0
|
||||
-- sum up data or 0s
|
||||
@ -53,7 +53,8 @@ sumWith toSelect = fmap $ sumElements . LA.zipVectorWith (\selected d -> if sele
|
||||
percentagePoisonous :: Functor f => [Int] -> f (LA.Vector Amount) -> f Amount
|
||||
percentagePoisonous poisons = fmap percentage
|
||||
where
|
||||
percentage v = (\(tox,total) -> tox / total) $ foldl1' pfold [(if i `L.elem` poisons then v!i else 0, v!i) | i <- [1..LA.size v]]
|
||||
percentage v = uncurry (/) $ foldl1' pfold [(if i `L.elem` poisons then v!i else 0, v!i) | i <- [0..LA.size v-1]]
|
||||
-- uncurry (/) == (\(tox,total) -> tox / total), but exposes more laziness
|
||||
pfold (a,b) (a',b') = (a+a', b+b')
|
||||
|
||||
-- | helper function for Foldl-Package.
|
||||
|
Loading…
Reference in New Issue
Block a user