Add function for generating Float/Double in [0,1] range

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
@@ -185,6 +186,59 @@ 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 "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) ->
               bench "genShortByteString" $

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

src/System/Random/Internal.hs

@@ -51,6 +51,10 @@ module System.Random.Internal
   , Uniform(..)
   , UniformRange(..)
   , uniformByteString
+  , uniformDouble01M
+  , uniformDoublePositive01M
+  , uniformFloat01M
+  , uniformFloatPositive01M
 
   -- * Generators for sequences of pseudo-random bytes
   , genShortByteStringIO
@@ -709,34 +713,62 @@ 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
+-- | 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
+  return $ fromIntegral w64 / m
   where
-    d = fromIntegral w64 :: Double
     m = fromIntegral (maxBound :: Word64) :: Double
-{-# INLINE word64ToDoubleInUnitInterval #-}
+
+-- | 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
+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
+    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
+-- | 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
+  return $ fromIntegral w32 / m
   where
-    f = fromIntegral w32 :: Float
     m = fromIntegral (maxBound :: Word32) :: Float
-{-# INLINE word32ToFloatInUnitInterval #-}
+
+-- | 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
+uniformFloatPositive01M g = (+ d) <$> uniformFloat01M g
+  where
+    -- See uniformDoublePositive01M
+    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)

src/System/Random/Stateful.hs

@@ -77,6 +77,10 @@ module System.Random.Stateful
   , genShortByteStringIO
   , genShortByteStringST
   , uniformByteString
+  , uniformDouble01M
+  , uniformDoublePositive01M
+  , uniformFloat01M
+  , uniformFloatPositive01M
 
   -- * Appendix