From 022b26e7a609019cdea7488f85d49beabc8fbd73 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Thu, 14 Jun 2018 11:56:28 +0200 Subject: [PATCH] broken state --- app/Main.hs | 27 +++++++++++++++++++++++---- src/Evaluation.hs | 25 ++++++++++++++++++++++++- 2 files changed, 47 insertions(+), 5 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index e342b4b..b6fbc3e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -104,11 +104,30 @@ loop loopAmount ps env = loop' loopAmount 0 ps env (!fs,cs) <- unzip <$> fitness plants let fps = zip plants fs -- gives us plants & their fitness in a tuple sumFitness = sum fs - spc = meanAndVar `from` sumProducedCompounds $ cs - ndc = meanAndVar `from` numDistinctCompounds $ cs + -- $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_{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 + -- - $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 + -- Stoffe gegenüber dem Schnitt der Gesamtpopulation + e_hash_plant = F.mean `from` numDistinctCompounds $ cs + -- mean and variance of fitness fns = meanAndVar `from` id $ fs - cstats = meanAndVar `from` id <$> byProducts cs - cstats' = meanAndVar `from` id $ snd <$> cstats + -- - $P_\{\mu,\sigma\}$ Mittelwert/Varianz der Anteile der Stoffe in Pflanze i, die giftig sind + toxs = meanAndVar `from` percentagePoisonous $ cs when (curLoop `mod` printEvery == 0) $ liftIO $ do printPopulation stringe (zip3 plants fs cs) putStrLn $ "Population statistics (mean,variance):" diff --git a/src/Evaluation.hs b/src/Evaluation.hs index 295e60d..8bf0d42 100644 --- a/src/Evaluation.hs +++ b/src/Evaluation.hs @@ -1,16 +1,21 @@ +{-# LANGUAGE GADTs #-} module Evaluation ( sumProducedCompounds , numDistinctCompounds + , percentagePoisonous , sumCompounds , from , meanAndVar + , sumWith + , countWith , byCompound , byProducts ) where import Control.Foldl as F import Numeric.LinearAlgebra as LA -import Data.List +import Numeric.LinearAlgebra.Devel as LA +import Data.List as L import Environment @@ -33,6 +38,24 @@ 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 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 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 +-- for all data + +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') + -- | helper function for Foldl-Package. -- -- Usage: @F.mean `from` sumCompounds $ v@ where v is a Set/List/Vector/... of Vector of Compounds.