creatur 5.9.19 → 5.9.20
raw patch · 6 files changed
+77/−178 lines, 6 filesdep ~HUnitdep ~QuickCheckdep ~array
Dependency ranges changed: HUnit, QuickCheck, array, base, binary, bytestring, directory, filepath, process, temporary, time, unix
Files
- creatur.cabal +18/−20
- src/ALife/Creatur/Genetics/BRGCBool.hs +4/−2
- src/ALife/Creatur/Genetics/BRGCWord16.hs +18/−2
- src/ALife/Creatur/Genetics/BRGCWord8.hs +37/−32
- test/ALife/Creatur/Genetics/BRGCBoolBench.hs +0/−57
- test/ALife/Creatur/Genetics/BRGCWord8Bench.hs +0/−65
creatur.cabal view
@@ -1,5 +1,5 @@ name: creatur-version: 5.9.19+version: 5.9.20 cabal-version: >=1.8 build-type: Simple license: BSD3@@ -58,27 +58,27 @@ ALife.Creatur.Task ALife.Creatur.Util build-depends:- array >=0.5.1.1 && <0.6,- base ==4.9.* || ==4.10.*,- binary >=0.8.3.0 && <0.9,- bytestring >=0.10.8.1 && <0.11,+ array >=0.5.2.0 && <0.6,+ base >=4.10.0.0 && <4.11,+ binary >=0.8.5.1 && <0.9,+ bytestring >=0.10.8.2 && <0.11, cond >=0.4.1.1 && <0.5, cereal >=0.5.4.0 && <0.6,- directory >=1.3.0.0 && <1.4,+ directory >=1.3.0.2 && <1.4, exceptions >=0.8.3 && <0.9,- filepath >=1.4.1.1 && <1.5,+ filepath >=1.4.1.2 && <1.5, gray-extended >=1.5.2 && <1.6, hdaemonize >=0.5.4 && <0.6, hsyslog >=5.0.1 && <5.1, MonadRandom >=0.5.1 && <0.6, mtl >=2.2.1 && <2.3, old-locale >=1.0.0.7 && <1.1,- process >=1.4.3.0 && <1.5,+ process >=1.6.1.0 && <1.7, random ==1.1.*, split >=0.2.3.2 && <0.3,- time >=1.6.0.1 && <1.7,+ time >=1.8.0.2 && <1.9, transformers >=0.5.2.0 && <0.6,- unix >=2.7.2.1 && <2.8,+ unix >=2.7.2.2 && <2.8, zlib >=0.6.1.2 && <0.7 hs-source-dirs: src other-modules:@@ -89,32 +89,30 @@ type: exitcode-stdio-1.0 main-is: TestAll.hs build-depends:- array >=0.5.1.1 && <0.6,- base ==4.9.* || ==4.10.*,- binary >=0.8.3.0 && <0.9,+ array >=0.5.2.0 && <0.6,+ base >=4.10.0.0 && <4.11,+ binary >=0.8.5.1 && <0.9, cereal >=0.5.4.0 && <0.6, creatur,- directory >=1.3.0.0 && <1.4,- filepath >=1.4.1.1 && <1.5,+ directory >=1.3.0.2 && <1.4,+ filepath >=1.4.1.2 && <1.5, hsyslog >=5.0.1 && <5.1,- HUnit >=1.5.0.0 && <1.6,+ HUnit >=1.6.0.0 && <1.7, MonadRandom >=0.5.1 && <0.6, mtl >=2.2.1 && <2.3,- temporary >=1.2.1 && <1.3,+ temporary >=1.2.1.1 && <1.3, test-framework >=0.8.1.1 && <0.9, test-framework-hunit >=0.3.0.2 && <0.4, test-framework-quickcheck2 >=0.3.0.4 && <0.4,- QuickCheck >=2.9.2 && <2.10+ QuickCheck >=2.10.0.1 && <2.11 hs-source-dirs: test other-modules: ALife.Creatur.ChecklistQC ALife.Creatur.CounterQC ALife.Creatur.Database.CachedFileSystemQC ALife.Creatur.Database.FileSystemQC- ALife.Creatur.Genetics.BRGCBoolBench ALife.Creatur.Genetics.BRGCBoolQC ALife.Creatur.Genetics.BRGCWord16QC- ALife.Creatur.Genetics.BRGCWord8Bench ALife.Creatur.Genetics.BRGCWord8QC ALife.Creatur.Genetics.DiploidQC ALife.Creatur.Genetics.RecombinationQC
src/ALife/Creatur/Genetics/BRGCBool.hs view
@@ -184,9 +184,11 @@ return $ Right x instance Genetic Char where- put = putRawBoolArray . intToBools 8 . ord+ put c = do+ let bs = map (\b -> b == '1') $ showIntAtBase 2 intToDigit (ord c) ""+ put bs get = do- bs <- getRawBoolArray 8+ bs <- get return . fmap chr $ fmap boolsToInt bs instance Genetic Word8 where
src/ALife/Creatur/Genetics/BRGCWord16.hs view
@@ -58,6 +58,8 @@ import Codec.Gray (integralToGray, grayToIntegral) import Control.Monad.State.Lazy (StateT, runState, execState, evalState) import qualified Control.Monad.State.Lazy as S (put, get, gets)+import Data.Binary (Binary, encode, decode)+import Data.ByteString.Lazy (pack, unpack) import Data.Char (ord, chr) import Data.Functor.Identity (Identity) import Data.Word (Word8, Word16)@@ -182,8 +184,8 @@ word16ToBool x = if even x then False else True instance Genetic Char where- put = putRawWord16 . fromIntegral . ord- get = fmap (fmap (chr . fromIntegral)) getRawWord16+ put = put . ord+ get = fmap (fmap chr) get instance Genetic Word8 where put x = put (fromIntegral x :: Word16)@@ -195,6 +197,14 @@ put = putRawWord16 . integralToGray get = fmap (fmap grayToIntegral) getRawWord16 +instance Genetic Int where+ put g = put (map integralToGray . integralToByteArray $ g)+ get = do+ x <- get+ case x of+ Right xs -> return $ Right (byteArrayToIntegral . map grayToIntegral $ xs)+ Left s -> return $ Left s+ instance (Genetic a) => Genetic [a] instance (Genetic a) => Genetic (Maybe a)@@ -207,6 +217,12 @@ -- -- Utilities --++integralToByteArray :: (Integral t, Binary t) => t -> [Word8]+integralToByteArray = unpack . encode++byteArrayToIntegral :: (Integral t, Binary t) => [Word8] -> t+byteArrayToIntegral = decode . pack -- | Write a Word16 value to the genome without encoding it putRawWord16 :: Word16 -> Writer ()
src/ALife/Creatur/Genetics/BRGCWord8.hs view
@@ -193,11 +193,16 @@ word8ToBool x = if even x then False else True instance Genetic Char where- put x = putAndReport [fromIntegral . ord $ x] (show x)- get = getAndReport 1 convert- where convert (x:[]) = Right (g, show g)- where g = (chr . fromIntegral) x- convert _ = Left "logic error"+ put c = do+ put . ord $ c+ replaceReportW [c]+ get = do+ x <- get+ case x of+ Right x' -> do let c = chr x'+ replaceReportR [c]+ return $ Right c+ Left s -> return $ Left s instance Genetic Word8 where put x = putAndReport [integralToGray x] (show x ++ " Word8")@@ -249,6 +254,33 @@ Left s' -> return $ Left s' Left s -> return $ Left s +instance (Genetic a) => Genetic [a] where+ put xs = do+ put n'+ replaceReportW (show n' ++ " list length")+ mapM_ put xs+ where n = length xs+ n' = if n <= fromIntegral (maxBound :: Word16)+ then fromIntegral n+ else error "List too long" :: Word16+ get = do+ n <- get :: Reader (Either [String] Word16)+ case n of+ Right n' -> do replaceReportR (show n' ++ " list length")+ getList (fromIntegral n')+ Left s -> return $ Left s++instance (Genetic a) => Genetic (Maybe a)++instance (Genetic a, Genetic b) => Genetic (a, b)++instance (Genetic a, Genetic b) => Genetic (Either a b)+++--+-- Utilities+--+ grayWord16 :: [Word8] -> Either String (Word16, String) grayWord16 bs = Right (g, show g ++ " Word16") where g = grayToIntegral . bytesToIntegral $ bs@@ -278,33 +310,6 @@ byteArrayToIntegral :: (Integral t, Binary t) => [Word8] -> t byteArrayToIntegral = decode . pack--instance (Genetic a) => Genetic [a] where- put xs = do- put n'- replaceReportW (show n' ++ " list length")- mapM_ put xs- where n = length xs- n' = if n <= fromIntegral (maxBound :: Word16)- then fromIntegral n- else error "List too long" :: Word16- get = do- n <- get :: Reader (Either [String] Word16)- case n of- Right n' -> do replaceReportR (show n' ++ " list length")- getList (fromIntegral n')- Left s -> return $ Left s--instance (Genetic a) => Genetic (Maybe a)--instance (Genetic a, Genetic b) => Genetic (a, b)--instance (Genetic a, Genetic b) => Genetic (Either a b)-------- Utilities--- finalise :: Writer () finalise = do
− test/ALife/Creatur/Genetics/BRGCBoolBench.hs
@@ -1,57 +0,0 @@---------------------------------------------------------------------------- |--- Module : ALife.Creatur.Genetics.BRGCBoolBench--- Copyright : (c) Amy de Buitléir 2014-2016--- License : BSD-style--- Maintainer : amy@nualeargais.ie--- Stability : experimental--- Portability : portable------ Benchmarks.-----------------------------------------------------------------------------{-# LANGUAGE DeriveGeneric, FlexibleInstances #-}-module ALife.Creatur.Genetics.BRGCBoolBench- (- benchmark- ) where--import Prelude hiding (read)-import ALife.Creatur.Genetics.BRGCBool-import Data.Word (Word8)-import Criterion.Main (Benchmark, Pure, nf, bgroup, bench)--word8 :: Word8-word8 = 0--word8Encoded :: [Bool]-word8Encoded = write word8- -putWord8Benchmark :: Pure-putWord8Benchmark = nf write word8--getWord8Benchmark :: Pure-getWord8Benchmark = nf (read :: Sequence -> Either [String] Word8) word8Encoded--word8s :: [Word8]-word8s = [0..255]--word8sEncoded :: [Bool]-word8sEncoded = write word8s--putWord8sBenchmark :: Pure-putWord8sBenchmark = nf write word8s--getWord8sBenchmark :: Pure-getWord8sBenchmark = nf (read :: Sequence -> Either [String] [Word8]) word8sEncoded--benchmark :: Benchmark-benchmark = bgroup "ALife.Creatur.Genetics.BRGCBoolBench"- [- bench "put Word8" putWord8Benchmark,- bench "get Word8" getWord8Benchmark,- bench "put [Word8]" putWord8sBenchmark,- bench "get [Word8]" getWord8sBenchmark- ]--
− test/ALife/Creatur/Genetics/BRGCWord8Bench.hs
@@ -1,65 +0,0 @@---------------------------------------------------------------------------- |--- Module : ALife.Creatur.Genetics.BRGCWord8Bench--- Copyright : (c) Amy de Buitléir 2014-2016--- License : BSD-style--- Maintainer : amy@nualeargais.ie--- Stability : experimental--- Portability : portable------ Benchmarks.-----------------------------------------------------------------------------{-# LANGUAGE DeriveGeneric, FlexibleInstances #-}-module ALife.Creatur.Genetics.BRGCWord8Bench- (- benchmark- ) where--import Prelude hiding (read)-import ALife.Creatur.Genetics.BRGCWord8-import Data.Word (Word8)-import Criterion.Main (Benchmark, Pure, nf, bgroup, bench)--word8 :: Word8-word8 = 0--word8Encoded :: [Word8]-word8Encoded = write word8- -putWord8Benchmark :: Pure-putWord8Benchmark = nf write word8--getWord8Benchmark :: Pure-getWord8Benchmark = nf (read :: Sequence -> Either [String] Word8) word8Encoded--word8s :: [Word8]-word8s = concatMap (replicate 10) [0..255]--word8sEncoded :: [Word8]-word8sEncoded = write word8s--putWord8sBenchmark :: Pure-putWord8sBenchmark = nf write word8s--getWord8sBenchmark :: Pure-getWord8sBenchmark = nf (read :: Sequence -> Either [String] [Word8]) word8sEncoded---- putRawWord8sBenchmark :: Pure--- putRawWord8sBenchmark = nf (runWriter putRawWord8s) word8s---- getRawWord8sBenchmark :: Pure--- getRawWord8sBenchmark = nf (runReader getRawWord8sBenchmark) word8sEncoded--benchmark :: Benchmark-benchmark = bgroup "ALife.Creatur.Genetics.BRGCWord8Bench"- [- bench "put Word8" putWord8Benchmark,- bench "get Word8" getWord8Benchmark,- bench "put [Word8]" putWord8sBenchmark,- bench "get [Word8]" getWord8sBenchmark- -- bench "putRaw [Word8]" putRawWord8sBenchmark,- -- bench "getRaw [Word8]" getRawWord8sBenchmark- ]--