system-random-effect 0.2.0 → 0.3.0
raw patch · 4 files changed
+106/−29 lines, 4 filesdep +criteriondep +deepseqdep ~extensible-effects
Dependencies added: criterion, deepseq
Dependency ranges changed: extensible-effects
Files
- bench/Bench.hs +52/−0
- src/System/Random/Effect.hs +4/−4
- system-random-effect.cabal +34/−20
- test/Test.hs +16/−5
+ bench/Bench.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+module Main ( main ) where++import Control.Eff+import Control.Eff.State.Strict+import Control.Applicative+import Control.DeepSeq+import Control.Exception ( evaluate )+import Control.Monad++import Criterion+import Criterion.Config+import Criterion.Main++import System.Random.Effect++fastIntDist :: Member (State Random) r+ => Int+ -> Int+ -> Eff r Int+fastIntDist a' b' = do+ let a = min a' b'+ b = max a' b'+ range = b - a++ x <- randomInt+ return (x `rem` range + a)+{-# NOINLINE fastIntDist #-}++instance NFData a => Benchmarkable (Eff (State Random :> ()) a) where+ run eff n = do+ let res = Control.Eff.run $ runRandomState (mkRandom 0) $ do+ last <$> replicateM n eff++ _ <- evaluate (rnf res)+ return ()++main :: IO ()+main =+ defaultMainWith config (return ()) [+ bcompare [+ bench "fastIntDist" (fastIntDist 1 1000 :: Eff (State Random :> ()) Int)+ , bench "uniformIntDist" (uniformIntDist 1 1000 :: Eff (State Random :> ()) Integer)+ ]+ ]+ where+ config = defaultConfig {+ -- cfgPerformGC = ljust True+ cfgConfInterval = ljust 0.99+ }
src/System/Random/Effect.hs view
@@ -77,8 +77,8 @@ import qualified System.Random.Mersenne.Pure64 as SR import Control.Eff-import Control.Eff.State import Control.Eff.Lift+import Control.Eff.State.Strict -- | A pure mersenne twister pseudo-random number generator. data Random = Random {-# UNPACK #-} !SR.PureMT@@ -92,7 +92,7 @@ -- | Create a new random number generator, using the clocktime as the base for -- the seed. This must be called from a computation with a lifted base effect -- of 'IO'.-mkRandomIO :: Member (Lift IO) r+mkRandomIO :: SetMember Lift (Lift IO) r => Eff r Random mkRandomIO = lift (fmap Random SR.newPureMT) {-# INLINE mkRandomIO #-}@@ -111,9 +111,9 @@ => (SR.PureMT -> (a, SR.PureMT)) -> Eff r a randomF f = do- (Random old) <- getState+ (Random old) <- get let (val, new) = f old- putState (Random new)+ put (Random new) return val {-# INLINE randomF #-}
system-random-effect.cabal view
@@ -1,14 +1,14 @@-name: system-random-effect-version: 0.2.0-synopsis: Random number generation for extensible effects.-homepage: https://github.com/wowus/system-random-effect-license: BSD3-license-file: LICENSE-author: Clark Gaebel-maintainer: cgaebel@uwaterloo.ca-category: System-build-type: Simple-cabal-version: >=1.10+name: system-random-effect+version: 0.3.0+synopsis: Random number generation for extensible effects.+homepage: https://github.com/wowus/system-random-effect+license: BSD3+license-file: LICENSE+author: Clark Gaebel+maintainer: cgaebel@uwaterloo.ca+category: System+build-type: Simple+cabal-version: >=1.10 library hs-source-dirs: src/@@ -16,7 +16,7 @@ exposed-modules: System.Random.Effect build-depends: base == 4.6.*- , extensible-effects == 1.1.*+ , extensible-effects == 1.2.* , mersenne-random-pure64 == 0.2.* , statistics == 0.10.* , vector == 0.10.*@@ -24,12 +24,12 @@ default-language: Haskell2010 -test-suite extensible-effects-tests- type: exitcode-stdio-1.0- main-is: Test.hs- hs-source-dirs: test/+test-suite tests+ type: exitcode-stdio-1.0+ main-is: Test.hs+ hs-source-dirs: test/ - ghc-options: -rtsopts=all -threaded+ ghc-options: -rtsopts=all -threaded build-depends: base == 4.6.* , QuickCheck == 2.*@@ -37,11 +37,25 @@ , test-framework == 0.8.* , test-framework-hunit == 0.3.* , test-framework-quickcheck2 == 0.3.*- , extensible-effects == 1.1.*+ , extensible-effects == 1.2.* , system-random-effect default-language: Haskell2010 +benchmark benchmarks+ type: exitcode-stdio-1.0+ hs-source-dirs: bench/+ ghc-options: -Wall -rtsopts=all -threaded -fno-warn-orphans -O2+ main-is: Bench.hs++ build-depends: base == 4.6.*+ , deepseq == 1.3.*+ , criterion == 0.8.*+ , extensible-effects == 1.2.*+ , system-random-effect++ default-language: Haskell2010+ source-repository head- type: git- location: https://github.com/wowus/system-random-effect+ type: git+ location: https://github.com/wowus/system-random-effect
test/Test.hs view
@@ -3,7 +3,7 @@ module Main ( main ) where import Control.Eff-import Control.Eff.State+import Control.Eff.State.Strict import System.Random.Effect @@ -41,21 +41,32 @@ let ddh = buildDDH xs minVal = 0 maxVal = length xs - 1- in length xs == 0 || sum xs == 0 ||+ in sum xs == 0 || ((\x -> x >= minVal && x <= maxVal) . runWithSeed seed $ discreteDist ddh) testNoZeroDiscreteDistributionPick :: [Word64] -> Word64 -> Bool testNoZeroDiscreteDistributionPick xs seed = let ddh = buildDDH xs- minVal = 0- maxVal = length xs - 1- in length xs == 0 || sum xs == 0 ||+ in sum xs == 0 || ((\x -> (xs !! x) /= 0) . runWithSeed seed $ discreteDist ddh) +testUnsafeThaw :: [Word64] -> Word64 -> Bool+testUnsafeThaw xs seed =+ let ddh = buildDDH xs+ in sum xs == 0 ||+ (runWithSeed seed $ do+ _ <- discreteDist ddh+ _ <- discreteDist ddh+ _ <- discreteDist ddh+ _ <- discreteDist ddh+ _ <- discreteDist ddh+ return True)+ tests = [ testProperty "random range" testUniformRandom , testProperty "discrete dist range" testDiscreteDistributionInRange , testProperty "no non-zero discrete dist pick" testNoZeroDiscreteDistributionPick+ , testProperty "unsafeThaw is okay to use" testUnsafeThaw ]