From 9d23cd411bcbd95e77eeeb49e477efb8b1961074 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Mon, 8 Jun 2020 22:46:43 +0300 Subject: [PATCH 01/11] Add function for generating Float/Double in [0,1] range There're functions for Float and Double. They come in two variants: one that sample in [0,1] interval and one that samples in (0,1]. Former allows to save few floating poit operations when one needs values in [0,1] range. Which is very commonly used primitive Latter isimportant when output of generator is fed into function which not defined at 0. This is again very common. For Float sampling zero is feasible. For Double it's improbable but could in principle happen in bad generator/seed combo, or for malicious generator inicialization. --- src/System/Random/Internal.hs | 49 +++++++++++++++++++++++------------ src/System/Random/Stateful.hs | 4 +++ 2 files changed, 37 insertions(+), 16 deletions(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 556e86cb0..a7a66aa32 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -51,6 +51,10 @@ module System.Random.Internal , Uniform(..) , UniformRange(..) , uniformByteString + , uniformDouble01M + , uniformDoublePos01M + , uniformFloat01M + , uniformFloatPos01M -- * Generators for sequences of pseudo-random bytes , genShortByteStringIO @@ -709,34 +713,47 @@ instance UniformRange Bool where -- | See /Floating point number caveats/ in "System.Random.Stateful". instance UniformRange Double where uniformRM (l, h) g = do - w64 <- uniformWord64 g - let x = word64ToDoubleInUnitInterval w64 + x <- uniformDouble01M g return $ (h - l) * x + l --- | Turns a given uniformly distributed 'Word64' value into a uniformly --- distributed 'Double' value in the range [0, 1]. -word64ToDoubleInUnitInterval :: Word64 -> Double -word64ToDoubleInUnitInterval w64 = d / m +-- | Generate uniformly distributed 'Double' in the range [0, 1]. +uniformDouble01M :: StatefulGen g m => g -> m Double +uniformDouble01M g = do + w64 <- uniformWord64 g + return $ fromIntegral w64 / m where - d = fromIntegral w64 :: Double m = fromIntegral (maxBound :: Word64) :: Double -{-# INLINE word64ToDoubleInUnitInterval #-} + +-- | Generate uniformly distributed 'Double' in the range (0, 1]. That +-- is result is guaranteed to be positive +uniformDoublePos01M :: StatefulGen g m => g -> m Double +uniformDoublePos01M g = (+ d) <$> uniformDouble01M g + where + -- We add small constant to shift generated value from zero. It's + -- selected as 1/2 of smallest possible nonzero value + d = 2.710505431213761e-20 -- 2**(-65) -- | See /Floating point number caveats/ in "System.Random.Stateful". instance UniformRange Float where uniformRM (l, h) g = do - w32 <- uniformWord32 g - let x = word32ToFloatInUnitInterval w32 + x <- uniformFloat01M g return $ (h - l) * x + l --- | Turns a given uniformly distributed 'Word32' value into a uniformly --- distributed 'Float' value in the range [0,1]. -word32ToFloatInUnitInterval :: Word32 -> Float -word32ToFloatInUnitInterval w32 = f / m +-- | Generate uniformly distributed 'Float' in the range [0, 1]. +uniformFloat01M :: StatefulGen g m => g -> m Float +uniformFloat01M g = do + w32 <- uniformWord32 g + return $ fromIntegral w32 / m where - f = fromIntegral w32 :: Float m = fromIntegral (maxBound :: Word32) :: Float -{-# INLINE word32ToFloatInUnitInterval #-} + +-- | Generate uniformly distributed 'Float' in the range (0, 1]. That +-- is result is guaranteed to be positive. +uniformFloatPos01M :: StatefulGen g m => g -> m Float +uniformFloatPos01M g = (+ d) <$> uniformFloat01M g + where + -- See uniformDoublePos01M + d = 1.1641532182693481e-10 -- 2**(-33) -- The two integer functions below take an [inclusive,inclusive] range. randomIvalIntegral :: (RandomGen g, Integral a) => (a, a) -> g -> (a, g) diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index 687563f30..5afc5a6ed 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -77,6 +77,10 @@ module System.Random.Stateful , genShortByteStringIO , genShortByteStringST , uniformByteString + , uniformDouble01M + , uniformDoublePos01M + , uniformFloat01M + , uniformFloatPos01M -- * Appendix From 5dcc02202a105049d7047036f9fb59acf8561728 Mon Sep 17 00:00:00 2001 From: Aleksey Khudyakov Date: Tue, 9 Jun 2020 20:05:02 +0300 Subject: [PATCH 02/11] Update src/System/Random/Internal.hs Co-authored-by: Leonhard Markert --- src/System/Random/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index a7a66aa32..2ffdb96c2 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -739,7 +739,7 @@ instance UniformRange Float where x <- uniformFloat01M g return $ (h - l) * x + l --- | Generate uniformly distributed 'Float' in the range [0, 1]. +-- | Generates uniformly distributed 'Float' in the range [0, 1]. uniformFloat01M :: StatefulGen g m => g -> m Float uniformFloat01M g = do w32 <- uniformWord32 g From ab6a1e6873b0226d70f2b9491b42e0b099a09758 Mon Sep 17 00:00:00 2001 From: Aleksey Khudyakov Date: Tue, 9 Jun 2020 20:05:10 +0300 Subject: [PATCH 03/11] Update src/System/Random/Internal.hs Co-authored-by: Leonhard Markert --- src/System/Random/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 2ffdb96c2..c57a6170d 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -716,7 +716,7 @@ instance UniformRange Double where x <- uniformDouble01M g return $ (h - l) * x + l --- | Generate uniformly distributed 'Double' in the range [0, 1]. +-- | Generates uniformly distributed 'Double' in the range [0, 1]. uniformDouble01M :: StatefulGen g m => g -> m Double uniformDouble01M g = do w64 <- uniformWord64 g From 18a222d42e9d1dfe83c2b12268e35dd5fd6096fc Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 9 Jun 2020 20:13:46 +0300 Subject: [PATCH 04/11] Use generates --- src/System/Random/Internal.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index c57a6170d..d615ab4db 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -724,7 +724,7 @@ uniformDouble01M g = do where m = fromIntegral (maxBound :: Word64) :: Double --- | Generate uniformly distributed 'Double' in the range (0, 1]. That +-- | Generates uniformly distributed 'Double' in the range (0, 1]. That -- is result is guaranteed to be positive uniformDoublePos01M :: StatefulGen g m => g -> m Double uniformDoublePos01M g = (+ d) <$> uniformDouble01M g @@ -747,7 +747,7 @@ uniformFloat01M g = do where m = fromIntegral (maxBound :: Word32) :: Float --- | Generate uniformly distributed 'Float' in the range (0, 1]. That +-- | Generates uniformly distributed 'Float' in the range (0, 1]. That -- is result is guaranteed to be positive. uniformFloatPos01M :: StatefulGen g m => g -> m Float uniformFloatPos01M g = (+ d) <$> uniformFloat01M g From fc0c7fbc793793682bd2cd454c53370f0bc10f3e Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 9 Jun 2020 20:15:41 +0300 Subject: [PATCH 05/11] Rename Pos -> Positive --- src/System/Random/Internal.hs | 14 +++++++------- src/System/Random/Stateful.hs | 4 ++-- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index d615ab4db..5a2be88d8 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -52,9 +52,9 @@ module System.Random.Internal , UniformRange(..) , uniformByteString , uniformDouble01M - , uniformDoublePos01M + , uniformDoublePositive01M , uniformFloat01M - , uniformFloatPos01M + , uniformFloatPositive01M -- * Generators for sequences of pseudo-random bytes , genShortByteStringIO @@ -726,8 +726,8 @@ uniformDouble01M g = do -- | Generates uniformly distributed 'Double' in the range (0, 1]. That -- is result is guaranteed to be positive -uniformDoublePos01M :: StatefulGen g m => g -> m Double -uniformDoublePos01M g = (+ d) <$> uniformDouble01M g +uniformDoublePositive01M :: StatefulGen g m => g -> m Double +uniformDoublePositive01M g = (+ d) <$> uniformDouble01M g where -- We add small constant to shift generated value from zero. It's -- selected as 1/2 of smallest possible nonzero value @@ -749,10 +749,10 @@ uniformFloat01M g = do -- | Generates uniformly distributed 'Float' in the range (0, 1]. That -- is result is guaranteed to be positive. -uniformFloatPos01M :: StatefulGen g m => g -> m Float -uniformFloatPos01M g = (+ d) <$> uniformFloat01M g +uniformFloatPositive01M :: StatefulGen g m => g -> m Float +uniformFloatPositive01M g = (+ d) <$> uniformFloat01M g where - -- See uniformDoublePos01M + -- See uniformDoublePositive01M d = 1.1641532182693481e-10 -- 2**(-33) -- The two integer functions below take an [inclusive,inclusive] range. diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index 5afc5a6ed..18400a3e9 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -78,9 +78,9 @@ module System.Random.Stateful , genShortByteStringST , uniformByteString , uniformDouble01M - , uniformDoublePos01M + , uniformDoublePositive01M , uniformFloat01M - , uniformFloatPos01M + , uniformFloatPositive01M -- * Appendix From 1ecb2f729e28d4a4b674981fa1eaa1e6a27593cd Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 9 Jun 2020 20:16:46 +0300 Subject: [PATCH 06/11] Drop positive from haddock --- src/System/Random/Internal.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 5a2be88d8..5ea1fce0c 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -724,8 +724,7 @@ uniformDouble01M g = do where m = fromIntegral (maxBound :: Word64) :: Double --- | Generates uniformly distributed 'Double' in the range (0, 1]. That --- is result is guaranteed to be positive +-- | Generates uniformly distributed 'Double' in the range (0, 1]. uniformDoublePositive01M :: StatefulGen g m => g -> m Double uniformDoublePositive01M g = (+ d) <$> uniformDouble01M g where @@ -747,8 +746,7 @@ uniformFloat01M g = do where m = fromIntegral (maxBound :: Word32) :: Float --- | Generates uniformly distributed 'Float' in the range (0, 1]. That --- is result is guaranteed to be positive. +-- | Generates uniformly distributed 'Float' in the range (0, 1]. uniformFloatPositive01M :: StatefulGen g m => g -> m Float uniformFloatPositive01M g = (+ d) <$> uniformFloat01M g where From 46b8aec23b2df9dea8a20295581c2e9734b24012 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Wed, 10 Jun 2020 21:08:51 +0300 Subject: [PATCH 07/11] Add since pragmas and expand docs for unform{Float,Double}01 --- src/System/Random/Internal.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 5ea1fce0c..490ea215a 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -717,6 +717,11 @@ instance UniformRange Double where return $ (h - l) * x + l -- | Generates uniformly distributed 'Double' in the range [0, 1]. +-- Numbers are generated by generating uniform 'Word64' and dividing +-- it by @2^64@. It's used to implement 'UniformR' instance for +-- 'Double'. +-- +-- @since 1.2.0 uniformDouble01M :: StatefulGen g m => g -> m Double uniformDouble01M g = do w64 <- uniformWord64 g @@ -725,6 +730,8 @@ uniformDouble01M g = do m = fromIntegral (maxBound :: Word64) :: Double -- | Generates uniformly distributed 'Double' in the range (0, 1]. +-- +-- @since 1.2.0 uniformDoublePositive01M :: StatefulGen g m => g -> m Double uniformDoublePositive01M g = (+ d) <$> uniformDouble01M g where @@ -739,6 +746,10 @@ instance UniformRange Float where return $ (h - l) * x + l -- | Generates uniformly distributed 'Float' in the range [0, 1]. +-- Numbers are generated by generating uniform 'Word32' and dividing +-- it by @2^32@. It's used to implement 'UniformR' instance for 'Float' +-- +-- @since 1.2.0 uniformFloat01M :: StatefulGen g m => g -> m Float uniformFloat01M g = do w32 <- uniformWord32 g @@ -747,6 +758,8 @@ uniformFloat01M g = do m = fromIntegral (maxBound :: Word32) :: Float -- | Generates uniformly distributed 'Float' in the range (0, 1]. +-- +-- @since 1.2.0 uniformFloatPositive01M :: StatefulGen g m => g -> m Float uniformFloatPositive01M g = (+ d) <$> uniformFloat01M g where From c5e5fd0499f573741ef661e6f18d1b0240ef90e0 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Sat, 13 Jun 2020 14:42:28 +0300 Subject: [PATCH 08/11] First attempt to add benchmarks for uniformFloat --- bench/Main.hs | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/bench/Main.hs b/bench/Main.hs index caa116dc3..764eb404a 100644 --- a/bench/Main.hs +++ b/bench/Main.hs @@ -185,6 +185,41 @@ main = do !range = (1, n - 1) in pureUniformRBench @Natural range sz ] + , bgroup "floating" + [ bgroup "IO" + [ bench "uniformFloat01M" $ nfIO $ runStateGenT_ (mkStdGen 1337) $ \g -> + replicateM_ sz $ do !_ <- uniformFloat01M g + return () + , bench "uniformFloatPositive01M" $ nfIO $ runStateGenT_ (mkStdGen 1337) $ \g -> + replicateM_ sz $ do !_ <- uniformFloatPositive01M g + return () + , bench "uniformDouble01M" $ nfIO $ runStateGenT_ (mkStdGen 1337) $ \g -> + replicateM_ sz $ do !_ <- uniformDouble01M g + return () + , bench "uniformDoublePositive01M" $ nfIO $ runStateGenT_ (mkStdGen 1337) $ \g -> + replicateM_ sz $ do !_ <- uniformDoublePositive01M g + return () + ] + -- + , bgroup "St" + [ bench "uniformFloat01M" $ nf + (\n -> runStateGen_ (mkStdGen 1337) $ \g -> replicateM_ n $ do !_ <- uniformFloat01M g + return () + ) sz + , bench "uniformFloatPositive01M" $ nf + (\n -> runStateGen_ (mkStdGen 1337) $ \g -> replicateM_ n $ do !_ <- uniformFloatPositive01M g + return () + ) sz + , bench "uniformDouble01M" $ nf + (\n -> runStateGen_ (mkStdGen 1337) $ \g -> replicateM_ n $ do !_ <- uniformDouble01M g + return () + ) sz + , bench "uniformDoublePositive01M" $ nf + (\n -> runStateGen_ (mkStdGen 1337) $ \g -> replicateM_ n $ do !_ <- uniformDoublePositive01M g + return () + ) sz + ] + ] , bgroup "ShortByteString" [ env (pure genLengths) $ \ ~(ns, gen) -> bench "genShortByteString" $ From 27025e08f96ee8445314dab9fdada85514c05433 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Sat, 13 Jun 2020 16:43:42 +0300 Subject: [PATCH 09/11] Describe algorithm for positive variants Also use LaTeX. It looks prettier --- src/System/Random/Internal.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 490ea215a..9301bb390 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -716,9 +716,9 @@ instance UniformRange Double where x <- uniformDouble01M g return $ (h - l) * x + l --- | Generates uniformly distributed 'Double' in the range [0, 1]. +-- | Generates uniformly distributed 'Double' in the range \([0, 1]\). -- Numbers are generated by generating uniform 'Word64' and dividing --- it by @2^64@. It's used to implement 'UniformR' instance for +-- it by \(2^{64}\). It's used to implement 'UniformR' instance for -- 'Double'. -- -- @since 1.2.0 @@ -729,7 +729,9 @@ uniformDouble01M g = do where m = fromIntegral (maxBound :: Word64) :: Double --- | Generates uniformly distributed 'Double' in the range (0, 1]. +-- | Generates uniformly distributed 'Double' in the range +-- \((0, 1]\). Number is generated by adding \(2^{-32}/2\) to the +-- evaluation result of 'uniformDouble01M'. -- -- @since 1.2.0 uniformDoublePositive01M :: StatefulGen g m => g -> m Double @@ -745,9 +747,9 @@ instance UniformRange Float where x <- uniformFloat01M g return $ (h - l) * x + l --- | Generates uniformly distributed 'Float' in the range [0, 1]. +-- | Generates uniformly distributed 'Float' in the range \([0, 1]\). -- Numbers are generated by generating uniform 'Word32' and dividing --- it by @2^32@. It's used to implement 'UniformR' instance for 'Float' +-- it by \(2^{32}\). It's used to implement 'UniformR' instance for 'Float' -- -- @since 1.2.0 uniformFloat01M :: StatefulGen g m => g -> m Float @@ -757,7 +759,9 @@ uniformFloat01M g = do where m = fromIntegral (maxBound :: Word32) :: Float --- | Generates uniformly distributed 'Float' in the range (0, 1]. +-- | Generates uniformly distributed 'Float' in the range +-- \((0, 1]\). Number is generated by adding \(2^{-33}\) to +-- the evaluation result of 'uniformFloat01M'. -- -- @since 1.2.0 uniformFloatPositive01M :: StatefulGen g m => g -> m Float From b1663a719f2b586373d02fd8171cbb612546879d Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Sat, 13 Jun 2020 16:57:25 +0300 Subject: [PATCH 10/11] Add benchmarks for uniformFloat written in same style as rest --- bench/Main.hs | 19 +++++++++++++++++++ random.cabal | 1 + 2 files changed, 20 insertions(+) diff --git a/bench/Main.hs b/bench/Main.hs index 764eb404a..0ac7ce4b0 100644 --- a/bench/Main.hs +++ b/bench/Main.hs @@ -8,6 +8,7 @@ module Main (main) where import Control.Monad +import Control.Monad.State.Strict import Data.Int import Data.Proxy import Data.Typeable @@ -219,6 +220,24 @@ main = do return () ) sz ] + , bgroup "pure" + [ let !stdGen = mkStdGen 1337 + in bench "uniformFloat01M" $ nf + (genMany (runState $ uniformFloat01M (StateGenM @StdGen)) stdGen) + sz + , let !stdGen = mkStdGen 1337 + in bench "uniformFloatPositive01M" $ nf + (genMany (runState $ uniformFloatPositive01M (StateGenM @StdGen)) stdGen) + sz + , let !stdGen = mkStdGen 1337 + in bench "uniformDouble01M" $ nf + (genMany (runState $ uniformDouble01M (StateGenM @StdGen)) stdGen) + sz + , let !stdGen = mkStdGen 1337 + in bench "uniformDoublePositive01M" $ nf + (genMany (runState $ uniformDoublePositive01M (StateGenM @StdGen)) stdGen) + sz + ] ] , bgroup "ShortByteString" [ env (pure genLengths) $ \ ~(ns, gen) -> diff --git a/random.cabal b/random.cabal index d7d9a48cf..add7b005f 100644 --- a/random.cabal +++ b/random.cabal @@ -168,5 +168,6 @@ benchmark bench build-depends: base -any, gauge >=0.2.3 && <0.3, + mtl, random -any, splitmix >=0.1 && <0.2 From d8da39379c44ed50a6fa4a81fe961c6572dfb92f Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Mon, 15 Jun 2020 19:04:37 +0300 Subject: [PATCH 11/11] Update haddock --- src/System/Random/Internal.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 9301bb390..80d936a30 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -730,8 +730,9 @@ uniformDouble01M g = do m = fromIntegral (maxBound :: Word64) :: Double -- | Generates uniformly distributed 'Double' in the range --- \((0, 1]\). Number is generated by adding \(2^{-32}/2\) to the --- evaluation result of 'uniformDouble01M'. +-- \((0, 1]\). Number is generated as \(2^{-64}/2+\operatorname{uniformDouble01M}\). +-- Constant is 1\/2 of smallest nonzero value which could be generated +-- by 'uniformDouble01M'. -- -- @since 1.2.0 uniformDoublePositive01M :: StatefulGen g m => g -> m Double @@ -760,8 +761,9 @@ uniformFloat01M g = do m = fromIntegral (maxBound :: Word32) :: Float -- | Generates uniformly distributed 'Float' in the range --- \((0, 1]\). Number is generated by adding \(2^{-33}\) to --- the evaluation result of 'uniformFloat01M'. +-- \((0, 1]\). Number is generated as \(2^{-32}/2+\operatorname{uniformFloat01M}\). +-- Constant is 1\/2 of smallest nonzero value which could be generated +-- by 'uniformFloat01M'. -- -- @since 1.2.0 uniformFloatPositive01M :: StatefulGen g m => g -> m Float