From 723df072c11631293bf98f44bacdf3fc8122baca Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sat, 5 May 2018 00:23:40 +0200 Subject: [PATCH] added EnzymeTree-Generator via QuickCheck --- app/Main.hs | 32 ++++++++++++++-------------- package.yaml | 2 ++ sketch.md.lhs | 33 ++++++++++++++--------------- src/Arbitrary.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 87 insertions(+), 34 deletions(-) create mode 100644 src/Arbitrary.hs diff --git a/app/Main.hs b/app/Main.hs index f9f13ce..f89563e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -19,7 +19,7 @@ import System.IO -- Enzymes pps :: Enzyme -- uses Phosphor from Substrate to produce PP -pps = Enzyme "PPS" [(Substrate Phosphor,1)] ((Substrate Phosphor,(-1)),(Produced PP,1)) Nothing +pps = Enzyme "PPS" [(Substrate Phosphor,1)] ((Substrate Phosphor,-1),(Produced PP,1)) Nothing fpps :: Enzyme -- PP -> FPP fpps = makeSimpleEnzyme (Produced PP) (Produced FPP) @@ -40,7 +40,7 @@ exampleEnvironment = ] , predators = [ (greenfly, 0.1) ] , metabolismIteration = 100 - , maxCompound = maxCompoundWithoutGeneric + 100 + , maxCompound = maxCompoundWithoutGeneric , toxicCompounds = [(Produced FPP,0.5)] --FPP kills 100% if produced amount above 0.2 units , possibleEnzymes = [pps,fpps] } @@ -61,10 +61,10 @@ examplePlants = (\g -> Plant g defaultAbsorption) <$> genomes a <- activation return $ (,,) <$> e' <*> [q] <*> [a] - defaultAbsorption = soil <$> ask >>= return . fmap ( limit Phosphor 2 - . limit Nitrate 1 - . limit Sulfur 0 - ) + defaultAbsorption = fmap ( limit Phosphor 2 + . limit Nitrate 1 + . limit Sulfur 0 + ) <$> asks soil -- custom absorbtion with helper-function: limit :: Nutrient -> Amount -> (Nutrient, Amount) -> (Nutrient, Amount) limit n a (n', a') @@ -75,23 +75,23 @@ examplePlants = (\g -> Plant g defaultAbsorption) <$> genomes -- ---------------------- loop :: Int -> [Plant] -> Environment -> IO () -loop loopAmount plants e = loop' loopAmount 0 plants e +loop loopAmount = loop' loopAmount 0 where loop' :: Int -> Int -> [Plant] -> Environment -> IO () loop' loopAmount curLoop plants e = unless (loopAmount == curLoop) $ do - putStr $ "\ESC[2J\ESC[H" + putStr "\ESC[2J\ESC[H" printEnvironment e putStrLn "" putStrLn $ "Generation " ++ show curLoop ++ " of " ++ show loopAmount ++ ":" - newPlants <- (flip runReaderT) e $ do + newPlants <- flip runReaderT e $ do fs <- sequence $ fitness <$> plants let fps = zip plants fs -- gives us plants & their fitness in a tuple sumFitness = sum fs - pe <- possibleEnzymes <$> ask + pe <- asks possibleEnzymes liftIO $ printPopulation pe fps -- generate 100 new plants. - sequence . (flip fmap) [1..100] $ \_ -> do + sequence . flip fmap [1..100] $ \_ -> do parent' <- liftIO $ randomRIO (0,sumFitness) let -- if we only have one parent in our list, take it. @@ -141,12 +141,12 @@ printPopulation :: [Enzyme] -> [(Plant,Double)] -> IO () printPopulation es ps = do let padded i str = take i $ str ++ repeat ' ' putStr $ padded 40 "Population:" - forM_ ps $ \((_,f)) -> putStr (printColor f '█') + forM_ ps $ \(_,f) -> putStr (printColor f '█') putStrLn colorOff forM_ es $ \e -> do putStr $ padded 40 (show (enzymeName e)) - forM_ ps $ \((Plant g _,_)) -> do - let curE = sum $ map (\(_,q,a) -> (fromIntegral q)*a) + forM_ ps $ \(Plant g _,_) -> do + let curE = sum $ map (\(_,q,a) -> fromIntegral q*a) . filter (\(e',_,_) -> e == e') $ g plot x @@ -161,8 +161,8 @@ printPopulation es ps = do printColor :: Double -> Char -> String printColor x c - | x*x < 0.5 = "\ESC[38;5;" ++ (show $ 16 + 36*5 + 6*(floor $ 5*2*x') + 0) ++ "m" ++ [c] ++ "" - | otherwise = "\ESC[38;5;" ++ (show $ 16 + 36*(floor $ 5*2*(1-x')) + 6*5 + 0) ++ "m" ++ [c] ++ "" + | x*x < 0.5 = "\ESC[38;5;" ++ show (16 + 36*5 + 6*floor (5*2*x') + 0) ++ "m" ++ [c] ++ "" + | otherwise = "\ESC[38;5;" ++ show (16 + 36*floor (5*2*(1-x')) + 6*5 + 0) ++ "m" ++ [c] ++ "" -- 32 bit -- | x*x < 0.5 = "\ESC[38;2;255;" ++ (show . floor $ 255*2*x') ++ ";0m" ++ [c] ++ "" -- | otherwise = "\ESC[38;2;" ++ (show . floor $ 255*2*(1-x')) ++ ";255;0m" ++ [c] ++ "" diff --git a/package.yaml b/package.yaml index 8f1171a..c740b7b 100644 --- a/package.yaml +++ b/package.yaml @@ -24,6 +24,8 @@ dependencies: - hmatrix - mtl - random +- QuickCheck +- pretty-simple library: source-dirs: src diff --git a/sketch.md.lhs b/sketch.md.lhs index 45b3bb8..99c80f3 100644 --- a/sketch.md.lhs +++ b/sketch.md.lhs @@ -154,9 +154,10 @@ plant. > | Photosynthesis > deriving (Show, Enum, Bounded, Eq) > -> data Component = PP +> data Component = GenericComponent Int +> | PP > | FPP -> deriving (Show, Enum, Bounded, Eq) +> deriving (Show, Eq) Compounds are either direct nutrients or already processed components @@ -173,15 +174,14 @@ Enzymes Enzymes are the main reaction-driver behind synthesis of intricate compounds. +> data Synthesis = Synthesis [(Compound, Amount)] (Compound,Amount) > data Enzyme = Enzyme > { enzymeName :: String > -- ^ Name of the Enzyme. Enzymes with the same name are supposed > -- to be identical. > , substrateRequirements :: [(Nutrient,Amount)] > -- ^ needed for reaction to take place -> , substrateIntolerance :: [(Nutrient,Amount)] -> -- ^ inhibits reaction if given nutrients are above the given concentration -> , synthesis :: [(Compound,Amount)] -> [(Compound,Amount)] +> , synthesis :: [Synthesis] > -- ^ given x in amount a, this will produce y in amount b > , dominance :: Maybe Amount > -- ^ in case of competition for nutrients this denotes the priority @@ -199,18 +199,14 @@ Enzymes are the main reaction-driver behind synthesis of intricate compounds. Example "enzymes" could be: > pps :: Enzyme -- uses Phosphor from Substrate to produce PP -> pps = Enzyme "PPS" [(Phosphor,1)] [] syn Nothing +> pps = Enzyme "PPS" [(Phosphor,1)] syn Nothing > where -> syn compAvailable = [(Substrate Phosphor,i*(-1)),(Produced PP,i)] -> where -> i = getAmountOf (Substrate Phosphor) compAvailable +> syn = [Synthesis [(Substrate Phosphor, 1)] (PP, 1)] > -> fpps :: Enzyme -- PP -> FPP -> fpps = Enzyme "FPPS" [] [] syn Nothing +> fpps :: Enzyme +> fpps = Enzyme "FPPS" [] syn Nothing > where -> syn compAvailable = [(Produced PP,i*(-1)),(Produced FPP,i*0.5)] -> where -> i = getAmountOf (Produced PP) compAvailable +> syn = [Synthesis [(PP, 1)] (FPP, 1)] --- @@ -272,7 +268,7 @@ internal state how many nutrients and compounds are currently inside the plant. > data Plant = Plant > { genome :: Genome > -- ^ the genetic characteristic of the plant -> , absorbNutrients :: Environment -> [(Nutrient,Amount)] +> , absorbNutrients :: Environment -> [(Component,Amount)] > -- ^ the capability to absorb nutrients given an environment > } > instance Show Plant where @@ -303,7 +299,8 @@ The following example yields in the example-environment this population: > a <- activation > return $ (,,) <$> e' <*> [q] <*> [a] > -> defaultAbsorption (Environment s _) = limit Phosphor 2 +> defaultAbsorption (Environment s _) = (\(a,b) -> (Substrate a,b)) +> . limit Phosphor 2 > . limit Nitrate 1 > . limit Sulfur 0 > <$> s @@ -334,10 +331,10 @@ an environment. --- -> produceCompounds :: Plant -> [(Nutrient, Amount)] -> [Compound] +> produceCompounds :: Plant -> [(Compound, Amount)] -> [Compound] > produceCompounds (Plant genes _) = undefined > -- this will take some constrained linear algebra-solving - +> > deterPredators :: [(Predator, Probability)] -> [Compound] -> Probability > deterPredators ps cs = sum $ do > c <- cs -- for every compound diff --git a/src/Arbitrary.hs b/src/Arbitrary.hs new file mode 100644 index 0000000..d133dfb --- /dev/null +++ b/src/Arbitrary.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DeriveGeneric #-} +module Arbitrary where + +import Test.QuickCheck +import GHC.Generics (Generic(..)) +import Text.Pretty.Simple +import Data.List + +data TreeShape = Root + { treeSize :: Int + , treeSubSizes :: [TreeShape] + } deriving (Show, Eq) + +data EnzymeTree s a = EnzymeTree TreeShape a [EnzymeTree TreeShape a] deriving (Show, Eq, Generic, Functor, Foldable, Traversable) + +instance Applicative (EnzymeTree s) where + pure a = EnzymeTree (Root 1 []) a [] + EnzymeTree s f fs <*> EnzymeTree _ a as = EnzymeTree s (f a) (zipWith (<*>) fs as) + +instance Arbitrary a => Arbitrary (EnzymeTree s a) where + arbitrary = sized arbitrarySizedEnzymeTree + +arbitrarySizedEnzymeTree :: Arbitrary a => Int -> Gen (EnzymeTree s a) +arbitrarySizedEnzymeTree m = do + t <- arbitrary + n <- choose (m `div` 4, m) + ts <- if n == 0 then return [] + else sequenceA $ replicate (2*n) (arbitrarySizedEnzymeTree (n `div` 2)) + let (_,ts') = foldr (go m) (0,[]) ts + go :: Int -> EnzymeTree s a -> (Int, [EnzymeTree s a]) -> (Int, [EnzymeTree s a]) + go m x (s,ts) + | m == 0 = (s,ts) + | s + getTreeSize x > m = (s,ts) + | otherwise = (s + getTreeSize x, x:ts) + + sz = sum $ getTreeSize <$> ts' + ss = (\(EnzymeTree a _ _) -> a) <$> ts' + return (EnzymeTree (Root (sz+1) ss) t ts') + +getTreeSize :: EnzymeTree s a -> Int +getTreeSize (EnzymeTree (Root a _) _ _) = a + +getShape :: EnzymeTree s a -> TreeShape +getShape (EnzymeTree s _ _) = s + +treeFromList :: TreeShape -> [a] -> EnzymeTree s a +treeFromList (Root n ns) (a:as) = EnzymeTree (Root n ns) a (unfoldr go (ns,as)) + where + go :: ([TreeShape],[a]) -> Maybe (EnzymeTree s a,([TreeShape],[a])) + go (n:ns,as) = Just (treeFromList n (take (treeSize n) as), (ns, drop (treeSize n) as)) + go ([],_) = Nothing