added EnzymeTree-Generator via QuickCheck

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
+   defaultAbsorption = fmap ( limit Phosphor 2
-                                                      . limit Nitrate 1
+                            . limit Nitrate 1
-                                                      . limit Sulfur 0
+                            . 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
+    forM_ ps $ \(Plant g _,_) -> do
-      let curE = sum $ map (\(_,q,a) -> (fromIntegral q)*a) 
+      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] ++ ""
+  | 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] ++ ""
+  | 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] ++ ""

package.yaml

@@ -24,6 +24,8 @@ dependencies:
 - hmatrix
 - mtl
 - random
+- QuickCheck
+- pretty-simple
 
 library:
   source-dirs: src

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)]
+>        , synthesis             :: [Synthesis]
->          -- ^ inhibits reaction if given nutrients are above the given concentration
->        , synthesis             :: [(Compound,Amount)] -> [(Compound,Amount)]
 >          -- ^ 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)]
+>    syn = [Synthesis [(Substrate Phosphor, 1)] (PP, 1)]
->      where
->        i = getAmountOf (Substrate Phosphor) compAvailable
 >
-> fpps :: Enzyme -- PP -> FPP
+> fpps :: Enzyme
-> fpps = Enzyme "FPPS" [] [] syn Nothing
+> fpps = Enzyme "FPPS" [] syn Nothing
 >  where
->    syn compAvailable = [(Produced PP,i*(-1)),(Produced FPP,i*0.5)]
+>    syn = [Synthesis [(PP, 1)] (FPP, 1)]
->      where
->        i = getAmountOf (Produced PP) compAvailable
 
 
 ---
@@ -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

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