From a63f4727b72b848bd4c54904e8da27e573c36595 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 28 Jul 2023 00:58:01 +0200 Subject: [PATCH] Add `uniformListRM`, `uniformList`, `uniformListR`, `uniforms` and `uniformRs` Cleanup and improve tests a bit --- CHANGELOG.md | 1 + src/System/Random.hs | 84 +++++++++++++++++++++++++++++++++++ src/System/Random/Internal.hs | 39 +++++++++++++++- src/System/Random/Stateful.hs | 23 +++------- test/Spec.hs | 48 ++++++++++++-------- 5 files changed, 158 insertions(+), 37 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 412a7b5a..47a38b33 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/src/System/Random.hs b/src/System/Random.hs index 9290d242..a21a27c8 100644 --- a/src/System/Random.hs +++ b/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. -- diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 4c87f18b..facc6eac 100644 --- a/src/System/Random/Internal.hs +++ b/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 diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index 20474cc6..c3d1372f 100644 --- a/src/System/Random/Stateful.hs +++ b/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 = diff --git a/test/Spec.hs b/test/Spec.hs index 95f139ad..b16c66fd 100644 --- a/test/Spec.hs +++ b/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) -