Hello community, here is the log from the commit of package ghc-mwc-random for openSUSE:Factory checked in at 2018-08-20 16:20:38 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-mwc-random (Old) and /work/SRC/openSUSE:Factory/.ghc-mwc-random.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-mwc-random" Mon Aug 20 16:20:38 2018 rev:2 rq:630370 version:0.14.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-mwc-random/ghc-mwc-random.changes 2018-07-25 16:09:23.253481285 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-mwc-random.new/ghc-mwc-random.changes 2018-08-20 16:20:39.544927403 +0200 @@ -1,0 +2,13 @@ +Fri Aug 17 09:43:29 UTC 2018 - psim...@suse.com + +- Update mwc-random to version 0.14.0.0. + ## Changes in 0.14.0.0 + + * Low level functions for acquiring random data for initialization + of PRGN state is moved to `System.Random.MWC.SeedSource` module + + * Ensure that carry is always correct when restoring PRNG state from + seed. Only affects users who create 258 element seed manually. + (#63, #65) + +------------------------------------------------------------------- Old: ---- mwc-random-0.13.6.0.tar.gz New: ---- mwc-random-0.14.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-mwc-random.spec ++++++ --- /var/tmp/diff_new_pack.GcorNx/_old 2018-08-20 16:20:42.256931236 +0200 +++ /var/tmp/diff_new_pack.GcorNx/_new 2018-08-20 16:20:42.260931242 +0200 @@ -17,9 +17,8 @@ %global pkg_name mwc-random -%bcond_with tests Name: ghc-%{pkg_name} -Version: 0.13.6.0 +Version: 0.14.0.0 Release: 0 Summary: Fast, high quality pseudo random number generation License: BSD-2-Clause @@ -32,14 +31,6 @@ BuildRequires: ghc-rpm-macros BuildRequires: ghc-time-devel BuildRequires: ghc-vector-devel -%if %{with tests} -BuildRequires: ghc-HUnit-devel -BuildRequires: ghc-QuickCheck-devel -BuildRequires: ghc-statistics-devel -BuildRequires: ghc-test-framework-devel -BuildRequires: ghc-test-framework-hunit-devel -BuildRequires: ghc-test-framework-quickcheck2-devel -%endif %description This package contains code for generating high quality random numbers that @@ -74,9 +65,6 @@ %install %ghc_lib_install -%check -%cabal_test - %post devel %ghc_pkg_recache ++++++ mwc-random-0.13.6.0.tar.gz -> mwc-random-0.14.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/README.markdown new/mwc-random-0.14.0.0/README.markdown --- old/mwc-random-0.13.6.0/README.markdown 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/README.markdown 2018-07-11 18:23:47.000000000 +0200 @@ -1,4 +1,6 @@ # Efficient, general purpose pseudo-random number generation +[![Build Status](https://travis-ci.org/Shimuuar/mwc-random.png?branch=master)](https://travis-ci.org/Shimuuar/mwc-random) +[![Build status](https://ci.appveyor.com/api/projects/status/4228vkxje4as3nhw/branch/master)](https://ci.appveyor.com/project/Shimuuar/mwc-random) This package provides the System.Random.MWC module, a Haskell library for generating high-quality pseudo-random numbers in a space- and diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/System/Random/MWC/SeedSource.hs new/mwc-random-0.14.0.0/System/Random/MWC/SeedSource.hs --- old/mwc-random-0.13.6.0/System/Random/MWC/SeedSource.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/mwc-random-0.14.0.0/System/Random/MWC/SeedSource.hs 2018-07-11 18:23:47.000000000 +0200 @@ -0,0 +1,97 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | +-- Low level source of random values for seeds. It should work on both +-- unices and windows +module System.Random.MWC.SeedSource ( + acquireSeedSystem + , acquireSeedTime + , randomSourceName + ) where + +import Control.Monad (liftM) +import Data.Word (Word32,Word64) +import Data.Bits (shiftR) +import Data.Ratio ((%), numerator) +import Data.Time.Clock.POSIX (getPOSIXTime) + +import Foreign.Storable +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Marshal.Array (peekArray) +#if defined(mingw32_HOST_OS) +import Foreign.Ptr +import Foreign.C.Types +#endif +import System.CPUTime (cpuTimePrecision, getCPUTime) +import System.IO (IOMode(..), hGetBuf, withBinaryFile) + +-- Acquire seed from current time. This is horrible fallback for +-- Windows system. +acquireSeedTime :: IO [Word32] +acquireSeedTime = do + c <- (numerator . (%cpuTimePrecision)) `liftM` getCPUTime + t <- toRational `liftM` getPOSIXTime + let n = fromIntegral (numerator t) :: Word64 + return [fromIntegral c, fromIntegral n, fromIntegral (n `shiftR` 32)] + +-- | Acquire seed from the system entropy source. On Unix machines, +-- this will attempt to use @/dev/urandom@. On Windows, it will internally +-- use @RtlGenRandom@. +acquireSeedSystem :: forall a. Storable a => Int -> IO [a] +acquireSeedSystem nElts = do + let eltSize = sizeOf (undefined :: a) + nbytes = nElts * eltSize +#if !defined(mingw32_HOST_OS) + allocaBytes nbytes $ \buf -> do + nread <- withBinaryFile "/dev/urandom" ReadMode $ \h -> hGetBuf h buf nbytes + peekArray (nread `div` eltSize) buf +#else + -- Generate 256 random Word32s from RtlGenRandom + allocaBytes nbytes $ \buf -> do + ok <- c_RtlGenRandom buf (fromIntegral nbytes) + if ok then return () else fail "Couldn't use RtlGenRandom" + peekArray nElts buf + +-- Note: on 64-bit Windows, the 'stdcall' calling convention +-- isn't supported, so we use 'ccall' instead. +#if defined(i386_HOST_ARCH) +# define WINDOWS_CCONV stdcall +#elif defined(x86_64_HOST_ARCH) +# define WINDOWS_CCONV ccall +#else +# error Unknown mingw32 architecture! +#endif + +-- Note: On Windows, the typical convention would be to use +-- the CryptoGenRandom API in order to generate random data. +-- However, here we use 'SystemFunction036', AKA RtlGenRandom. +-- +-- This is a commonly used API for this purpose; one bonus is +-- that it avoids having to bring in the CryptoAPI library, +-- and completely sidesteps the initialization cost of CryptoAPI. +-- +-- While this function is technically "subject to change" that is +-- extremely unlikely in practice: rand_s in the Microsoft CRT uses +-- this, and they can't change it easily without also breaking +-- backwards compatibility with e.g. statically linked applications. +-- +-- The name 'SystemFunction036' is the actual link-time name; the +-- display name is just for giggles, I guess. +-- +-- See also: +-- - http://blogs.msdn.com/b/michael_howard/archive/2005/01/14/353379.aspx +-- - https://bugzilla.mozilla.org/show_bug.cgi?id=504270 +-- +foreign import WINDOWS_CCONV unsafe "SystemFunction036" + c_RtlGenRandom :: Ptr a -> CULong -> IO Bool +#endif + + +-- | Name of source of randomness. It should be used in error messages +randomSourceName :: String +#if !defined(mingw32_HOST_OS) +randomSourceName = "/dev/urandom" +#else +randomSourceName = "RtlGenRandom" +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/System/Random/MWC.hs new/mwc-random-0.14.0.0/System/Random/MWC.hs --- old/mwc-random-0.13.6.0/System/Random/MWC.hs 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/System/Random/MWC.hs 2018-07-11 18:23:47.000000000 +0200 @@ -1,6 +1,6 @@ {-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, FlexibleContexts, - MagicHash, Rank2Types, ScopedTypeVariables, TypeFamilies, UnboxedTuples, - ForeignFunctionInterface #-} + MagicHash, Rank2Types, ScopedTypeVariables, TypeFamilies, UnboxedTuples + #-} -- | -- Module : System.Random.MWC -- Copyright : (c) 2009-2012 Bryan O'Sullivan @@ -99,35 +99,25 @@ #endif import Control.Monad (ap, liftM, unless) -import Control.Monad.Primitive (PrimMonad, PrimState, unsafePrimToIO) -#if MIN_VERSION_primitive(0,6,0) -import Control.Monad.Primitive (PrimBase) -#endif +import Control.Monad.Primitive (PrimMonad, PrimBase, PrimState, unsafePrimToIO) import Control.Monad.ST (ST) import Data.Bits ((.&.), (.|.), shiftL, shiftR, xor) import Data.Int (Int8, Int16, Int32, Int64) import Data.IORef (atomicModifyIORef, newIORef) -import Data.Ratio ((%), numerator) -import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Typeable (Typeable) import Data.Vector.Generic (Vector) -import Data.Word (Word8, Word16, Word32, Word64) -#if !MIN_VERSION_base(4,8,0) -import Data.Word (Word) -#endif -import Foreign.Marshal.Alloc (allocaBytes) -import Foreign.Marshal.Array (peekArray) +import Data.Word import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as I import qualified Data.Vector.Unboxed.Mutable as M -import System.CPUTime (cpuTimePrecision, getCPUTime) -import System.IO (IOMode(..), hGetBuf, hPutStrLn, stderr, withBinaryFile) +import System.IO (hPutStrLn, stderr) import System.IO.Unsafe (unsafePerformIO) import qualified Control.Exception as E #if defined(mingw32_HOST_OS) import Foreign.Ptr import Foreign.C.Types #endif +import System.Random.MWC.SeedSource -- | The class of types for which we can generate uniformly @@ -202,7 +192,7 @@ {-# INLINE uniformR #-} instance Variate Word32 where - uniform = uniform1 fromIntegral + uniform = uniform1 id uniformR a b = uniformRange a b {-# INLINE uniform #-} {-# INLINE uniformR #-} @@ -359,6 +349,17 @@ -- the following example: -- -- @gen' <- 'initialize' . 'fromSeed' =<< 'save'@ +-- +-- In the MWC algorithm, the /carry/ value must be strictly smaller than the +-- multiplicator (see https://en.wikipedia.org/wiki/Multiply-with-carry). +-- Hence, if a seed contains exactly 258 elements, the /carry/ value, which is +-- the last of the 258 values, is moduloed by the multiplicator. +-- +-- Note that if the /first/ carry value is strictly smaller than the multiplicator, +-- all subsequent carry values are also strictly smaller than the multiplicator +-- (a proof of this is in the comments of the code of 'uniformWord32'), hence +-- when restoring a saved state, we have the guarantee that moduloing the saved +-- carry won't modify its value. initialize :: (PrimMonad m, Vector v Word32) => v Word32 -> m (Gen (PrimState m)) initialize seed = do @@ -367,7 +368,7 @@ if fini == 258 then do M.unsafeWrite q ioff $ G.unsafeIndex seed ioff .&. 255 - M.unsafeWrite q coff $ G.unsafeIndex seed coff + M.unsafeWrite q coff $ G.unsafeIndex seed coff `mod` fromIntegral aa else do M.unsafeWrite q ioff 255 M.unsafeWrite q coff 362436 @@ -409,70 +410,6 @@ {-# INLINE restore #-} --- Aquire seed from current time. This is horrible fallback for --- Windows system. -acquireSeedTime :: IO [Word32] -acquireSeedTime = do - c <- (numerator . (%cpuTimePrecision)) `liftM` getCPUTime - t <- toRational `liftM` getPOSIXTime - let n = fromIntegral (numerator t) :: Word64 - return [fromIntegral c, fromIntegral n, fromIntegral (n `shiftR` 32)] - --- | Acquire seed from the system entropy source. On Unix machines, --- this will attempt to use @/dev/urandom@. On Windows, it will internally --- use @RtlGenRandom@. -acquireSeedSystem :: IO [Word32] -acquireSeedSystem = do -#if !defined(mingw32_HOST_OS) - -- Read 256 random Word32s from /dev/urandom - let nbytes = 1024 - random = "/dev/urandom" - allocaBytes nbytes $ \buf -> do - nread <- withBinaryFile random ReadMode $ - \h -> hGetBuf h buf nbytes - peekArray (nread `div` 4) buf -#else - let nbytes = 1024 - -- Generate 256 random Word32s from RtlGenRandom - allocaBytes nbytes $ \buf -> do - ok <- c_RtlGenRandom buf (fromIntegral nbytes) - if ok then return () else fail "Couldn't use RtlGenRandom" - peekArray (nbytes `div` 4) buf - --- Note: on 64-bit Windows, the 'stdcall' calling convention --- isn't supported, so we use 'ccall' instead. -#if defined(i386_HOST_ARCH) -# define WINDOWS_CCONV stdcall -#elif defined(x86_64_HOST_ARCH) -# define WINDOWS_CCONV ccall -#else -# error Unknown mingw32 architecture! -#endif - --- Note: On Windows, the typical convention would be to use --- the CryptoGenRandom API in order to generate random data. --- However, here we use 'SystemFunction036', AKA RtlGenRandom. --- --- This is a commonly used API for this purpose; one bonus is --- that it avoids having to bring in the CryptoAPI library, --- and completely sidesteps the initialization cost of CryptoAPI. --- --- While this function is technically "subject to change" that is --- extremely unlikely in practice: rand_s in the Microsoft CRT uses --- this, and they can't change it easily without also breaking --- backwards compatibility with e.g. statically linked applications. --- --- The name 'SystemFunction036' is the actual link-time name; the --- display name is just for giggles, I guess. --- --- See also: --- - http://blogs.msdn.com/b/michael_howard/archive/2005/01/14/353379.aspx --- - https://bugzilla.mozilla.org/show_bug.cgi?id=504270 --- -foreign import WINDOWS_CCONV unsafe "SystemFunction036" - c_RtlGenRandom :: Ptr a -> CULong -> IO Bool -#endif - -- | Seed a PRNG with data from the system's fast source of -- pseudo-random numbers (\"@\/dev\/urandom@\" on Unix-like systems or -- @RtlGenRandom@ on Windows), then run the given action. @@ -480,22 +417,13 @@ -- This is a somewhat expensive function, and is intended to be called -- only occasionally (e.g. once per thread). You should use the `Gen` -- it creates to generate many random numbers. -withSystemRandom :: -#if MIN_VERSION_primitive(0,6,0) - PrimBase m -#else - PrimMonad m -#endif +withSystemRandom :: PrimBase m => (Gen (PrimState m) -> m a) -> IO a withSystemRandom act = do - seed <- acquireSeedSystem `E.catch` \(_::E.IOException) -> do + seed <- acquireSeedSystem 256 `E.catch` \(_::E.IOException) -> do seen <- atomicModifyIORef warned ((,) True) unless seen $ E.handle (\(_::E.IOException) -> return ()) $ do -#if !defined(mingw32_HOST_OS) - hPutStrLn stderr ("Warning: Couldn't open /dev/urandom") -#else - hPutStrLn stderr ("Warning: Couldn't use RtlGenRandom") -#endif + hPutStrLn stderr $ "Warning: Couldn't use randomness source " ++ randomSourceName hPutStrLn stderr ("Warning: using system clock for seed instead " ++ "(quality will be lower)") acquireSeedTime @@ -516,6 +444,10 @@ where j = fromIntegral (i+1) :: Word8 {-# INLINE nextIndex #-} +-- The multiplicator : 0x5BCF5AB2 +-- +-- Eventhough it is a 'Word64', it is important for the correctness of the proof +-- on carry value that it is /not/ greater than maxBound 'Word32'. aa :: Word64 aa = 1540315826 {-# INLINE aa #-} @@ -526,10 +458,29 @@ c <- fromIntegral `liftM` M.unsafeRead q coff qi <- fromIntegral `liftM` M.unsafeRead q i let t = aa * qi + c + -- The comments in this function are a proof that: + -- "if the carry value is strictly smaller than the multiplicator, + -- the next carry value is also strictly smaller than the multiplicator." + -- Eventhough the proof is written in terms of the actual value of the multiplicator, + -- it holds for any multiplicator value /not/ greater than maxBound 'Word32' + -- + -- (In the code, the multiplicator is aa, the carry value is c, + -- the next carry value is c''.) + -- + -- So we'll assume that c < aa, and show that c'' < aa : + -- + -- by definition, aa = 0x5BCF5AB2, qi <= 0xFFFFFFFF (because it is a 'Word32') + -- hence aa*qi <= 0x5BCF5AB200000000 - 0x5BCF5AB2. + -- + -- hence t < 0x5BCF5AB200000000 (because t = aa * qi + c and c < 0x5BCF5AB2) + -- hence t <= 0x5BCF5AB1FFFFFFFF c' = fromIntegral (t `shiftR` 32) + -- c' < 0x5BCF5AB1 x = fromIntegral t + c' (# x', c'' #) | x < c' = (# x + 1, c' + 1 #) | otherwise = (# x, c' #) + -- hence c'' < 0x5BCF5AB2, + -- hence c'' < aa, which is what we wanted to prove. M.unsafeWrite q i x' M.unsafeWrite q ioff (fromIntegral i) M.unsafeWrite q coff (fromIntegral c'') diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/benchmarks/Benchmark.hs new/mwc-random-0.14.0.0/benchmarks/Benchmark.hs --- old/mwc-random-0.13.6.0/benchmarks/Benchmark.hs 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/benchmarks/Benchmark.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,113 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -import Control.Exception -import Control.Monad -import Control.Monad.ST -import Criterion.Main -import Data.Int -import Data.Word -import qualified Data.Vector.Unboxed as U -import qualified System.Random as R -import System.Random.MWC -import System.Random.MWC.Distributions -import System.Random.MWC.CondensedTable -import qualified System.Random.Mersenne as M - -makeTableUniform :: Int -> CondensedTable U.Vector Int -makeTableUniform n = - tableFromProbabilities $ U.zip (U.enumFromN 0 n) (U.replicate n (1 / fromIntegral n)) -{-# INLINE makeTableUniform #-} - - -main = do - mwc <- create - mtg <- M.newMTGen . Just =<< uniform mwc - defaultMain - [ bgroup "mwc" - -- One letter group names are used so they will fit on the plot. - -- - -- U - uniform - -- R - uniformR - -- D - distribution - [ bgroup "U" - [ bench "Double" (uniform mwc :: IO Double) - , bench "Int" (uniform mwc :: IO Int) - , bench "Int8" (uniform mwc :: IO Int8) - , bench "Int16" (uniform mwc :: IO Int16) - , bench "Int32" (uniform mwc :: IO Int32) - , bench "Int64" (uniform mwc :: IO Int64) - , bench "Word" (uniform mwc :: IO Word) - , bench "Word8" (uniform mwc :: IO Word8) - , bench "Word16" (uniform mwc :: IO Word16) - , bench "Word32" (uniform mwc :: IO Word32) - , bench "Word64" (uniform mwc :: IO Word64) - ] - , bgroup "R" - -- I'm not entirely convinced that this is right way to test - -- uniformR. /A.Khudyakov/ - [ bench "Double" (uniformR (-3.21,26) mwc :: IO Double) - , bench "Int" (uniformR (-12,679) mwc :: IO Int) - , bench "Int8" (uniformR (-12,4) mwc :: IO Int8) - , bench "Int16" (uniformR (-12,679) mwc :: IO Int16) - , bench "Int32" (uniformR (-12,679) mwc :: IO Int32) - , bench "Int64" (uniformR (-12,679) mwc :: IO Int64) - , bench "Word" (uniformR (34,633) mwc :: IO Word) - , bench "Word8" (uniformR (34,63) mwc :: IO Word8) - , bench "Word16" (uniformR (34,633) mwc :: IO Word16) - , bench "Word32" (uniformR (34,633) mwc :: IO Word32) - , bench "Word64" (uniformR (34,633) mwc :: IO Word64) - ] - , bgroup "D" - [ bench "standard" (standard mwc :: IO Double) - , bench "normal" (normal 1 3 mwc :: IO Double) - -- Regression tests for #16. These functions should take 10x - -- longer to execute. - -- - -- N.B. Bang patterns are necessary to trigger the bug with - -- GHC 7.6 - , bench "standard/N" (replicateM_ 10 $ do - !_ <- standard mwc :: IO Double - return () - ) - , bench "normal/N" (replicateM_ 10 $ do - !_ <- normal 1 3 mwc :: IO Double - return () - ) - , bench "exponential" (exponential 3 mwc :: IO Double) - , bench "gamma,a<1" (gamma 0.5 1 mwc :: IO Double) - , bench "gamma,a>1" (gamma 2 1 mwc :: IO Double) - , bench "chiSquare" (chiSquare 4 mwc :: IO Double) - ] - , bgroup "CT/gen" $ concat - [ [ bench ("uniform "++show i) (genFromTable (makeTableUniform i) mwc :: IO Int) - | i <- [2..10] - ] - , [ bench ("poisson " ++ show l) (genFromTable (tablePoisson l) mwc :: IO Int) - | l <- [0.01, 0.2, 0.8, 1.3, 2.4, 8, 12, 100, 1000] - ] - , [ bench ("binomial " ++ show p ++ " " ++ show n) (genFromTable (tableBinomial n p) mwc :: IO Int) - | (n,p) <- [ (4, 0.5), (10,0.1), (10,0.6), (10, 0.8), (100,0.4)] - ] - ] - , bgroup "CT/table" $ concat - [ [ bench ("uniform " ++ show i) $ whnf makeTableUniform i - | i <- [2..30] - ] - , [ bench ("poisson " ++ show l) $ whnf tablePoisson l - | l <- [0.01, 0.2, 0.8, 1.3, 2.4, 8, 12, 100, 1000] - ] - , [ bench ("binomial " ++ show p ++ " " ++ show n) $ whnf (tableBinomial n) p - | (n,p) <- [ (4, 0.5), (10,0.1), (10,0.6), (10, 0.8), (100,0.4)] - ] - ] - ] - , bgroup "random" - [ - bench "Double" (R.randomIO >>= evaluate :: IO Double) - , bench "Int" (R.randomIO >>= evaluate :: IO Int) - ] - , bgroup "mersenne" - [ - bench "Double" (M.random mtg :: IO Double) - , bench "Int" (M.random mtg :: IO Int) - ] - ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/benchmarks/Quickie.hs new/mwc-random-0.14.0.0/benchmarks/Quickie.hs --- old/mwc-random-0.13.6.0/benchmarks/Quickie.hs 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/benchmarks/Quickie.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,13 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -import System.Random.MWC (create, uniform) -import Control.Monad.ST (ST, runST) - -u :: ST s Double -u = do - let last = 1000000 :: Int - gen <- create - let loop !n !i | n == last = return i - | otherwise = uniform gen >>= loop (n+1) - loop 0 0 - -main = print (runST u) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/benchmarks/mwc-random-benchmarks.cabal new/mwc-random-0.14.0.0/benchmarks/mwc-random-benchmarks.cabal --- old/mwc-random-0.13.6.0/benchmarks/mwc-random-benchmarks.cabal 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/benchmarks/mwc-random-benchmarks.cabal 1970-01-01 01:00:00.000000000 +0100 @@ -1,18 +0,0 @@ -name: mwc-random-benchmarks -version: 0 -synopsis: Benchmarks for the mwc-random package -description: Benchmarks for the mwc-random package -license: BSD3 -license-file: ../LICENSE -build-type: Simple -cabal-version: >= 1.6 - -executable bm - main-is: Benchmark.hs - - build-depends: - base < 5, - criterion, - mersenne-random, - mwc-random, - random diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/changelog.md new/mwc-random-0.14.0.0/changelog.md --- old/mwc-random-0.13.6.0/changelog.md 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/changelog.md 2018-07-11 18:23:47.000000000 +0200 @@ -1,8 +1,19 @@ +## Changes in 0.14.0.0 + + * Low level functions for acquiring random data for initialization + of PRGN state is moved to `System.Random.MWC.SeedSource` module + + * Ensure that carry is always correct when restoring PRNG state from + seed. Only affects users who create 258 element seed manually. + (#63, #65) + + ## Changes in 0.13.6.0 * `tablePoisson` now can handle λ>1923, see #59 for details. That required intoduction of dependency on math-functions. + ## Changes in 0.13.5.0 * `logCategorical` added diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/mwc-random.cabal new/mwc-random-0.14.0.0/mwc-random.cabal --- old/mwc-random-0.13.6.0/mwc-random.cabal 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/mwc-random.cabal 2018-07-11 18:23:47.000000000 +0200 @@ -1,5 +1,5 @@ name: mwc-random -version: 0.13.6.0 +version: 0.14.0.0 synopsis: Fast, high quality pseudo random number generation description: This package contains code for generating high quality random @@ -28,56 +28,20 @@ extra-source-files: changelog.md README.markdown - benchmarks/*.hs - benchmarks/Quickie.hs - benchmarks/mwc-random-benchmarks.cabal - test/*.R - test/*.sh - test/visual.hs library - exposed-modules: - System.Random.MWC - System.Random.MWC.Distributions - System.Random.MWC.CondensedTable - build-depends: - base < 5, - primitive, - time, - vector >= 0.7, - math-functions >= 0.2.1.0 - if impl(ghc >= 6.10) - build-depends: - base >= 4 + exposed-modules: System.Random.MWC + System.Random.MWC.Distributions + System.Random.MWC.CondensedTable + System.Random.MWC.SeedSource + build-depends: base >= 4.5 && < 5 + , primitive >= 0.6 + , time + , vector >= 0.7 + , math-functions >= 0.2.1.0 - -- gather extensive profiling data for now - ghc-prof-options: -auto-all + ghc-options: -Wall -funbox-strict-fields -fwarn-tabs - ghc-options: -Wall -funbox-strict-fields - if impl(ghc >= 6.8) - ghc-options: -fwarn-tabs - -test-suite tests - buildable: False - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: tests.hs - other-modules: KS - QC - - ghc-options: - -Wall -threaded -rtsopts - - build-depends: - vector >= 0.7, - HUnit, - QuickCheck, - base, - mwc-random, - statistics >= 0.10.1.0, - test-framework, - test-framework-hunit, - test-framework-quickcheck2 source-repository head type: git diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/test/KS.hs new/mwc-random-0.14.0.0/test/KS.hs --- old/mwc-random-0.13.6.0/test/KS.hs 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/test/KS.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,54 +0,0 @@ --- Kolmogorov-Smirnov tests for distribution --- --- Note that it's not most powerful test for normality. -module KS ( - tests - ) where - -import qualified Data.Vector.Unboxed as U - -import Statistics.Test.KolmogorovSmirnov - -import Statistics.Distribution -import Statistics.Distribution.Binomial -import Statistics.Distribution.Exponential -import Statistics.Distribution.Gamma -import Statistics.Distribution.Normal -import Statistics.Distribution.Uniform -import Statistics.Distribution.Beta - -import qualified System.Random.MWC as MWC -import qualified System.Random.MWC.Distributions as MWC - -import Test.HUnit hiding (Test) -import Test.Framework -import Test.Framework.Providers.HUnit - - -tests :: MWC.GenIO -> Test -tests g = testGroup "Kolmogorov-Smirnov" - [ testCase "standard" $ testKS standard MWC.standard g - , testCase "normal m=1 s=2" $ testKS (normalDistr 1 2) (MWC.normal 1 2) g - -- Gamma distribution - , testCase "gamma k=1 θ=1" $ testKS (gammaDistr 1 1 ) (MWC.gamma 1 1 ) g - , testCase "gamma k=0.3 θ=0.4" $ testKS (gammaDistr 0.3 0.4) (MWC.gamma 0.3 0.4) g - , testCase "gamma k=0.3 θ=3" $ testKS (gammaDistr 0.3 3 ) (MWC.gamma 0.3 3 ) g - , testCase "gamma k=3 θ=0.4" $ testKS (gammaDistr 3 0.4) (MWC.gamma 3 0.4) g - , testCase "gamma k=3 θ=3" $ testKS (gammaDistr 3 3 ) (MWC.gamma 3 3 ) g - -- Uniform - , testCase "uniform -2 .. 3" $ testKS (uniformDistr (-2) 3) (MWC.uniformR (-2,3)) g - -- Exponential - , testCase "exponential l=1" $ testKS (exponential 1) (MWC.exponential 1) g - , testCase "exponential l=3" $ testKS (exponential 3) (MWC.exponential 3) g - -- Beta - , testCase "beta a=0.3,b=0.5" $ testKS (betaDistr 0.3 0.5) (MWC.beta 0.3 0.5) g - , testCase "beta a=0.1,b=0.8" $ testKS (betaDistr 0.3 0.5) (MWC.beta 0.3 0.5) g - , testCase "beta a=0.8,b=0.1" $ testKS (betaDistr 0.3 0.5) (MWC.beta 0.3 0.5) g - ] - -testKS :: (Distribution d) => d -> (MWC.GenIO -> IO Double) -> MWC.GenIO -> IO () -testKS distr generator g = do - sample <- U.replicateM 1000 (generator g) - case kolmogorovSmirnovTest distr 0.01 sample of - Significant -> assertFailure "KS test failed" - NotSignificant -> return () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/test/QC.hs new/mwc-random-0.14.0.0/test/QC.hs --- old/mwc-random-0.13.6.0/test/QC.hs 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/test/QC.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,56 +0,0 @@ --- QC tests for random number generators --- --- Require QuickCheck >= 2.2 -module QC ( - tests - ) where - -import Control.Applicative - -import Data.Word (Word8,Word16,Word32,Word64,Word) -import Data.Int (Int8, Int16, Int32, Int64 ) - -import Test.QuickCheck -import Test.QuickCheck.Monadic -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import System.Random.MWC - - - ----------------------------------------------------------------- - -tests :: GenIO -> Test -tests g = testGroup "Range" - [ testProperty "Int8" $ (prop_InRange g :: InRange Int8) - , testProperty "Int16" $ (prop_InRange g :: InRange Int16) - , testProperty "Int32" $ (prop_InRange g :: InRange Int32) - , testProperty "Int64" $ (prop_InRange g :: InRange Int64) - , testProperty "Word8" $ (prop_InRange g :: InRange Word8) - , testProperty "Word16" $ (prop_InRange g :: InRange Word16) - , testProperty "Word32" $ (prop_InRange g :: InRange Word32) - , testProperty "Word64" $ (prop_InRange g :: InRange Word64) - , testProperty "Int" $ (prop_InRange g :: InRange Int) - , testProperty "Word64" $ (prop_InRange g :: InRange Word) - , testProperty "Float" $ (prop_InRange g :: InRange Float) - , testProperty "Double" $ (prop_InRange g :: InRange Double) - ] - - - ----------------------------------------------------------------- - --- Test that values generated with uniformR never lie outside range. -prop_InRange :: (Variate a, Ord a,Num a) => GenIO -> OrderedPair a -> Property -prop_InRange g (OrderedPair (x1,x2)) = monadicIO $ do - r <- run $ uniformR (x1,x2) g - assert (x1 <= r && r <= x2) - -type InRange a = OrderedPair a -> Property - --- Ordered pair (x,y) for which x <= y -newtype OrderedPair a = OrderedPair (a,a) - deriving Show -instance (Ord a, Arbitrary a) => Arbitrary (OrderedPair a) where - arbitrary = OrderedPair <$> suchThat arbitrary (uncurry (<=)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/test/run-dieharder-test.sh new/mwc-random-0.14.0.0/test/run-dieharder-test.sh --- old/mwc-random-0.13.6.0/test/run-dieharder-test.sh 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/test/run-dieharder-test.sh 1970-01-01 01:00:00.000000000 +0100 @@ -1,26 +0,0 @@ -#!/bin/sh -# -# Run dieharder set of tests for PRNG. All command line parameters are -# passed directly to the dieharder. If no parameters are given -a flag -# is passed which runs all available tests. Full list of dieharder -# options is available at dieharder manpage -# -# NOTE: -# Full set of test require a lot of time to complete. From several -# hours to a few days depending on CPU speed and thoroughness -# settings. -# -# dieharder-source.hs is enthropy source for this test. -# -# This test require dieharder to be installed. It is available at: -# http://www.phy.duke.edu/~rgb/General/dieharder.php - -which dieharder > /dev/null || { echo "dieharder is not found. Aborting"; exit 1; } - -ghc -fforce-recomp -O2 diehard-source -( - date - ./diehard-source | \ - if [ $# = 0 ]; then dieharder -a -g 200; else dieharder "$@" -g 200; fi - date -) | tee diehard.log diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/test/tests.hs new/mwc-random-0.14.0.0/test/tests.hs --- old/mwc-random-0.13.6.0/test/tests.hs 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/test/tests.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,16 +0,0 @@ -import Test.Framework (defaultMain) -import System.Random.MWC (withSystemRandom) - -import qualified QC -import qualified ChiSquare -import qualified KS - - -main :: IO () -main = - withSystemRandom $ \g -> - defaultMain - [ QC.tests g - , ChiSquare.tests g - , KS.tests g - ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/test/visual.R new/mwc-random-0.14.0.0/test/visual.R --- old/mwc-random-0.13.6.0/test/visual.R 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/test/visual.R 1970-01-01 01:00:00.000000000 +0100 @@ -1,105 +0,0 @@ -# Ugly script for displaying distributions alogside with theoretical -# distribution. - - -view.dumps <- function() { - # Load random data from dist - load.d <- function(name) read.table(name)[,1] - # Plots for continous distribution - plot.d <- function(name, dens, rng) { - smp <- load.d( name ) - plot( density(smp), xlim=rng, main=name, col='blue', lwd=2) - hist( smp, probability=TRUE, breaks=100, add=TRUE) - plot( dens, xlim=rng, col='red', add=TRUE, lwd=2) - } - # plots for discrete distribution - plot.ds <- function( name, xs, prob) { - smp <- load.d( name ) - h <- hist( smp, - breaks = c( max(xs) + 0.5, xs - 0.5), - freq=FALSE, main = name - ) - dh <- sqrt( h$count ) / max( 1, sum( h$count ) ) - arrows( xs, h$density + dh, - xs, h$density - dh, - angle=90, code=3, length=0.2 ) - points( xs, prob(xs), pch='0', col='red', type='b') - } - ################################################################ - # Normal - plot.d ("distr/normal-0-1", - function(x) dnorm( x, 0, 1 ), - c(-4,4) ) - readline() - # - plot.d ("distr/normal-1-2", - function(x) dnorm( x, 1, 2 ), - c(-6,8) ) - readline(); - - ################################################################ - # Gamma - plot.d ("distr/gamma-1.0-1.0", - function(x) dgamma( x, 1, 1 ), - c(-1,8) ) - readline(); - # - plot.d ("distr/gamma-0.3-0.4", - function(x) dgamma( x, 0.3, scale=0.4 ), - c(-0.25,2) ) - readline(); - # - plot.d ("distr/gamma-0.3-3.0", - function(x) dgamma( x, 0.3, scale=3.0 ), - c(-1,5) ) - readline(); - # - plot.d ("distr/gamma-3.0-0.4", - function(x) dgamma( x, 3.0, scale=0.4 ), - c(-1,6) ) - readline(); - # - plot.d ("distr/gamma-3.0-3.0", - function(x) dgamma( x, 3.0, scale=3.0 ), - c(-1,32) ) - readline(); - ################################################################ - # Exponential - plot.d ("distr/exponential-1", - function(x) dexp(x,1), - c(-0.5, 9) ) - readline() - # - plot.d ("distr/exponential-3", - function(x) dexp(x,3), - c(-0.5, 3) ) - readline() - ################################################################ - # Poisson - plot.ds( "distr/poisson-0.1", 0:6, function(x) dpois(x, lambda=0.1) ) - readline() - # - plot.ds( "distr/poisson-1.0", 0:10, function(x) dpois(x, lambda=1.0) ) - readline() - # - plot.ds( "distr/poisson-4.5", 0:20, function(x) dpois(x, lambda=4.5) ) - readline() - # - plot.ds( "distr/poisson-30", 0:100, function(x) dpois(x, lambda=30) ) - readline() - # - ################################################################ - # Binomial - plot.ds( "distr/binom-4-0.5", 0:4, function(x) dbinom(x, 4, 0.5) ) - readline() - # - plot.ds( "distr/binom-10-0.1", 0:10, function(x) dbinom(x, 10, 0.1) ) - readline() - # - plot.ds( "distr/binom-10-0.6", 0:10, function(x) dbinom(x, 10, 0.6) ) - readline() - # - plot.ds( "distr/binom-10-0.8", 0:10, function(x) dbinom(x, 10, 0.8) ) - readline() - # -} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/mwc-random-0.13.6.0/test/visual.hs new/mwc-random-0.14.0.0/test/visual.hs --- old/mwc-random-0.13.6.0/test/visual.hs 2017-04-27 14:54:49.000000000 +0200 +++ new/mwc-random-0.14.0.0/test/visual.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,44 +0,0 @@ --- Generates samples of value for display with visual.R -import Control.Monad - -import System.Directory (createDirectoryIfMissing,setCurrentDirectory) -import System.IO - -import qualified System.Random.MWC as MWC -import qualified System.Random.MWC.Distributions as MWC -import qualified System.Random.MWC.CondensedTable as MWC - - -dumpSample :: Show a => Int -> FilePath -> IO a -> IO () -dumpSample n fname gen = - withFile fname WriteMode $ \h -> - replicateM_ n (hPutStrLn h . show =<< gen) - -main :: IO () -main = MWC.withSystemRandom $ \g -> do - let n = 30000 - dir = "distr" - createDirectoryIfMissing True dir - setCurrentDirectory dir - -- Normal - dumpSample n "normal-0-1" $ MWC.normal 0 1 g - dumpSample n "normal-1-2" $ MWC.normal 1 2 g - -- Gamma - dumpSample n "gamma-1.0-1.0" $ MWC.gamma 1.0 1.0 g - dumpSample n "gamma-0.3-0.4" $ MWC.gamma 0.3 0.4 g - dumpSample n "gamma-0.3-3.0" $ MWC.gamma 0.3 3.0 g - dumpSample n "gamma-3.0-0.4" $ MWC.gamma 3.0 0.4 g - dumpSample n "gamma-3.0-3.0" $ MWC.gamma 3.0 3.0 g - -- Exponential - dumpSample n "exponential-1" $ MWC.exponential 1 g - dumpSample n "exponential-3" $ MWC.exponential 3 g - -- Poisson - dumpSample n "poisson-0.1" $ MWC.genFromTable (MWC.tablePoisson 0.1) g - dumpSample n "poisson-1.0" $ MWC.genFromTable (MWC.tablePoisson 1.0) g - dumpSample n "poisson-4.5" $ MWC.genFromTable (MWC.tablePoisson 4.5) g - dumpSample n "poisson-30" $ MWC.genFromTable (MWC.tablePoisson 30) g - -- Binomial - dumpSample n "binom-4-0.5" $ MWC.genFromTable (MWC.tableBinomial 4 0.5) g - dumpSample n "binom-10-0.1" $ MWC.genFromTable (MWC.tableBinomial 10 0.1) g - dumpSample n "binom-10-0.6" $ MWC.genFromTable (MWC.tableBinomial 10 0.6) g - dumpSample n "binom-10-0.8" $ MWC.genFromTable (MWC.tableBinomial 10 0.8) g