MonadRandom-0.1.6/0000755000000000000000000000000011470535345012112 5ustar0000000000000000MonadRandom-0.1.6/MonadRandom.cabal0000644000000000000000000000106411470535345015276 0ustar0000000000000000Name: MonadRandom Build-type: Simple Version: 0.1.6 Synopsis: Random-number generation monad. Description: Support for computations which consume random values. License: OtherLicense License-file: LICENSE Category: Control Author: Cale Gibbard and others Maintainer: Eric Kidd Stability: experimental Build-Depends: base >=2 && < 5, mtl, random Exposed-modules: Control.Monad.Random.Class, Control.Monad.Random MonadRandom-0.1.6/LICENSE0000644000000000000000000000313311470535345013117 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.1.6/Setup.hs0000644000000000000000000000005611470535345013547 0ustar0000000000000000import Distribution.Simple main = defaultMain MonadRandom-0.1.6/Control/0000755000000000000000000000000011470535345013532 5ustar0000000000000000MonadRandom-0.1.6/Control/Monad/0000755000000000000000000000000011470535345014570 5ustar0000000000000000MonadRandom-0.1.6/Control/Monad/Random.hs0000644000000000000000000001456511470535345016357 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# 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, Rand, RandT -- but not the data constructors -- * Example -- $RandExample ) where import System.Random import Control.Monad() import Control.Monad.Identity import Control.Monad.Random.Class import Control.Monad.Reader import Control.Monad.State import Control.Monad.Trans() import Control.Monad.Writer import Control.Arrow import Control.Applicative -- | A monad transformer which adds a random number generator to an -- existing monad. newtype (RandomGen g) => RandT g m a = RandT (StateT g m a) deriving (Functor, Monad, MonadTrans, MonadIO, MonadFix) instance (Functor m,Monad m) => Applicative (RandT g m) where pure = return (<*>) = ap liftState :: (MonadState s m) => (s -> (a,s)) -> m a liftState t = do v <- get let (x, v') = t v put v' return x instance (Monad m, RandomGen g) => MonadRandom (RandT g m) where getRandom = RandT . liftState $ random getRandoms = RandT . liftState $ first randoms . split getRandomR (x,y) = RandT . liftState $ randomR (x,y) getRandomRs (x,y) = RandT . liftState $ first (randomRs (x,y)) . split instance (Monad m, RandomGen g) => MonadSplit g (RandT g m) where getSplit = RandT . liftState $ 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, RandomGen g) => 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 :: (Monad m, RandomGen g) => RandT g m a -> g -> m (a, g) runRandT (RandT x) g = runStateT x g -- | A basic random monad. newtype Rand g a = Rand (RandT g Identity a) deriving (Functor, Applicative, Monad, MonadRandom, MonadSplit g, MonadFix) -- | 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 :: (RandomGen g) => Rand g a -> g -> a evalRand (Rand x) g = runIdentity (evalRandT x g) -- | Run a random computation using the generator @g@, returning the result -- and the updated generator. runRand :: (RandomGen g) => Rand g a -> g -> (a, g) runRand (Rand x) g = runIdentity (runRandT x g) -- | Evaluate a random computation in the IO monad, using the random number -- generator supplied by 'System.Random.getStdRandom'. evalRandIO :: Rand StdGen a -> IO a evalRandIO (Rand (RandT x)) = getStdRandom (runIdentity . runStateT x) -- | 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 instance (MonadRandom m) => MonadRandom (StateT s m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m, Monoid w) => MonadRandom (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 (MonadSplit g m) => MonadSplit g (StateT s m) where getSplit = lift getSplit instance (MonadSplit g m, Monoid w) => MonadSplit g (WriterT w m) where getSplit = lift getSplit instance (MonadSplit g m) => MonadSplit g (ReaderT r m) where getSplit = lift getSplit instance (MonadState s m, RandomGen g) => MonadState s (RandT g m) where get = lift get put = lift . put instance (MonadReader r m, RandomGen g) => MonadReader r (RandT g m) where ask = lift ask local f (RandT m) = RandT $ local f m instance (MonadWriter w m, RandomGen g, Monoid w) => MonadWriter w (RandT g m) where tell = lift . tell listen (RandT m) = RandT $ listen m pass (RandT m) = RandT $ pass m 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.1.6/Control/Monad/Random/0000755000000000000000000000000011470535345016010 5ustar0000000000000000MonadRandom-0.1.6/Control/Monad/Random/Class.hs0000644000000000000000000000346611470535345017422 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