creatur 5.3.1 → 5.3.2

raw patch · 6 files changed

+92/−94 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• creatur.cabal +3/−3
• src/ALife/Creatur/AgentNamer.hs +0/−52
• src/ALife/Creatur/Database/CachedFileSystemInternal.hs +10/−9
• src/ALife/Creatur/Namer.hs +51/−0
• src/ALife/Creatur/Universe.hs +23/−28
• test/ALife/Creatur/UtilQC.hs +5/−2

@@ -1,5 +1,5 @@ Name:              creatur-Version:           5.3.1+Version:           5.3.2 Stability:         experimental Synopsis:          Framework for artificial life experiments. Description:       A software framework for automating experiments@@ -36,13 +36,12 @@ source-repository this   type:     git   location: https://github.com/mhwombat/creatur.git-  tag:      5.3.1+  tag:      5.3.2  library   GHC-Options:      -Wall -fno-warn-orphans   Hs-source-dirs:   src   exposed-modules:  ALife.Creatur,-                    ALife.Creatur.AgentNamer,                     ALife.Creatur.Checklist,                     ALife.Creatur.Clock,                     ALife.Creatur.Counter,@@ -60,6 +59,7 @@                     ALife.Creatur.Genetics.Reproduction.Sexual,                     ALife.Creatur.Genetics.Reproduction.SimplifiedSexual,                     ALife.Creatur.Logger,+                    ALife.Creatur.Namer,                     ALife.Creatur.Universe,                     ALife.Creatur.Task,                     ALife.Creatur.Util

@@ -1,52 +0,0 @@---------------------------------------------------------------------------- |--- Module      :  ALife.Creatur.AgentNamer--- Copyright   :  (c) Amy de Buitléir 2012-2013--- License     :  BSD-style--- Maintainer  :  amy@nualeargais.ie--- Stability   :  experimental--- Portability :  portable------ Assigns a unique ID upon request. IDs generated by an @AgentNamer@ --- are guaranteed to be unique within a given universe, across all --- simulation runs.-----------------------------------------------------------------------------module ALife.Creatur.AgentNamer-  (-    AgentNamer(..),-    SimpleAgentNamer,-    mkSimpleAgentNamer-  ) where--import ALife.Creatur (AgentId)-import ALife.Creatur.Counter (PersistentCounter, current, increment,-  mkPersistentCounter)-import ALife.Creatur.Util (stateMap)-import Control.Monad.State (StateT, get, gets)--class AgentNamer n where-  -- | Assign a unique ID using the supplied prefix.-  genName :: StateT n IO AgentId--data SimpleAgentNamer = SimpleAgentNamer -  {-    prefix :: String,-    counter :: PersistentCounter-  } deriving (Show, Eq)--mkSimpleAgentNamer :: String -> FilePath -> SimpleAgentNamer-mkSimpleAgentNamer s f = SimpleAgentNamer s $ mkPersistentCounter f--withCounter :: StateT PersistentCounter IO x -> StateT SimpleAgentNamer IO x-withCounter runProgram = do-  u <- get-  stateMap (\c -> u {counter=c}) counter runProgram--instance AgentNamer SimpleAgentNamer where-  genName = do-    p <- gets prefix-    k <- withCounter (increment >> current)-    return $ p ++ show k--

@@ -12,14 +12,14 @@ -- This module is subject to change without notice. -- -------------------------------------------------------------------------{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, ScopedTypeVariables #-} module ALife.Creatur.Database.CachedFileSystemInternal where  import Prelude hiding (readFile, writeFile, lookup)  import ALife.Creatur.Database (Database(..), DBRecord, Record,   SizedRecord, delete, key, keys, store, size)-import ALife.Creatur.Database.FileSystem (FSDatabase, mkFSDatabase)+import qualified ALife.Creatur.Database.FileSystem as FS import ALife.Creatur.Util (stateMap) import Control.Monad (when) import Control.Monad.State (StateT, get, gets, modify)@@ -28,7 +28,7 @@ --   and the name of the file is the record's key. data CachedFSDatabase r = CachedFSDatabase   {-    database :: FSDatabase r,+    database :: FS.FSDatabase r,     cache :: [r],     maxCacheSize :: Int   } deriving (Show, Eq)@@ -59,7 +59,7 @@    store r = do     addToCache r-    withFSDB (store r)+    withFSDB (store r :: StateT (FS.FSDatabase r) IO ())    delete k = do     deleteByKeyFromCache k@@ -67,7 +67,7 @@  withFSDB    :: Monad m-    => StateT (FSDatabase r) m a -> StateT (CachedFSDatabase r) m a+    => StateT (FS.FSDatabase r) m a -> StateT (CachedFSDatabase r) m a withFSDB f = do   d <- get   stateMap (\x -> d{database=x}) database f@@ -95,8 +95,8 @@ deleteFromCache   :: SizedRecord r     => r -> StateT (CachedFSDatabase r) IO ()-deleteFromCache r-  = modify (\d -> d {cache=filter (\x -> key x /= key r) (cache d)})+deleteFromCache r =+  modify (\d -> d {cache=filter (\x -> key x /= key r) (cache d)})  trimCache :: SizedRecord r => StateT (CachedFSDatabase r) IO () trimCache = do@@ -111,9 +111,10 @@               else xs  listSize :: SizedRecord r => [r] -> Int-listSize xs = if null xs then 0 else sum $ map size xs+listSize [] = 0+listSize xs = sum $ map size xs  -- | @'mkFSDatabase' d@ (re)creates the FSDatabase in the --   directory @d@. mkCachedFSDatabase :: FilePath -> Int -> CachedFSDatabase r-mkCachedFSDatabase d s = CachedFSDatabase (mkFSDatabase d) [] s+mkCachedFSDatabase d s = CachedFSDatabase (FS.mkFSDatabase d) [] s

@@ -0,0 +1,51 @@+------------------------------------------------------------------------+-- |+-- Module      :  ALife.Creatur.Namer+-- Copyright   :  (c) Amy de Buitléir 2012-2013+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- Assigns a unique ID upon request. IDs generated by an @Namer@ +-- are guaranteed to be unique within a given universe, across all +-- simulation runs.+--+------------------------------------------------------------------------+module ALife.Creatur.Namer+  (+    Namer(..),+    SimpleNamer,+    mkSimpleNamer+  ) where++import ALife.Creatur.Counter (PersistentCounter, current, increment,+  mkPersistentCounter)+import ALife.Creatur.Util (stateMap)+import Control.Monad.State (StateT, get, gets)++class Namer n where+  -- | Assign a unique ID using the supplied prefix.+  genName :: StateT n IO String++data SimpleNamer = SimpleNamer +  {+    prefix :: String,+    counter :: PersistentCounter+  } deriving (Show, Eq)++mkSimpleNamer :: String -> FilePath -> SimpleNamer+mkSimpleNamer s f = SimpleNamer s $ mkPersistentCounter f++withCounter :: StateT PersistentCounter IO x -> StateT SimpleNamer IO x+withCounter runProgram = do+  u <- get+  stateMap (\c -> u {counter=c}) counter runProgram++instance Namer SimpleNamer where+  genName = do+    p <- gets prefix+    k <- withCounter (increment >> current)+    return $ p ++ show k++

@@ -10,7 +10,7 @@ -- Provides a habitat for artificial life. -- -------------------------------------------------------------------------{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, ScopedTypeVariables #-} module ALife.Creatur.Universe   (     -- * Constructors@@ -51,7 +51,7 @@ import Prelude hiding (lookup)  import qualified ALife.Creatur as A-import qualified ALife.Creatur.AgentNamer as N+import qualified ALife.Creatur.Namer as N import qualified ALife.Creatur.Checklist as CL import qualified ALife.Creatur.Clock as C import qualified ALife.Creatur.Counter as K@@ -68,7 +68,7 @@  -- | A habitat containing artificial life. class (C.Clock (Clock u), L.Logger (Logger u), D.Database (AgentDB u),-  N.AgentNamer (AgentNamer u), CL.Checklist (Checklist u),+  N.Namer (Namer u), CL.Checklist (Checklist u),   A.Agent (Agent u), D.Record (Agent u),   Agent u ~ D.DBRecord (AgentDB u))       => Universe u where@@ -82,9 +82,9 @@   type AgentDB u   agentDB :: u -> AgentDB u   setAgentDB :: u -> AgentDB u -> u-  type AgentNamer u-  agentNamer :: u -> AgentNamer u-  setAgentNamer :: u -> AgentNamer u -> u+  type Namer u+  agentNamer :: u -> Namer u+  setNamer :: u -> Namer u -> u   type Checklist u   checklist :: u -> Checklist u   setChecklist :: u -> Checklist u -> u@@ -108,12 +108,12 @@   u <- get   stateMap (setAgentDB u) agentDB program -withAgentNamer+withNamer   :: (Universe u, Monad m)-    => StateT (AgentNamer u) m a -> StateT u m a-withAgentNamer program = do+    => StateT (Namer u) m a -> StateT u m a+withNamer program = do   u <- get-  stateMap (setAgentNamer u) agentNamer program+  stateMap (setNamer u) agentNamer program  withChecklist   :: (Universe u, Monad m)@@ -139,7 +139,7 @@  -- | Generate a unique name for a new agent. genName :: Universe u => StateT u IO A.AgentId-genName = withAgentNamer N.genName+genName = withNamer N.genName  -- | Returns the list of agents in the population. agentIds :: Universe u => StateT u IO [A.AgentId]@@ -186,9 +186,6 @@     => Agent u -> StateT u IO () store a = do   newAgent <- isNew (A.agentId a)-  -- agentList <- agentIds-  -- writeToLog $ "DEBUG agents:" ++ show agentList-  -- writeToLog $ "DEBUG " ++ A.agentId a ++ " new? " ++ show newAgent   withAgentDB (D.store a) -- Even dead agents should be stored (prior to archiving)   if A.isAlive a     then@@ -200,7 +197,6 @@       withChecklist $ CL.delete (A.agentId a)       writeToLog $ (A.agentId a) ++ " archived and removed from lineup" --- | EXPORTED FOR TESTING ONLY isNew :: Universe u => A.AgentId -> StateT u IO Bool isNew name = fmap (name `notElem`) agentIds @@ -278,12 +274,12 @@   {     suClock :: K.PersistentCounter,     suLogger :: L.SimpleRotatingLogger,-    suDB :: (FS.FSDatabase a),-    suNamer :: N.SimpleAgentNamer,+    suDB :: FS.FSDatabase a,+    suNamer :: N.SimpleNamer,     suChecklist :: CL.PersistentChecklist   } deriving (Show, Eq) -instance (A.Agent a, Serialize a) => Universe (SimpleUniverse a) where+instance (A.Agent a, D.Record a) => Universe (SimpleUniverse a) where   type Agent (SimpleUniverse a) = a   type Clock (SimpleUniverse a) = K.PersistentCounter   clock = suClock@@ -294,9 +290,9 @@   type AgentDB (SimpleUniverse a) = FS.FSDatabase a   agentDB = suDB   setAgentDB u d = u { suDB=d }-  type AgentNamer (SimpleUniverse a) = N.SimpleAgentNamer+  type Namer (SimpleUniverse a) = N.SimpleNamer   agentNamer = suNamer-  setAgentNamer u n = u { suNamer=n }+  setNamer u n = u { suNamer=n }   type Checklist (SimpleUniverse a) = CL.PersistentChecklist   checklist = suChecklist   setChecklist u cl = u { suChecklist=cl }@@ -307,20 +303,19 @@   where c = K.mkPersistentCounter (dir ++ "/clock")         l = L.mkSimpleRotatingLogger (dir ++ "/log/") name rotateCount         d = FS.mkFSDatabase (dir ++ "/db")-        n = N.mkSimpleAgentNamer (name ++ "_") (dir ++ "/namer")+        n = N.mkSimpleNamer (name ++ "_") (dir ++ "/namer")         cl = CL.mkPersistentChecklist (dir ++ "/todo")  data CachedUniverse a = CachedUniverse   {     cuClock :: K.PersistentCounter,     cuLogger :: L.SimpleRotatingLogger,-    cuDB :: (CFS.CachedFSDatabase a),-    cuNamer :: N.SimpleAgentNamer,+    cuDB :: CFS.CachedFSDatabase a,+    cuNamer :: N.SimpleNamer,     cuChecklist :: CL.PersistentChecklist   } deriving (Show, Eq) -instance (A.Agent a, Serialize a, D.SizedRecord a)-    => Universe (CachedUniverse a) where+instance (A.Agent a, D.SizedRecord a) => Universe (CachedUniverse a) where   type Agent (CachedUniverse a) = a   type Clock (CachedUniverse a) = K.PersistentCounter   clock = cuClock@@ -331,9 +326,9 @@   type AgentDB (CachedUniverse a) = CFS.CachedFSDatabase a   agentDB = cuDB   setAgentDB u d = u { cuDB=d }-  type AgentNamer (CachedUniverse a) = N.SimpleAgentNamer+  type Namer (CachedUniverse a) = N.SimpleNamer   agentNamer = cuNamer-  setAgentNamer u n = u { cuNamer=n }+  setNamer u n = u { cuNamer=n }   type Checklist (CachedUniverse a) = CL.PersistentChecklist   checklist = cuChecklist   setChecklist u cl = u { cuChecklist=cl }@@ -344,5 +339,5 @@   where c = K.mkPersistentCounter (dir ++ "/clock")         l = L.mkSimpleRotatingLogger (dir ++ "/log/") name rotateCount         d = CFS.mkCachedFSDatabase (dir ++ "/db") cacheSize-        n = N.mkSimpleAgentNamer (name ++ "_") (dir ++ "/namer")+        n = N.mkSimpleNamer (name ++ "_") (dir ++ "/namer")         cl = CL.mkPersistentChecklist (dir ++ "/todo")

@@ -34,8 +34,8 @@  prop_cropRect_returns_correct_size ::   (Int, Int) -> (Int, Int) -> String -> Int -> Property-prop_cropRect_returns_correct_size (a,b) (c, d) xs k =-    property $ length xs' == expectedSize || length xs < expectedSize+prop_cropRect_returns_correct_size (a,b) (c,d) xs k =+    property $ length xs' == expectedSize || length xs < minimalOriginalSize   where expectedSize = length is'         is = range ((0,0),(lastRow,lastCol))         is' = filter wanted is@@ -44,6 +44,9 @@         lastCol = constrain (-1,length xs - 1) (k - 1)         delta = if length xs `mod` k == 0 then 0 else 1 --add partial row         xs' = cropRect (a, b) (c, d) xs k+        minimalOriginalSize = c*k + d + 1+          -- the last row of the original matrix must have at least+          -- d+1 elements  -- Warning: If b < a, returns either a or x constrain :: Ord a => (a, a) -> a -> a