rand-vars (empty) → 0.1
raw patch · 4 files changed
+276/−0 lines, 4 filesdep +IntervalMapdep +arraydep +basesetup-changed
Dependencies added: IntervalMap, array, base, mtl, random
Files
- Control/Monad/Random.hs +227/−0
- LICENSE +23/−0
- Setup.hs +2/−0
- rand-vars.cabal +24/−0
+ Control/Monad/Random.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ConstraintKinds #-}++{- |+ This module provides efficient and intuitive ways+ to build and manipulate random variables of all kinds.++ The following is an example of generating combinations for a slot machine.++> import Control.Monad.Random+> import Control.Applicative+> import Control.Monad+>+> data Slot = Lemon+> | Cherry+> | Strawberry+> | Orange+> | Bar+> | Seven+> deriving (Enum, Show)+>+> data Combination = Combination Slot Slot Slot deriving Show+>+> fairSlot = oneOf [Lemon .. Seven]+> fairCombination = Combination <$> fairSlot <*> fairSlot <*> fairSlot+>+> biasedSlot = fromFreqs [Lemon `withFreq` 1,+> Cherry `withFreq` 1,+> Strawberry `withFreq` 1.2,+> Orange `withFreq` 1.1,+> Bar `withFreq` 0.9,+> Seven `withFreq` 0.8]+>+> biasedCombination = Combination <$> biasedSlot+> <*> biasedSlot+> <*> biasedSlot+>+>+> aTripToAMachine = do+> combination <- fromFreqs [fairCombination `withFreq` 10,+> biasedCombination `withFreq` 5]+> rounds <- inRange (5, 50)+> replicateM rounds combination+>+> aTripToTheCasino = do+> trips <- fmap (*3) $ inRange (1, 10)+> fmap concat $ replicateM trips aTripToAMachine+>+> main = pick aTripToTheCasino >>= print+-}+module Control.Monad.Random (+ -- * RandPicker class+ RandPicker (..),+ MonadRand,+ -- * Rand Monad+ Rand (..),+ evalRand, execRand,+ -- * Creation of random variables+ rand, oneOf, inRange,+ fromFreqs, withFreq,+ -- * RandT Monad+ RandT (..),+ evalRandT, execRandT+ ) where++import System.Random+import Data.Array.IArray ((!), listArray, Array)+import Control.Applicative+import Control.Monad+import Control.Arrow (first, second)+import Control.Monad.Trans+import Control.Monad.Reader.Class+import Control.Monad.State.Class+import Control.Monad.Writer.Class+import qualified Data.IntervalMap as IM++-- | Class supporting the return of a random element.+class RandPicker m where+ pick :: Rand a -> m a++type MonadRand m = (Monad m, RandPicker m)++instance RandPicker IO where+ pick r = do+ g <- getStdGen+ let (x, g') = r `runRand` g+ setStdGen g'+ return x++-- | Random variable of @a@.+newtype Rand a = Rand { runRand :: RandomGen g => g -> (a, g) }++instance Monad Rand where+ return x = Rand (\ g -> (x, g))+ r >>= f = Rand (\ g -> let (x, g') = r `runRand` g in f x `runRand` g')++instance Functor Rand where+ fmap f r = Rand (\ g -> let (x, g') = r `runRand` g in (f x, g'))++instance Applicative Rand where+ pure = return+ f <*> x = do+ h <- f+ a <- x+ return (h a)++instance RandPicker Rand where+ pick = id++{- |+ Run the random variable and returns only its value.+ The new generator is lost.+-}+evalRand :: RandomGen g => Rand a -> g -> a+evalRand v g = fst $ v `runRand` g++-- | Run the random variable and returns only the new @RandomGen@.+execRand :: RandomGen g => Rand a -> g -> g+execRand v g = snd $ v `runRand` g++-- | Equiprobable distribution among the elements of the list.+oneOf :: [a] -> Rand a+oneOf xs = fmap (arr !) $ inRange range+ where+ -- Creating an array for constant time lookup.+ range = (0, length xs - 1)+ arr = (listArray range :: [a] -> Array Int a) xs++-- | Distribution provided by 'random'.+rand :: Random a => Rand a+rand = Rand random++-- | Distribution within a given range, provided by 'randomR'.+inRange :: Random a => (a, a) -> Rand a+inRange r = Rand (randomR r)++-- | Distribution of elements proportionately to their indicated frequency.+fromFreqs :: Real b => [(a, b)] -> Rand a+fromFreqs fs = Rand (\ g ->+ let (from, to) = genRange g in+ let range = toRational (to - from) in+ let ratio = freqSum / range in+ let (i, g') = next g in+ let j = (*) ratio $ toRational (i - from) in+ case IM.containing intervalMap j of+ [(_, x)] -> (x, g')+ _ -> error "Index not in the map."+ )+ where+ elems = preprocess fs++ freqSum = sum $ map snd elems++ intervalMap = IM.fromAscList $ computeIntervals 0 elems++ preprocess = map (second toRational) . filter ((> 0) . snd)++ computeIntervals _ [] = undefined+ computeIntervals lower ((v, f) : []) = let upper = (lower + f) in+ [(IM.ClosedInterval lower upper, v)]+ computeIntervals lower ((v, f) : xs) = let upper = (lower + f) in+ (IM.IntervalCO lower upper, v) : computeIntervals upper xs++-- | Alias for @(,)@.+withFreq :: Real b => a -> b -> (a, b)+withFreq = (,)++newtype RandT m a = RandT { runRandT :: RandomGen g => g -> m (a, g) }++instance Functor m => Functor (RandT m) where+ fmap f r = RandT (\ g -> fmap (first f) $ r `runRandT` g)++instance Applicative m => Applicative (RandT m) where+ pure x = RandT (\ g -> pure (x, g))+ f <*> x = RandT (\ g -> let (g', g'') = split g in+ fmap (\ (h, g3') x -> (h x, g3')) (f `runRandT` g') <*>+ fmap fst (x `runRandT` g''))++instance Monad m => Monad (RandT m) where+ return x = RandT (\ g -> return (x, g))+ r >>= f = RandT (runRandT r >=> (\ ( x, g) -> f x `runRandT` g))+ fail err = RandT (\ _ -> fail err)++instance Monad m => RandPicker (RandT m) where+ pick r = RandT (\ g -> return $ r `runRand` g)++instance MonadTrans RandT where+ lift m = RandT (\ g -> m >>= (\ x -> return (x, g)))++instance MonadReader r m => MonadReader r (RandT m) where+ ask = lift ask+ local f m = RandT (\ g -> do+ (x, g') <- m `runRandT` g+ y <- local f (return x)+ return (y, g'))++instance MonadWriter w m => MonadWriter w (RandT m) where+ tell = lift . tell+ listen r = RandT (\ g -> do+ ((x, g'), w) <- listen $ r `runRandT` g+ return ((x, w), g'))+ pass r = RandT (\ g -> pass $ do+ ((x, f), g') <- r `runRandT` g+ return ((x, g'), f))++instance MonadState s m => MonadState s (RandT m) where+ get = lift get+ put = lift . put++instance MonadIO m => MonadIO (RandT m) where+ liftIO = lift . liftIO++instance MonadPlus m => MonadPlus (RandT m) where+ mzero = lift mzero+ mplus a b = RandT (\ g -> let (g', g'') = split g in+ (a `runRandT` g') `mplus` (b `runRandT` g''))++-- | Similar to 'evalRand'.+evalRandT :: (RandomGen g, Monad m) => RandT m a -> g -> m a+evalRandT r g = (r `runRandT` g) >>= (\ (x, _) -> return x)++-- | Similar to 'execRand'.+execRandT :: (RandomGen g, Monad m) => RandT m a -> g -> m g+execRandT r g = (r `runRandT` g) >>= (\ (_, g') -> return g')
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) 2012, Romain Edelmann+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * The names of its contributors may not be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL ROMAIN EDELMANN BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ rand-vars.cabal view
@@ -0,0 +1,24 @@+name: rand-vars+version: 0.1+author: Romain Edelmann+maintainer: Romain Edelmann+synopsis: Random variable library, with Functor, Applicative and Monad instances.+description: Random variable library, with Functor, Applicative and Monad instances.+cabal-version: >= 1.6+build-type: Simple+category: Random+license: BSD3+license-file: LICENSE++source-repository head+ type: git+ location: https://github.com/redelmann/haskell-rand-vars++library+ build-depends: base >=4.0 && <5.0, + mtl >= 1.0,+ array >= 0.4.0.0,+ random >= 1.0,+ IntervalMap >= 0.3+ exposed-modules: Control.Monad.Random+ extensions: Rank2Types