MonadRandom-0.4.1/0000755000000000000000000000000012623767533012117 5ustar0000000000000000MonadRandom-0.4.1/Setup.hs0000644000000000000000000000005612623767533013554 0ustar0000000000000000import Distribution.Simple main = defaultMain MonadRandom-0.4.1/LICENSE0000644000000000000000000000313312623767533013124 0ustar0000000000000000MonadRandom library. Copyright 2006-2007 Cale Gibbard. All rights reserved. Copyright 2006 Russell O'Connor, Dan Doel, Remi Turk. All rights reserved. Copyright 2007 Eric Kidd. All rights reserved. [This code was originally posted by Cale Gibbard to the Haskell Wiki, remnants of which can be seen at: http://web.archive.org/web/20070615071737/http://haskell.org/hawiki/MonadRandom This code was relicensed from a 2-clause BSD license to the license below by Cale Gibbard's statement at: http://www.haskell.org/haskellwiki/User:CaleGibbard The code was then moved to: http://www.haskell.org/haskellwiki/NewMonads/MonadRandom New additions by several people were provided under the implicit license at: http://www.haskell.org/haskellwiki/HaskellWiki:Copyrights So, in theory, this license should apply to everything in this library.] Permission is hereby granted, free of charge, to any person obtaining this work (the "Work"), to deal in the Work without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Work, and to permit persons to whom the Work is furnished to do so. THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS IN THE WORK. MonadRandom-0.4.1/MonadRandom.cabal0000644000000000000000000000174612623767533015312 0ustar0000000000000000name: MonadRandom version: 0.4.1 synopsis: Random-number generation monad. description: Support for computations which consume random values. license: OtherLicense license-file: LICENSE author: Cale Gibbard and others maintainer: Brent Yorgey bug-reports: https://github.com/byorgey/MonadRandom/issues category: Control build-type: Simple cabal-version: >=1.10 extra-source-files: CHANGES.markdown source-repository head type: git location: git://github.com/byorgey/MonadRandom.git library exposed-modules: Control.Monad.Random, Control.Monad.Random.Class build-depends: base >= 2 && < 5, transformers >= 0.3 && < 0.5, transformers-compat == 0.4.*, mtl >= 2.1 && < 2.3, random ghc-options: -Wall default-language: Haskell2010 MonadRandom-0.4.1/CHANGES.markdown0000644000000000000000000000505312623767533014736 0ustar00000000000000000.4.1 (20 November 2015) ------------------------ - Remove unnecessary `Monad m` constraint from `liftRandT` and `runRandT`. This should again technically require a major version bump, but I'm not doing it this time in the interest of not being super annoying. If this breaks something for you, just yell, and I will deprecate this version and do a proper 0.5 release. 0.4 (12 May 2015) ----------------- - Remove unnecessary `RandomGen g` constraints from `liftRandT`, `liftRand`, `evalRandT`, `evalRand`, `runRandT`, `runRand`. A major version bump is required by the PVP since the types of all the above methods have changed, but this release is again very unlikely to break any client code. 0.3.0.2 (30 March 2015) ----------------------- - Add `transformers-compat` to allow building with newer `mtl` 0.3.0.1 (24 November 2014) -------------------------- - Improve documentation: ranges are exclusive at the upper bound 0.3 (4 September 2014) ---------------------- - Eta-reduce definition of `Rand` - Remove unnecessary `Random a` constraint from types of `liftRand` and `liftRandT`. Note that a major version bump is required by the PVP since the types of `liftRand` and `liftRandT` have changed, but this release is highly unlikely to break any client code. 0.2.0.1 (24 August 2014) ------------------------ - Allow building with both `transformers-0.3` and `0.4`. 0.2 (20 August 2014) -------------------- - change `Rand` from a `newtype` to a type synonym - `MonadRandom` and `MonadSplit` instances for - `ExceptT` - strict variants of `StateT` and `WriterT` - both lazy and strict variants of `RWST` - remove unneeded `RandomGen` constraint from `MonadState RandT` instance 0.1.13 (9 February 2014) ------------------------ - add simple `uniform` function for creating a uniform distribution over a list of values 0.1.12 (30 September 2013) -------------------------- - add `liftRandT` and `liftRand` functions, for lifting explicit generator-passing functions into `RandT` and `Rand`, respectively. 0.1.11 (1 August 2013) ---------------------- - add `MonadRandom` and `MonadSplit` instances for `IdentityT` - derive `MonadReader` and `MonadWriter` instances instead of declaring them explicitly (thanks again to James Koppel) 0.1.10 (16 July 2013) --------------------- - add `MonadRandom` and `MonadSplit` instances for `ContT` (thanks to James Koppel for the patch) 0.1.9 (26 April 2013) --------------------- - add `MonadRandom` and `MonadSplit` instances for `MaybeT` MonadRandom-0.4.1/Control/0000755000000000000000000000000012623767533013537 5ustar0000000000000000MonadRandom-0.4.1/Control/Monad/0000755000000000000000000000000012623767533014575 5ustar0000000000000000MonadRandom-0.4.1/Control/Monad/Random.hs0000644000000000000000000002320612623767533016354 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS -fno-warn-orphans #-} {- | Copyright : 2006-2007 Cale Gibbard, Russell O'Connor, Dan Doel, Remi Turk, Eric Kidd. License : OtherLicense Stability : experimental Portability : non-portable (multi-parameter type classes, undecidable instances) A random number generation monad. See for the original version of this code. The actual interface is defined by 'Control.Monad.Random.Class.MonadRandom'. [Computation type:] Computations which consume random values. [Binding strategy:] The computation proceeds in the same fashion as the identity monad, but it carries a random number generator that may be queried to generate random values. [Useful for:] Monte Carlo algorithms and simulating random processes. -} module Control.Monad.Random ( module System.Random, module Control.Monad.Random.Class, evalRandT, runRandT, evalRand, runRand, evalRandIO, fromList, uniform, Rand, RandT, -- but not the data constructors -- * Special lift functions liftRand, liftRandT -- * Example -- $RandExample ) where import Control.Applicative import Control.Arrow import Control.Monad () import Control.Monad.Cont import Control.Monad.Error import Control.Monad.Identity import Control.Monad.Random.Class import Control.Monad.Reader import qualified Control.Monad.RWS.Lazy as RWSL import qualified Control.Monad.RWS.Strict as RWSS import Control.Monad.State import qualified Control.Monad.State.Lazy as SL import qualified Control.Monad.State.Strict as SS import Control.Monad.Trans () import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe import Control.Monad.Writer.Class import qualified Control.Monad.Writer.Lazy as WL import qualified Control.Monad.Writer.Strict as WS import Data.Monoid (Monoid) import System.Random -- | A monad transformer which adds a random number generator to an -- existing monad. newtype RandT g m a = RandT (StateT g m a) deriving (Functor, Monad, MonadTrans, MonadIO, MonadFix, MonadReader r, MonadWriter w) instance (Functor m,Monad m) => Applicative (RandT g m) where pure = return (<*>) = ap -- | Lift arbitrary action to RandT liftRandT :: (g -> m (a, g)) -- ^ action returning value and new generator state -> RandT g m a liftRandT = RandT . StateT -- | Lift arbitrary action to Rand liftRand :: (g -> (a, g)) -- ^ action returning value and new generator state -> Rand g a liftRand = RandT . state instance (Monad m, RandomGen g) => MonadRandom (RandT g m) where getRandom = RandT . state $ random getRandoms = RandT . state $ first randoms . split getRandomR (x,y) = RandT . state $ randomR (x,y) getRandomRs (x,y) = RandT . state $ first (randomRs (x,y)) . split instance (Monad m, RandomGen g) => MonadSplit g (RandT g m) where getSplit = RandT . state $ split -- | Evaluate a RandT computation using the generator @g@. Note that the -- generator @g@ is not returned, so there's no way to recover the -- updated version of @g@. evalRandT :: (Monad m) => RandT g m a -> g -> m a evalRandT (RandT x) g = evalStateT x g -- | Run a RandT computation using the generator @g@, returning the result and -- the updated generator. runRandT :: RandT g m a -> g -> m (a, g) runRandT (RandT x) g = runStateT x g -- | A basic random monad. type Rand g = RandT g Identity -- | Evaluate a random computation using the generator @g@. Note that the -- generator @g@ is not returned, so there's no way to recover the -- updated version of @g@. evalRand :: Rand g a -> g -> a evalRand x g = runIdentity (evalRandT x g) -- | Run a random computation using the generator @g@, returning the result -- and the updated generator. runRand :: Rand g a -> g -> (a, g) runRand x g = runIdentity (runRandT x g) -- | Evaluate a random computation in the IO monad, splitting the global standard generator to get a new one for the computation. evalRandIO :: Rand StdGen a -> IO a evalRandIO x = fmap (evalRand x) newStdGen -- | Sample a random value from a weighted list. The total weight of all -- elements must not be 0. fromList :: (MonadRandom m) => [(a,Rational)] -> m a fromList [] = error "MonadRandom.fromList called with empty list" fromList [(x,_)] = return x fromList xs = do -- TODO: Do we want to be able to use floats as weights? -- TODO: Better error message if weights sum to 0. let s = (fromRational (sum (map snd xs))) :: Double -- total weight cs = scanl1 (\(_,q) (y,s') -> (y, s'+q)) xs -- cumulative weight p <- liftM toRational $ getRandomR (0.0,s) return . fst . head $ dropWhile (\(_,q) -> q < p) cs -- | Sample a value from a uniform distribution of a list of elements. uniform :: (MonadRandom m) => [a] -> m a uniform = fromList . fmap (flip (,) 1) instance (MonadRandom m) => MonadRandom (IdentityT m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m) => MonadRandom (SL.StateT s m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m) => MonadRandom (SS.StateT s m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m, Monoid w) => MonadRandom (WL.WriterT w m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m, Monoid w) => MonadRandom (WS.WriterT w m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m) => MonadRandom (ReaderT r m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m, Monoid w) => MonadRandom (RWSL.RWST r w s m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m, Monoid w) => MonadRandom (RWSS.RWST r w s m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m) => MonadRandom (ExceptT e m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (Error e, MonadRandom m) => MonadRandom (ErrorT e m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m) => MonadRandom (MaybeT m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance MonadRandom m => MonadRandom (ContT r m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadSplit g m) => MonadSplit g (IdentityT m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (SL.StateT s m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (SS.StateT s m) where getSplit = lift getSplit instance (MonadSplit g m, Monoid w) => MonadSplit g (WL.WriterT w m) where getSplit = lift getSplit instance (MonadSplit g m, Monoid w) => MonadSplit g (WS.WriterT w m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (ReaderT r m) where getSplit = lift getSplit instance (MonadSplit g m, Monoid w) => MonadSplit g (RWSL.RWST r w s m) where getSplit = lift getSplit instance (MonadSplit g m, Monoid w) => MonadSplit g (RWSS.RWST r w s m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (ExceptT e m) where getSplit = lift getSplit instance (Error e, MonadSplit g m) => MonadSplit g (ErrorT e m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (MaybeT m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (ContT r m) where getSplit = lift getSplit instance (MonadState s m) => MonadState s (RandT g m) where get = lift get put = lift . put instance MonadRandom IO where getRandom = randomIO getRandomR = randomRIO getRandoms = fmap randoms newStdGen getRandomRs b = fmap (randomRs b) newStdGen instance MonadSplit StdGen IO where getSplit = newStdGen {- $RandExample The @die@ function simulates the roll of a die, picking a number between 1 and 6, inclusive, and returning it in the 'Rand' monad. Notice that this code will work with any source of random numbers @g@. >die :: (RandomGen g) => Rand g Int >die = getRandomR (1,6) The @dice@ function uses @replicate@ and @sequence@ to simulate the roll of @n@ dice. >dice :: (RandomGen g) => Int -> Rand g [Int] >dice n = sequence (replicate n die) To extract a value from the 'Rand' monad, we can can use 'evalRandIO'. >main = do > values <- evalRandIO (dice 2) > putStrLn (show values) -} MonadRandom-0.4.1/Control/Monad/Random/0000755000000000000000000000000012623767533016015 5ustar0000000000000000MonadRandom-0.4.1/Control/Monad/Random/Class.hs0000644000000000000000000000346612623767533017427 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FunctionalDependencies #-} {- | Copyright : 2006-2007 Cale Gibbard, Russell O'Connor, Dan Doel, Remi Turk, Eric Kidd. License : OtherLicense Stability : experimental Portability : non-portable (multi-parameter type classes, undecidable instances) A type class for random number generation monads. See for the original version of this code. Instances of this type class include 'Control.Monad.Random.Rand' and monads created using 'Control.Monad.Random.RandT'. -} module Control.Monad.Random.Class ( MonadRandom, getRandom, getRandomR, getRandoms, getRandomRs, MonadSplit, getSplit ) where import System.Random -- | An interface to random number generation monads. class (Monad m) => MonadRandom m where -- | Return a randomly-selected value of type @a@. See -- 'System.Random.random' for details. getRandom :: (Random a) => m a -- | Return an infinite stream of random values of type @a@. See -- 'System.Random.randoms' for details. getRandoms :: (Random a) => m [a] -- | Return a randomly-selected value of type @a@ in the range -- /[lo,hi]/. See 'System.Random.randomR' for details. getRandomR :: (Random a) => (a,a) -> m a -- | Return an infinite stream of randomly-selected value of type @a@ -- in the range /[lo,hi]/. See 'System.Random.randomRs' for details. getRandomRs :: (Random a) => (a,a) -> m [a] -- | An interface to monads with splittable state (as most random number generation monads will have). -- The intention is that the 'getSplit' action splits the state, returning one half of the result, and -- setting the new state to the other. class (Monad m) => MonadSplit s m | m -> s where getSplit :: m s