diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,15 @@ +0.6.1 (22 October 2024) +----------------------- + +- Fix the potential for a crash in `fromListMay` (and hence also in + functions that use it, namely `fromList`, `weighted`, `weightedMay`, + `uniform`, and `uniformMay`). Thanks to @Flupp for pointing out the + issue and suggesting a fix. The fix may in theory cause these + functions, extremely rarely, to output values different from the old + values for the same seed. See + https://byorgey.github.io/blog/posts/2024/10/14/MonadRandom-version-bump.html + for more information and discussion. + 0.6 (5 Nov 2022) ---------------- @@ -5,12 +17,17 @@ - Allow building with `transformers-0.6` and `mtl-2.3.1` - Drop support for GHC 7.6 and 7.8 +- r1 (18 Dec 2022): require `base >= 4.8` +- r2 (9 Jan 2023): require `random >= 1.0.1` +- r3 (22 Feb 2023): allow `primitive-0.8` +- r4 (12 Oct 2023): allow `primitive-0.9`, test on GHC 9.6 and 9.8 + 0.5.3 (8 April 2021) -------------------- - `StatefulGen` instances for `RandT` - Addition of `RandGen` -- Additioon of `withRandGen` and `withRandGen_` +- Addition of `withRandGen` and `withRandGen_` - r1 (28 April 2021): require `base >= 4.6` - r2 (9 Aug 2021): allow `transformers-compat-0.7`. diff --git a/Control/Monad/Random/Class.hs b/Control/Monad/Random/Class.hs --- a/Control/Monad/Random/Class.hs +++ b/Control/Monad/Random/Class.hs @@ -1,72 +1,68 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE UndecidableInstances #-} - -{- | -Module : Control.Monad.Random.Class -Copyright : (c) Brent Yorgey 2016 -License : BSD3 (see LICENSE) -Maintainer : byorgey@gmail.com - -The 'MonadRandom', 'MonadSplit', and 'MonadInterleave' classes. - -* 'MonadRandom' abstracts over monads with the capability of - generating random values. - -* 'MonadSplit' abstracts over random monads with the ability to get a - split generator state. It is not very useful but kept here for - backwards compatibility. - -* 'MonadInterleave' abstracts over random monads supporting an - 'interleave' operation, which allows sequencing computations which do - not depend on each other's random generator state, by splitting the - generator between them. - -This module also defines convenience functions for sampling from a -given collection of values, either uniformly or according to given -weights. - --} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Safe #-} +{-# LANGUAGE UndecidableInstances #-} +-- | +-- Module : Control.Monad.Random.Class +-- Copyright : (c) Brent Yorgey 2016 +-- License : BSD3 (see LICENSE) +-- Maintainer : byorgey@gmail.com +-- +-- The 'MonadRandom', 'MonadSplit', and 'MonadInterleave' classes. +-- +-- * 'MonadRandom' abstracts over monads with the capability of +-- generating random values. +-- +-- * 'MonadSplit' abstracts over random monads with the ability to get a +-- split generator state. It is not very useful but kept here for +-- backwards compatibility. +-- +-- * 'MonadInterleave' abstracts over random monads supporting an +-- 'interleave' operation, which allows sequencing computations which do +-- not depend on each other's random generator state, by splitting the +-- generator between them. +-- +-- This module also defines convenience functions for sampling from a +-- given collection of values, either uniformly or according to given +-- weights. module Control.Monad.Random.Class ( - - -- * MonadRandom - MonadRandom(..), + -- * MonadRandom + MonadRandom (..), - -- * MonadSplit - MonadSplit(..), + -- * MonadSplit + MonadSplit (..), - -- * MonadInterleave - MonadInterleave(..), + -- * MonadInterleave + MonadInterleave (..), - -- * Sampling functions - fromList, - fromListMay, - uniform, - uniformMay, - weighted, - weightedMay - ) where + -- * Sampling functions + fromList, + fromListMay, + uniform, + uniformMay, + weighted, + weightedMay, +) where -import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.Cont -import Control.Monad.Trans.Except -import Control.Monad.Trans.Identity -import Control.Monad.Trans.Maybe -import Control.Monad.Trans.Reader -import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS -import qualified Control.Monad.Trans.RWS.Strict as StrictRWS -import qualified Control.Monad.Trans.State.Lazy as LazyState -import qualified Control.Monad.Trans.State.Strict as StrictState -import qualified Control.Monad.Trans.Writer.Lazy as LazyWriter +import Control.Monad +import Control.Monad.Trans.Class +import Control.Monad.Trans.Cont +import Control.Monad.Trans.Except +import Control.Monad.Trans.Identity +import Control.Monad.Trans.Maybe +import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS +import qualified Control.Monad.Trans.RWS.Strict as StrictRWS +import Control.Monad.Trans.Reader +import qualified Control.Monad.Trans.State.Lazy as LazyState +import qualified Control.Monad.Trans.State.Strict as StrictState +import qualified Control.Monad.Trans.Writer.Lazy as LazyWriter import qualified Control.Monad.Trans.Writer.Strict as StrictWriter -import qualified System.Random as Random - -import qualified Data.Foldable as F +import qualified Data.Foldable as F +import Data.Word (Word64) +import qualified System.Random as Random #if MIN_VERSION_base(4,8,0) #else @@ -79,7 +75,7 @@ -- | With a source of random number supply in hand, the 'MonadRandom' class -- allows the programmer to extract random values of a variety of types. -class (Monad m) => MonadRandom m where +class Monad m => MonadRandom m where -- | Takes a range /(lo,hi)/ and a random number generator -- /g/, and returns a computation that returns a random value uniformly -- distributed in the closed interval /[lo,hi]/, together with a new @@ -89,7 +85,7 @@ -- interval. -- -- See 'System.Random.randomR' for details. - getRandomR :: (Random.Random a) => (a, a) -> m a + getRandomR :: Random.Random a => (a, a) -> m a -- | The same as 'getRandomR', but using a default range determined by the type: -- @@ -102,91 +98,91 @@ -- * For 'Integer', the range is (arbitrarily) the range of 'Int'. -- -- See 'System.Random.random' for details. - getRandom :: (Random.Random a) => m a + getRandom :: Random.Random a => m a -- | Plural variant of 'getRandomR', producing an infinite list of -- random values instead of returning a new generator. -- -- See 'System.Random.randomRs' for details. - getRandomRs :: (Random.Random a) => (a, a) -> m [a] + getRandomRs :: Random.Random a => (a, a) -> m [a] -- | Plural variant of 'getRandom', producing an infinite list of -- random values instead of returning a new generator. -- -- See 'System.Random.randoms' for details. - getRandoms :: (Random.Random a) => m [a] + getRandoms :: Random.Random a => m [a] instance MonadRandom IO where - getRandomR = Random.randomRIO - getRandom = Random.randomIO + getRandomR = Random.randomRIO + getRandom = Random.randomIO getRandomRs lohi = liftM (Random.randomRs lohi) Random.newStdGen - getRandoms = liftM Random.randoms Random.newStdGen + getRandoms = liftM Random.randoms Random.newStdGen -instance (MonadRandom m) => MonadRandom (ContT r m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom +instance MonadRandom m => MonadRandom (ContT r m) where + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms -instance (MonadRandom m) => MonadRandom (ExceptT e m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom +instance MonadRandom m => MonadRandom (ExceptT e m) where + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms -instance (MonadRandom m) => MonadRandom (IdentityT m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom +instance MonadRandom m => MonadRandom (IdentityT m) where + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms -instance (MonadRandom m) => MonadRandom (MaybeT m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom +instance MonadRandom m => MonadRandom (MaybeT m) where + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms instance (Monoid w, MonadRandom m) => MonadRandom (LazyRWS.RWST r w s m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms instance (Monoid w, MonadRandom m) => MonadRandom (StrictRWS.RWST r w s m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms -instance (MonadRandom m) => MonadRandom (ReaderT r m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom +instance MonadRandom m => MonadRandom (ReaderT r m) where + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms -instance (MonadRandom m) => MonadRandom (LazyState.StateT s m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom +instance MonadRandom m => MonadRandom (LazyState.StateT s m) where + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms -instance (MonadRandom m) => MonadRandom (StrictState.StateT s m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom +instance MonadRandom m => MonadRandom (StrictState.StateT s m) where + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms instance (MonadRandom m, Monoid w) => MonadRandom (LazyWriter.WriterT w m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms instance (MonadRandom m, Monoid w) => MonadRandom (StrictWriter.WriterT w m) where - getRandomR = lift . getRandomR - getRandom = lift getRandom + getRandomR = lift . getRandomR + getRandom = lift getRandom getRandomRs = lift . getRandomRs - getRandoms = lift getRandoms + getRandoms = lift getRandoms ------------------------------------------------------------ -- MonadSplit @@ -199,8 +195,7 @@ -- actually do anything with a generator. It remains here to avoid -- breaking existing code unnecessarily. For a more practically -- useful interface, see 'MonadInterleave'. -class (Monad m) => MonadSplit g m | m -> g where - +class Monad m => MonadSplit g m | m -> g where -- | The 'getSplit' operation allows one to obtain two distinct random number -- generators. -- @@ -210,16 +205,16 @@ instance MonadSplit Random.StdGen IO where getSplit = Random.newStdGen -instance (MonadSplit g m) => MonadSplit g (ContT r m) where +instance MonadSplit g m => MonadSplit g (ContT r m) where getSplit = lift getSplit -instance (MonadSplit g m) => MonadSplit g (ExceptT e m) where +instance MonadSplit g m => MonadSplit g (ExceptT e m) where getSplit = lift getSplit -instance (MonadSplit g m) => MonadSplit g (IdentityT m) where +instance MonadSplit g m => MonadSplit g (IdentityT m) where getSplit = lift getSplit -instance (MonadSplit g m) => MonadSplit g (MaybeT m) where +instance MonadSplit g m => MonadSplit g (MaybeT m) where getSplit = lift getSplit instance (Monoid w, MonadSplit g m) => MonadSplit g (LazyRWS.RWST r w s m) where @@ -228,13 +223,13 @@ instance (Monoid w, MonadSplit g m) => MonadSplit g (StrictRWS.RWST r w s m) where getSplit = lift getSplit -instance (MonadSplit g m) => MonadSplit g (ReaderT r m) where +instance MonadSplit g m => MonadSplit g (ReaderT r m) where getSplit = lift getSplit -instance (MonadSplit g m) => MonadSplit g (LazyState.StateT s m) where +instance MonadSplit g m => MonadSplit g (LazyState.StateT s m) where getSplit = lift getSplit -instance (MonadSplit g m) => MonadSplit g (StrictState.StateT s m) where +instance MonadSplit g m => MonadSplit g (StrictState.StateT s m) where getSplit = lift getSplit instance (Monoid w, MonadSplit g m) => MonadSplit g (LazyWriter.WriterT w m) where @@ -250,7 +245,6 @@ -- | The class 'MonadInterleave' proivides a convenient interface atop -- a 'split' operation on a random generator. class MonadRandom m => MonadInterleave m where - -- | If @x :: m a@ is a computation in some random monad, then -- @interleave x@ works by splitting the generator, running @x@ -- using one half, and using the other half as the final generator @@ -295,16 +289,16 @@ -- > Node 8243316398511136358 (Node 4139784028141790719 Leaf Leaf) (Node 4473998613878251948 Leaf Leaf) interleave :: m a -> m a -instance (MonadInterleave m) => MonadInterleave (ContT r m) where +instance MonadInterleave m => MonadInterleave (ContT r m) where interleave = mapContT interleave -instance (MonadInterleave m) => MonadInterleave (ExceptT e m) where +instance MonadInterleave m => MonadInterleave (ExceptT e m) where interleave = mapExceptT interleave -instance (MonadInterleave m) => MonadInterleave (IdentityT m) where +instance MonadInterleave m => MonadInterleave (IdentityT m) where interleave = mapIdentityT interleave -instance (MonadInterleave m) => MonadInterleave (MaybeT m) where +instance MonadInterleave m => MonadInterleave (MaybeT m) where interleave = mapMaybeT interleave instance (Monoid w, MonadInterleave m) => MonadInterleave (LazyRWS.RWST r w s m) where @@ -313,13 +307,13 @@ instance (Monoid w, MonadInterleave m) => MonadInterleave (StrictRWS.RWST r w s m) where interleave = StrictRWS.mapRWST interleave -instance (MonadInterleave m) => MonadInterleave (ReaderT r m) where +instance MonadInterleave m => MonadInterleave (ReaderT r m) where interleave = mapReaderT interleave -instance (MonadInterleave m) => MonadInterleave (LazyState.StateT s m) where +instance MonadInterleave m => MonadInterleave (LazyState.StateT s m) where interleave = LazyState.mapStateT interleave -instance (MonadInterleave m) => MonadInterleave (StrictState.StateT s m) where +instance MonadInterleave m => MonadInterleave (StrictState.StateT s m) where interleave = StrictState.mapStateT interleave instance (Monoid w, MonadInterleave m) => MonadInterleave (LazyWriter.WriterT w m) where @@ -340,7 +334,7 @@ ma <- weightedMay t case ma of Nothing -> error "Control.Monad.Random.Class.weighted: empty collection, or total weight <= 0" - Just a -> return a + Just a -> return a -- | Sample a random value from a weighted collection of elements. -- Returns @Nothing@ if the collection is empty or the total weight is @@ -350,23 +344,28 @@ -- | Sample a random value from a weighted list. The list must be -- non-empty and the total weight must be non-zero. -fromList :: (MonadRandom m) => [(a, Rational)] -> m a +fromList :: MonadRandom m => [(a, Rational)] -> m a fromList ws = do ma <- fromListMay ws case ma of Nothing -> error "Control.Monad.Random.Class.fromList: empty list, or total weight = 0" - Just a -> return a + Just a -> return a -- | Sample a random value from a weighted list. Return @Nothing@ if -- the list is empty or the total weight is nonpositive. -fromListMay :: (MonadRandom m) => [(a, Rational)] -> m (Maybe a) +fromListMay :: MonadRandom m => [(a, Rational)] -> m (Maybe a) fromListMay xs = do - let s = fromRational (sum (map snd xs)) :: Double - cums = scanl1 (\ ~(_,q) ~(y,s') -> (y, s'+q)) xs - case s <= 0 of - True -> return Nothing - _ -> do - p <- liftM toRational $ getRandomR (0, s) + let s = sum (map snd xs) + cums = scanl1 (\ ~(_, q) ~(y, s') -> (y, s' + q)) xs + if s <= 0 + then return Nothing + else do + -- Pick a Word64 value uniformly + w <- getRandom + -- w / maxBound gives a uniform Rational in the range [0,1]. + -- Subtract from 1 to match the way uniform Double values are + -- generated, and hence match the old behavior of this function. + let p = s * (1 - toRational (w :: Word64) / toRational (maxBound :: Word64)) return . Just . fst . head . dropWhile ((< p) . snd) $ cums -- | Sample a value uniformly from a nonempty collection of elements. @@ -375,9 +374,24 @@ ma <- uniformMay t case ma of Nothing -> error "Control.Monad.Random.Class.uniform: empty collection" - Just a -> return a + Just a -> return a -- | Sample a value uniformly from a collection of elements. Return -- @Nothing@ if the collection is empty. uniformMay :: (F.Foldable t, MonadRandom m) => t a -> m (Maybe a) uniformMay = fromListMay . map (flip (,) 1) . F.toList + +------------------------------------------------------------ + +-- The old implementation of `fromListMay`, for comparison. See +-- https://github.com/byorgey/MonadRandom/issues/53 and +-- https://byorgey.github.io/blog/posts/2024/10/14/MonadRandom-version-bump.html +fromListMayOld :: MonadRandom m => [(a, Rational)] -> m (Maybe a) +fromListMayOld xs = do + let s = fromRational (sum (map snd xs)) :: Double + cums = scanl1 (\ ~(_, q) ~(y, s') -> (y, s' + q)) xs + if s <= 0 + then return Nothing + else do + p <- liftM toRational $ getRandomR (0, s) + return . Just . fst . head . dropWhile ((< p) . snd) $ cums diff --git a/MonadRandom.cabal b/MonadRandom.cabal --- a/MonadRandom.cabal +++ b/MonadRandom.cabal @@ -1,5 +1,5 @@ name: MonadRandom -version: 0.6 +version: 0.6.1 synopsis: Random-number generation monad. description: Support for computations which consume random values. license: BSD3 @@ -11,7 +11,7 @@ build-type: Simple cabal-version: >=1.10 extra-source-files: CHANGES.markdown -tested-with: GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2 +tested-with: GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 || ==9.10.1 source-repository head type: git @@ -27,12 +27,12 @@ Control.Monad.Trans.Random.Lazy, Control.Monad.Trans.Random.Strict build-depends: - base >=4.6 && <5, + base >=4.8 && <5, transformers >=0.4 && <0.7, transformers-compat >=0.4 && <0.8, mtl >=2.2.1 && <2.3 || >= 2.3.1 && < 2.4, - primitive >=0.6 && <0.8, - random >=1.0 && <1.3 + primitive >=0.6 && <0.10, + random >=1.0.1 && <1.3 ghc-options: -Wall default-language: Haskell2010 other-extensions: Safe