From 62db90d3d94ba08fc1862fabd4724a9e01e3438c Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Thu, 14 Jun 2018 12:25:31 +0200 Subject: [PATCH] compiles, but metrics need to be checked. --- app/Main.hs | 28 ++++++++++++++-------------- src/Evaluation.hs | 9 +++++---- 2 files changed, 19 insertions(+), 18 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index b6fbc3e..dd02bac 100644 --- a/app/Main.hs +++ b/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) diff --git a/src/Evaluation.hs b/src/Evaluation.hs index 8bf0d42..3da7a6a 100644 --- a/src/Evaluation.hs +++ b/src/Evaluation.hs @@ -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,8 +53,9 @@ 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]] - pfold (a,b) (a',b') = (a+a', b+b') + 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. --