Add functions for generating lists with uniform elements

CHANGELOG.md

@@ -1,5 +1,6 @@
 # 1.3.0
 
+* Add `uniformListRM`, `uniformList`, `uniformListR`, `uniforms` and `uniformRs`: [#154](https://github.com/haskell/random/pull/154)
 * Add compatibility with recently added `ByteArray` to `base`:
   [#153](https://github.com/haskell/random/pull/153)
   * Switch to using `ByteArray` for type class implementation instead of

src/System/Random.hs

@@ -37,6 +37,12 @@ module System.Random
   , UniformRange
   , Finite
   -- * Generators for sequences of pseudo-random bytes
+  -- ** Lists
+  , uniforms
+  , uniformRs
+  , uniformList
+  , uniformListR
+  -- ** Bytes
   , uniformByteArray
   , uniformByteString
   , uniformFillMutableByteArray
@@ -204,6 +210,84 @@ uniformR :: (UniformRange a, RandomGen g) => (a, a) -> g -> (a, g)
 uniformR r g = runStateGen g (uniformRM r)
 {-# INLINE uniformR #-}
 
+-- | Produce an infinite list of pseudo-random values. Integrates nicely with list
+-- fusion. Naturally, there is no way to recover the final generator, therefore either use
+-- `split` before calling `uniforms` or use `uniformList` instead.
+--
+-- Similar to `randoms`, except it relies on `Uniform` type class instead of `Random`
+--
+-- ====__Examples__
+--
+-- >>> let gen = mkStdGen 2023
+-- >>> import Data.Word (Word16)
+-- >>> take 5 $ uniforms gen :: [Word16]
+-- [56342,15850,25292,14347,13919]
+--
+-- @since 1.3.0
+uniforms :: (Uniform a, RandomGen g) => g -> [a]
+uniforms g0 =
+  build $ \cons _nil ->
+    let go g =
+          case uniform g of
+            (x, g') -> x `seq` (x `cons` go g')
+     in go g0
+{-# INLINE uniforms #-}
+
+-- | Produce an infinite list of pseudo-random values in a specified range. Same as
+-- `uniforms`, integrates nicely with list fusion. There is no way to recover the final
+-- generator, therefore either use `split` before calling `uniformRs` or use
+-- `uniformListR` instead.
+--
+-- Similar to `randomRs`, except it relies on `UniformRange` type class instead of
+-- `Random`.
+--
+-- ====__Examples__
+--
+-- >>> let gen = mkStdGen 2023
+-- >>> take 5 $ uniformRs (10, 100) gen :: [Int]
+-- [32,86,21,57,39]
+--
+-- @since 1.3.0
+uniformRs :: (UniformRange a, RandomGen g) => (a, a) -> g -> [a]
+uniformRs range g0 =
+  build $ \cons _nil ->
+    let go g =
+          case uniformR range g of
+            (x, g') -> x `seq` (x `cons` go g')
+     in go g0
+{-# INLINE uniformRs #-}
+
+-- | Produce a list of the supplied length with elements generated uniformly.
+--
+-- See `uniformListM` for a stateful counterpart.
+--
+-- ====__Examples__
+--
+-- >>> let gen = mkStdGen 2023
+-- >>> import Data.Word (Word16)
+-- >>> uniformList 5 gen :: ([Word16], StdGen)
+-- ([56342,15850,25292,14347,13919],StdGen {unStdGen = SMGen 6446154349414395371 1920468677557965761})
+--
+-- @since 1.3.0
+uniformList :: (Uniform a, RandomGen g) => Int -> g -> ([a], g)
+uniformList n g = runStateGen g (uniformListM n)
+{-# INLINE uniformList #-}
+
+-- | Produce a list of the supplied length with elements generated uniformly.
+--
+-- See `uniformListM` for a stateful counterpart.
+--
+-- ====__Examples__
+--
+-- >>> let gen = mkStdGen 2023
+-- >>> uniformListR 10 (20, 30) gen :: ([Int], StdGen)
+-- ([26,30,27,24,30,25,27,21,27,27],StdGen {unStdGen = SMGen 12965503083958398648 1920468677557965761})
+--
+-- @since 1.3.0
+uniformListR :: (UniformRange a, RandomGen g) => Int -> (a, a) -> g -> ([a], g)
+uniformListR n r g = runStateGen g (uniformListRM n r)
+{-# INLINE uniformListR #-}
+
 -- | Generates a 'ByteString' of the specified size using a pure pseudo-random
 -- number generator. See 'uniformByteStringM' for the monadic version.
 --

src/System/Random/Internal.hs

@@ -60,6 +60,8 @@ module System.Random.Internal
   , uniformFloatPositive01M
   , uniformEnumM
   , uniformEnumRM
+  , uniformListM
+  , uniformListRM
 
   -- * Generators for sequences of pseudo-random bytes
   , uniformByteStringM
@@ -80,7 +82,7 @@ module System.Random.Internal
 
 import Control.Arrow
 import Control.DeepSeq (NFData)
-import Control.Monad (when, (>=>))
+import Control.Monad (replicateM, when, (>=>))
 import Control.Monad.Cont (ContT, runContT)
 import Control.Monad.Identity (IdentityT (runIdentityT))
 import Control.Monad.ST
@@ -810,6 +812,38 @@ runStateGenST_ g action = runST $ runStateGenT_ g action
 {-# INLINE runStateGenST_ #-}
 
 
+-- | Generates a list of pseudo-random values.
+--
+-- ====__Examples__
+--
+-- >>> import System.Random.Stateful
+-- >>> let pureGen = mkStdGen 137
+-- >>> g <- newIOGenM pureGen
+-- >>> uniformListM 10 g :: IO [Bool]
+-- [True,True,True,True,False,True,True,False,False,False]
+--
+-- @since 1.2.0
+uniformListM :: (StatefulGen g m, Uniform a) => Int -> g -> m [a]
+uniformListM n gen = replicateM n (uniformM gen)
+{-# INLINE uniformListM #-}
+
+
+-- | Generates a list of pseudo-random values in a specified range.
+--
+-- ====__Examples__
+--
+-- >>> import System.Random.Stateful
+-- >>> let pureGen = mkStdGen 137
+-- >>> g <- newIOGenM pureGen
+-- >>> uniformListRM 10 (20, 30) g :: IO [Int]
+-- [23,21,28,25,28,28,26,25,29,27]
+--
+-- @since 1.3.0
+uniformListRM :: (StatefulGen g m, UniformRange a) => Int -> (a, a) -> g -> m [a]
+uniformListRM n range gen = replicateM n (uniformRM range gen)
+{-# INLINE uniformListRM #-}
+
+
 -- | The standard pseudo-random number generator.
 newtype StdGen = StdGen { unStdGen :: SM.SMGen }
   deriving (Show, RandomGen, NFData)
@@ -964,10 +998,11 @@ class UniformRange a where
   -- >>> :set -XDeriveGeneric -XDeriveAnyClass
   -- >>> import GHC.Generics (Generic)
   -- >>> import Data.Word (Word8)
+  -- >>> import Control.Monad (replicateM)
   -- >>> import System.Random.Stateful
   -- >>> gen <- newIOGenM (mkStdGen 42)
   -- >>> data Tuple = Tuple Bool Word8 deriving (Show, Generic, UniformRange)
-  -- >>> Control.Monad.replicateM 10 (uniformRM (Tuple False 100, Tuple True 150) gen)
+  -- >>> replicateM 10 (uniformRM (Tuple False 100, Tuple True 150) gen)
   -- [Tuple False 102,Tuple True 118,Tuple False 115,Tuple True 113,Tuple True 126,Tuple False 127,Tuple True 130,Tuple False 113,Tuple False 150,Tuple False 125]
   --
   -- @since 1.2.0

src/System/Random/Stateful.hs

@@ -90,10 +90,13 @@ module System.Random.Stateful
   -- * Pseudo-random values of various types
   -- $uniform
   , Uniform(..)
-  , uniformListM
   , uniformViaFiniteM
   , UniformRange(..)
 
+  -- ** Lists
+  , uniformListM
+  , uniformListRM
+
   -- ** Generators for sequences of pseudo-random bytes
   , uniformByteArrayM
   , uniformByteStringM
@@ -127,7 +130,6 @@ module System.Random.Stateful
   ) where
 
 import Control.DeepSeq
-import Control.Monad (replicateM)
 import Control.Monad.IO.Class
 import Control.Monad.ST
 import GHC.Conc.Sync (STM, TVar, newTVar, newTVarIO, readTVar, writeTVar)
@@ -170,6 +172,7 @@ import System.Random.Internal
 -- can run this probabilistic computation using
 -- [@mwc-random@](https://hackage.haskell.org/package/mwc-random) as follows:
 --
+-- >>> import Control.Monad (replicateM)
 -- >>> :{
 -- let rollsM :: StatefulGen g m => Int -> g -> m [Word]
 --     rollsM n = replicateM n . uniformRM (1, 6)
@@ -297,20 +300,6 @@ withMutableGen_ :: ThawedGen f m => f -> (MutableGen f m -> m a) -> m a
 withMutableGen_ fg action = thawGen fg >>= action
 
 
--- | Generates a list of pseudo-random values.
---
--- ====__Examples__
---
--- >>> import System.Random.Stateful
--- >>> let pureGen = mkStdGen 137
--- >>> g <- newIOGenM pureGen
--- >>> uniformListM 10 g :: IO [Bool]
--- [True,True,True,True,False,True,True,False,False,False]
---
--- @since 1.2.0
-uniformListM :: (StatefulGen g m, Uniform a) => Int -> g -> m [a]
-uniformListM n gen = replicateM n (uniformM gen)
-
 -- | Generates a pseudo-random value using monadic interface and `Random` instance.
 --
 -- ====__Examples__
@@ -380,6 +369,7 @@ newAtomicGenM = fmap AtomicGenM . liftIO . newIORef
 -- | Global mutable standard pseudo-random number generator. This is the same
 -- generator that was historically used by `randomIO` and `randomRIO` functions.
 --
+-- >>> import Control.Monad (replicateM)
 -- >>> replicateM 10 (uniformRM ('a', 'z') globalStdGen)
 -- "tdzxhyfvgr"
 --
@@ -837,6 +827,7 @@ applyTGen f (TGenM tvar) = do
 -- generator and produces a short list with random even integers.
 --
 -- >>> import Data.Int (Int8)
+-- >>> import Control.Monad (replicateM)
 -- >>> :{
 -- myCustomRandomList :: ThawedGen f m => f -> m [Int8]
 -- myCustomRandomList f =

test/Spec.hs

@@ -116,8 +116,8 @@ floatTests = testGroup "(Float)"
     "Does not contain 1.0e-45"
   ]
 
-showsType :: forall t . Typeable t => Proxy t -> ShowS
-showsType px = showsTypeRep (typeRep px)
+showType :: forall t . Typeable t => Proxy t -> String
+showType px = show (typeRep px)
 
 byteStringSpec :: TestTree
 byteStringSpec =
@@ -171,7 +171,7 @@ rangeSpec ::
      (SC.Serial IO a, Typeable a, Ord a, UniformRange a, Show a)
   => Proxy a -> TestTree
 rangeSpec px =
-  testGroup ("Range (" ++ showsType px ")")
+  testGroup ("Range " ++ showType px)
   [ SC.testProperty "uniformR" $ seeded $ Range.uniformRangeWithin px
   ]
 
@@ -180,7 +180,7 @@ integralSpec ::
      (SC.Serial IO a, Typeable a, Ord a, UniformRange a, Show a)
   => Proxy a -> TestTree
 integralSpec px =
-  testGroup ("(" ++ showsType px ")")
+  testGroup (showType px)
   [ SC.testProperty "symmetric" $ seeded $ Range.symmetric px
   , SC.testProperty "bounded" $ seeded $ Range.bounded px
   , SC.testProperty "singleton" $ seeded $ Range.singleton px
@@ -199,7 +199,7 @@ floatingSpec ::
      (SC.Serial IO a, Typeable a, Num a, Ord a, Random a, UniformRange a, Read a, Show a)
   => Proxy a -> TestTree
 floatingSpec px =
-  testGroup ("(" ++ showsType px ")")
+  testGroup (showType px)
   [ SC.testProperty "uniformR" $ seeded $ Range.uniformRangeWithin px
   , testCase "r = +inf, x = 0" $ positiveInf @?= fst (uniformR (0, positiveInf) (ConstGen 0))
   , testCase "r = +inf, x = 1" $ positiveInf @?= fst (uniformR (0, positiveInf) (ConstGen 1))
@@ -218,30 +218,41 @@ randomSpec ::
   => Proxy a -> TestTree
 randomSpec px =
   testGroup
-    ("Random " ++ showsType px ")")
+    ("Random " ++ showType px)
     [ SC.testProperty "randoms" $
       seededWithLen $ \len g ->
         take len (randoms g :: [a]) == runStateGen_ g (replicateM len . randomM)
     , SC.testProperty "randomRs" $
       seededWithLen $ \len g ->
         case random g of
-          (l, g') ->
-            case random g' of
-              (h, g'') ->
-                take len (randomRs (l, h) g'' :: [a]) ==
-                runStateGen_ g'' (replicateM len . randomRM (l, h))
+          (range, g') ->
+             take len (randomRs range g' :: [a]) ==
+               runStateGen_ g' (replicateM len . randomRM range)
     ]
 
 uniformSpec ::
      forall a.
-     (Typeable a, Eq a, Random a, Uniform a, Show a)
+     (Typeable a, Eq a, Random a, Uniform a, UniformRange a, Show a)
   => Proxy a -> TestTree
 uniformSpec px =
   testGroup
-    ("Uniform " ++ showsType px ")")
-    [ SC.testProperty "uniformListM" $
+    ("Uniform " ++ showType px)
+    [ SC.testProperty "uniformList" $
       seededWithLen $ \len g ->
-        take len (randoms g :: [a]) == runStateGen_ g (uniformListM len)
+        take len (randoms g :: [a]) == fst (uniformList len g)
+    , SC.testProperty "uniformListR" $
+      seededWithLen $ \len g ->
+        case uniform g of
+          (range, g') ->
+            take len (randomRs range g' :: [a]) == fst (uniformListR len range g')
+    , SC.testProperty "uniforms" $
+      seededWithLen $ \len g ->
+        take len (randoms g :: [a]) == take len (uniforms g)
+    , SC.testProperty "uniformRs" $
+      seededWithLen $ \len g ->
+        case uniform g of
+          (range, g') ->
+            take len (randomRs range g' :: [a]) == take len (uniformRs range g')
     ]
 
 runSpec :: TestTree
@@ -252,10 +263,10 @@ runSpec = testGroup "runStateGen_ and runPrimGenIO_"
 seeded :: (StdGen -> a) -> Int -> a
 seeded f = f . mkStdGen
 
--- | Same as `seeded`, but also produces a length in range 0-255 suitable for generating
+-- | Same as `seeded`, but also produces a length in range 0-65535 suitable for generating
 -- lists and such
-seededWithLen :: (Int -> StdGen -> a) -> Word8 -> Int -> a
-seededWithLen f w8 = seeded (f (fromIntegral w8))
+seededWithLen :: (Int -> StdGen -> a) -> Word16 -> Int -> a
+seededWithLen f w16 = seeded (f (fromIntegral w16))
 
 data MyBool = MyTrue | MyFalse
   deriving (Eq, Ord, Show, Generic, Finite, Uniform)
@@ -293,4 +304,3 @@ instance Uniform Colors where
 instance UniformRange Colors where
   uniformRM = uniformEnumRM
   isInRange (lo, hi) x = isInRange (fromEnum lo, fromEnum hi) (fromEnum x)
-