diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,15 @@ +* Changes in 0.3.0.0: + + * Drop usage of `random-source` in favor of `random` + * Add `Prim` type that resembles one from `random-source` + * Add `RGen` type that serves the same purpose as `StdRandom` in `random-source` + +* Changes in 0.2.0.6: None. (Pacify Hackage.) + +* Changes in 0.2.0.4: Update for GHC 8.8. + +* Changes in 0.2.0.3: Version bump for transformers dependency. + +* Changes in 0.2.0.2: Version bump for transformers dependency. + +* Changes in 0.2.0.1: Version bump for transformers dependency. diff --git a/rvar.cabal b/rvar.cabal --- a/rvar.cabal +++ b/rvar.cabal @@ -1,12 +1,12 @@ name: rvar -version: 0.2.0.6 +version: 0.3.0.0 stability: stable cabal-version: >= 1.10 build-type: Simple author: James Cook -maintainer: James Cook +maintainer: Dominic Steinitz license: PublicDomain homepage: https://github.com/mokus0/random-fu @@ -26,16 +26,14 @@ comparable to other Haskell libraries, but still a fair bit slower than straight C implementations of the same algorithms. - . - Changes in 0.2.0.1: Version bump for transformers - dependency. -tested-with: GHC == 6.8.3, GHC == 6.10.4, GHC == 6.12.3, - GHC == 7.0.4, GHC == 7.2.1, GHC == 7.2.2 +tested-with: GHC == 8.10.7 +extra-source-files: changelog.md + source-repository head type: git - location: https://github.com/mokus0/random-fu.git + location: https://github.com/haskell-numerics/random-fu subdir: rvar Flag mtl2 @@ -46,6 +44,7 @@ hs-source-dirs: src default-language: Haskell2010 exposed-modules: Data.RVar + other-modules: Data.RVar.Prim if flag(mtl2) build-depends: mtl == 2.* @@ -54,6 +53,7 @@ build-depends: mtl == 1.1.* build-depends: base >= 3 && <5, + bytestring, MonadPrompt == 1.0.*, - random-source == 0.3.*, - transformers >= 0.2 && < 0.6 + transformers >= 0.2 && < 0.6, + random >= 1.2.0 diff --git a/src/Data/RVar.hs b/src/Data/RVar.hs --- a/src/Data/RVar.hs +++ b/src/Data/RVar.hs @@ -1,112 +1,121 @@ {- - ``Data/Random/RVar'' -} -{-# LANGUAGE - RankNTypes, - MultiParamTypeClasses, - FlexibleInstances, - GADTs, - ScopedTypeVariables, - CPP - #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} -- |Random variables. An 'RVar' is a sampleable random variable. Because -- probability distributions form a monad, they are quite easy to work with -- in the standard Haskell monadic styles. For examples, see the source for -- any of the 'Distribution' instances - they all are defined in terms of -- 'RVar's. +{-# LANGUAGE FlexibleContexts #-} + module Data.RVar - ( RandomSource - , MonadRandom - ( getRandomWord8 - , getRandomWord16 - , getRandomWord32 - , getRandomWord64 - , getRandomDouble - , getRandomNByteInteger - ) - - , RVar - , runRVar, sampleRVar - + ( RVar + , runRVar, sampleReaderRVar, sampleStateRVar + , pureRVar + , RVarT - , runRVarT, sampleRVarT - , runRVarTWith, sampleRVarTWith - ) where + , runRVarT, sampleReaderRVarT, sampleStateRVarT + , runRVarTWith, sampleReaderRVarTWith, sampleStateRVarTWith + , RGen(..) + , uniformRVarT + , uniformRangeRVarT -import Data.Random.Internal.Source (Prim(..), MonadRandom(..), RandomSource(..)) -import Data.Random.Source ({-instances-}) + , Prim(..) + ) where -import qualified Control.Monad.Trans.Class as T -import Control.Monad (liftM, ap) -import Control.Monad.Prompt (MonadPrompt(..), PromptT, runPromptT) + import qualified Control.Monad.IO.Class as T -import qualified Control.Monad.Trans as MTL +import Control.Monad.Prompt (MonadPrompt(..), PromptT, runPromptT) +import Control.Monad.Reader as MTL +import Control.Monad.State as MTL +import qualified Control.Monad.Trans.Class as T import qualified Data.Functor.Identity as T +import Data.RVar.Prim +import System.Random.Stateful --- |An opaque type modeling a \"random variable\" - a value --- which depends on the outcome of some random event. 'RVar's +-- |An opaque type modeling a \"random variable\" - a value +-- which depends on the outcome of some random event. 'RVar's -- can be conveniently defined by an imperative-looking style: --- +-- -- > normalPair = do -- > u <- stdUniform -- > t <- stdUniform -- > let r = sqrt (-2 * log u) -- > theta = (2 * pi) * t --- > +-- > -- > x = r * cos theta -- > y = r * sin theta -- > return (x,y) --- +-- -- OR by a more applicative style: --- +-- -- > logNormal = exp <$> stdNormal -- -- Once defined (in any style), there are several ways to sample 'RVar's: --- --- * In a monad, using a 'RandomSource': --- --- > runRVar (uniform 1 100) DevRandom :: IO Int --- --- * In a monad, using a 'MonadRandom' instance: -- --- > sampleRVar (uniform 1 100) :: State PureMT Int --- --- * As a pure function transforming a functional RNG: --- --- > sampleState (uniform 1 100) :: StdGen -> (Int, StdGen) +-- * Using an immutable pseudo-random number generator that has an instance for `RandomGen` with +-- `StateT` monad: -- --- (where @sampleState = runState . sampleRVar@) +-- >>> import qualified Data.Random as Fu (uniform) +-- >>> import System.Random (mkStdGen) +-- >>> import Control.Monad.State (runState) +-- >>> runState (sampleStateRVar (Fu.uniform 1 (100 :: Integer))) (mkStdGen 2021) +-- (79,StdGen {unStdGen = SMGen 4687568268719557181 4805600293067301895}) +-- +-- * Using a mutable pseud-random number generator that has an instance for `StatefulGen` with +-- `ReaderT` monad. +-- +-- >>> import qualified Data.Random as Fu (uniform) +-- >>> import System.Random.MWC (create) +-- >>> import Control.Monad.Reader (runReaderT) +-- >>> import qualified Data.Vector.Storable as VS +-- >>> initialize (VS.singleton 2021) >>= runReaderT (sampleReaderRVar (uniform 1 (100 :: Integer))) +-- 8 +-- type RVar = RVarT T.Identity +-- | Sample random variable using `RandomGen` generator as source of entropy +pureRVar :: RandomGen g => RVar a -> g -> (a, g) +pureRVar rvar g = runStateGen g (runRVar rvar) + -- |\"Run\" an 'RVar' - samples the random variable from the provided -- source of entropy. -runRVar :: RandomSource m s => RVar a -> s -> m a +runRVar :: StatefulGen g m => RVar a -> g -> m a runRVar = runRVarTWith (return . T.runIdentity) -- |@sampleRVar x@ is equivalent to @runRVar x 'StdRandom'@. -sampleRVar :: MonadRandom m => RVar a -> m a -sampleRVar = sampleRVarTWith (return . T.runIdentity) +sampleReaderRVar :: (StatefulGen g m, MonadReader g m) => RVar a -> m a +sampleReaderRVar = sampleReaderRVarTWith (return . T.runIdentity) +sampleStateRVar :: (RandomGen g, MonadState g m) => RVar a -> m a +sampleStateRVar = sampleStateRVarTWith (return . T.runIdentity) + -- |A random variable with access to operations in an underlying monad. Useful -- examples include any form of state for implementing random processes with hysteresis, -- or writer monads for implementing tracing of complicated algorithms. --- +-- -- For example, a simple random walk can be implemented as an 'RVarT' 'IO' value: -- -- > rwalkIO :: IO (RVarT IO Double) -- > rwalkIO d = do -- > lastVal <- newIORef 0 --- > +-- > -- > let x = do -- > prev <- lift (readIORef lastVal) -- > change <- rvarT StdNormal --- > +-- > -- > let new = prev + change -- > lift (writeIORef lastVal new) -- > return new --- > +-- > -- > return x -- -- To run the random walk it must first be initialized, after which it can be sampled as usual: @@ -119,35 +128,39 @@ -- -- The same random-walk process as above can be implemented using MTL types -- as follows (using @import Control.Monad.Trans as MTL@): --- +-- -- > rwalkState :: RVarT (State Double) Double -- > rwalkState = do -- > prev <- MTL.lift get -- > change <- rvarT StdNormal --- > +-- > -- > let new = prev + change -- > MTL.lift (put new) -- > return new --- +-- -- Invocation is straightforward (although a bit noisy) if you're used to MTL: --- +-- -- > rwalk :: Int -> Double -> StdGen -> ([Double], StdGen) --- > rwalk count start gen = +-- > rwalk count start gen = -- > flip evalState start . -- > flip runStateT gen . -- > sampleRVarTWith MTL.lift $ -- > replicateM count rwalkState newtype RVarT m a = RVarT { unRVarT :: PromptT Prim m a } -runRVarT :: RandomSource m s => RVarT m a -> s -> m a +runRVarT :: StatefulGen g m => RVarT m a -> g -> m a runRVarT = runRVarTWith id -sampleRVarT :: MonadRandom m => RVarT m a -> m a -sampleRVarT = sampleRVarTWith id +sampleStateRVarT :: (RandomGen g, MonadState g m) => RVarT m a -> m a +sampleStateRVarT rvar = runRVarT rvar StateGenM + +sampleReaderRVarT :: (StatefulGen g m, MonadReader g m) => RVarT m a -> m a +sampleReaderRVarT rvar = ask >>= runRVarT rvar + -- | \"Runs\" an 'RVarT', sampling the random variable it defines. --- --- The first argument lifts the base monad into the sampling monad. This +-- +-- The first argument lifts the base monad into the sampling monad. This -- operation must obey the \"monad transformer\" laws: -- -- > lift . return = return @@ -166,30 +179,62 @@ -- -- The ability to lift is very important - without it, every 'RVar' would have -- to either be given access to the full capability of the monad in which it --- will eventually be sampled (which, incidentally, would also have to be +-- will eventually be sampled (which, incidentally, would also have to be -- monomorphic so you couldn't sample one 'RVar' in more than one monad) --- or functions manipulating 'RVar's would have to use higher-ranked +-- or functions manipulating 'RVar's would have to use higher-ranked -- types to enforce the same kind of isolation and polymorphism. {-# INLINE runRVarTWith #-} -runRVarTWith :: forall m n s a. RandomSource m s => (forall t. n t -> m t) -> RVarT n a -> s -> m a -runRVarTWith liftN (RVarT m) src = runPromptT return bindP bindN m +runRVarTWith :: forall m n g a. StatefulGen g m => (forall t. n t -> m t) -> RVarT n a -> g -> m a +runRVarTWith liftN (RVarT m) gen = runPromptT return bindP bindN m where bindP :: forall t. (Prim t -> (t -> m a) -> m a) - bindP prim cont = getRandomPrimFrom src prim >>= cont - + bindP prim cont = uniformPrimM prim gen >>= cont + bindN :: forall t. n t -> (t -> m a) -> m a bindN nExp cont = liftN nExp >>= cont +{-# INLINE uniformPrimM #-} +uniformPrimM :: StatefulGen g m => Prim t -> g -> m t +uniformPrimM prim g = + case prim of + PrimWord8 -> uniformWord8 g + PrimWord16 -> uniformWord16 g + PrimWord32 -> uniformWord32 g + PrimWord64 -> uniformWord64 g + PrimShortByteString n -> uniformShortByteString n g + + -- |@sampleRVarTWith lift x@ is equivalent to @runRVarTWith lift x 'StdRandom'@. -sampleRVarTWith :: forall m n a. MonadRandom m => (forall t. n t -> m t) -> RVarT n a -> m a -sampleRVarTWith liftN (RVarT m) = runPromptT return bindP bindN m +{-# INLINE sampleReaderRVarTWith #-} +sampleReaderRVarTWith :: + forall m n a g. (StatefulGen g m, MonadReader g m) + => (forall t. n t -> m t) + -> RVarT n a + -> m a +sampleReaderRVarTWith liftN (RVarT m) = runPromptT return bindP bindN m where bindP :: forall t. (Prim t -> (t -> m a) -> m a) - bindP prim cont = getRandomPrim prim >>= cont - + bindP prim cont = ask >>= uniformPrimM prim >>= cont + bindN :: forall t. n t -> (t -> m a) -> m a bindN nExp cont = liftN nExp >>= cont + +-- |@sampleRVarTWith lift x@ is equivalent to @runRVarTWith lift x 'StdRandom'@. +{-# INLINE sampleStateRVarTWith #-} +sampleStateRVarTWith :: + forall m n a g. (RandomGen g, MonadState g m) + => (forall t. n t -> m t) + -> RVarT n a + -> m a +sampleStateRVarTWith liftN (RVarT m) = runPromptT return bindP bindN m + where + bindP :: forall t. (Prim t -> (t -> m a) -> m a) + bindP prim cont = uniformPrimM prim StateGenM >>= cont + + bindN :: forall t. n t -> (t -> m a) -> m a + bindN nExp cont = liftN nExp >>= cont + instance Functor (RVarT n) where fmap = liftM @@ -197,9 +242,6 @@ return x = RVarT (return $! x) (RVarT m) >>= k = RVarT (m >>= \x -> x `seq` unRVarT (k x)) -instance MonadRandom (RVarT n) where - getRandomPrim = RVarT . prompt - instance Applicative (RVarT n) where pure = return (<*>) = ap @@ -222,3 +264,26 @@ liftIO = MTL.lift . MTL.liftIO #endif + +data RGen = RGen + +instance StatefulGen RGen (RVarT m) where + uniformWord8 RGen = RVarT $ prompt PrimWord8 + {-# INLINE uniformWord8 #-} + uniformWord16 RGen = RVarT $ prompt PrimWord16 + {-# INLINE uniformWord16 #-} + uniformWord32 RGen = RVarT $ prompt PrimWord32 + {-# INLINE uniformWord32 #-} + uniformWord64 RGen = RVarT $ prompt PrimWord64 + {-# INLINE uniformWord64 #-} + uniformShortByteString n RGen = RVarT $ prompt (PrimShortByteString n) + {-# INLINE uniformShortByteString #-} + + +uniformRVarT :: Uniform a => RVarT m a +uniformRVarT = uniformM RGen +{-# INLINE uniformRVarT #-} + +uniformRangeRVarT :: UniformRange a => (a, a) -> RVarT m a +uniformRangeRVarT r = uniformRM r RGen +{-# INLINE uniformRangeRVarT #-} diff --git a/src/Data/RVar/Prim.hs b/src/Data/RVar/Prim.hs new file mode 100644 --- /dev/null +++ b/src/Data/RVar/Prim.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +-- |This is an internal interface to support the 'RVar' abstraction. It +-- reifies the operations provided by `System.Random.Stateful.StatefulGen` in a +-- uniform and efficient way, as functions of type @Prim a -> m a@. +module Data.RVar.Prim (Prim(..)) where + +import Data.Typeable +import Data.Word +import Data.ByteString.Short + +-- |A 'Prompt' GADT describing a request for a primitive random variate. Random variable +-- definitions will request their entropy via these prompts, and entropy sources will +-- satisfy those requests. This data type is needed for creating +-- `System.Random.Stateful.StatefulGen` instance for `Data.RVar.RVarT` +-- +data Prim a where + -- | An unsigned byte, uniformly distributed from 0 to 0xff + PrimWord8 :: Prim Word8 + -- | An unsigned 16-bit word, uniformly distributed from 0 to 0xffff + PrimWord16 :: Prim Word16 + -- | An unsigned 32-bit word, uniformly distributed from 0 to 0xffffffff + PrimWord32 :: Prim Word32 + -- | An unsigned 64-bit word, uniformly distributed from 0 to 0xffffffffffffffff + PrimWord64 :: Prim Word64 + -- | A uniformly distributed `ShortByteString` of length @n@ bytes + PrimShortByteString :: !Int -> Prim ShortByteString + deriving (Typeable) + +instance Show (Prim a) where + showsPrec _p PrimWord8 = showString "PrimWord8" + showsPrec _p PrimWord16 = showString "PrimWord16" + showsPrec _p PrimWord32 = showString "PrimWord32" + showsPrec _p PrimWord64 = showString "PrimWord64" + showsPrec p (PrimShortByteString n) = + showParen (p > 10) (showString "PrimShortByteString " . showsPrec 11 n)