random-fu 0.1.3 → 0.1.4
raw patch · 7 files changed
+77/−28 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- random-fu.cabal +11/−3
- src/Data/Random/Distribution/Binomial.hs +3/−3
- src/Data/Random/Distribution/Uniform.hs +18/−7
- src/Data/Random/Distribution/Ziggurat.hs +2/−2
- src/Data/Random/RVar.hs +16/−3
- src/Data/Random/Source/PureMT.hs +11/−3
- src/Data/Random/Source/StdGen.hs +16/−7
random-fu.cabal view
@@ -1,5 +1,5 @@ name: random-fu-version: 0.1.3+version: 0.1.4 stability: provisional cabal-version: >= 1.6@@ -8,7 +8,7 @@ author: James Cook <james.cook@usma.edu> maintainer: James Cook <james.cook@usma.edu> license: PublicDomain-homepage: http://code.haskell.org/~mokus/random-fu+homepage: https://github.com/mokus0/random-fu category: Math synopsis: Random number generation@@ -49,6 +49,14 @@ considering hiding data constructors for most or all of the distributions. +Tested-with: GHC == 6.10.4, GHC == 6.12.1, GHC == 6.12.3,+ GHC == 7.0.1, GHC == 7.0.2++source-repository head+ type: git+ location: https://github.com/mokus0/random-fu.git+ branch: v0.1-series+ Flag base4_2 Description: base-4.2 has an incompatible change in Data.Fixed (HasResolution) @@ -114,7 +122,7 @@ tagged, template-haskell, vector-+ if os(Windows) cpp-options: -Dwindows build-depends: erf-native
src/Data/Random/Distribution/Binomial.hs view
@@ -38,10 +38,10 @@ | otherwise = count k t where- count !k' 0 = return k'- count !k' (n+1) = do+ count !k' 0 = return k'+ count !k' n | n > 0 = do x <- stdUniformT- count (if x < p then k' + 1 else k') n+ count (if x < p then k' + 1 else k') (n-1) count _ _ = error "integralBinomial: negative number of trials specified" -- TODO: improve performance
src/Data/Random/Distribution/Uniform.hs view
@@ -158,12 +158,17 @@ | x >= 1 = 1 | otherwise = realToFrac x +-- |(internal) basic linear interpolation; @lerp x y@ is a linear function whose+-- value is @x@ at 0 and @y@ at 1+lerp :: Num a => a -> a -> a -> a+lerp x y a = (1-a)*x + a*y+ -- |@floatUniform a b@ computes a uniform random 'Float' value in the range [a,b) floatUniform :: Float -> Float -> RVarT m Float floatUniform 0 1 = floatStdUniform floatUniform a b = do x <- floatStdUniform- return (a + x * (b - a))+ return (lerp a b x) -- |@doubleUniform a b@ computes a uniform random 'Double' value in the range [a,b) {-# INLINE doubleUniform #-}@@ -171,7 +176,7 @@ doubleUniform 0 1 = doubleStdUniform doubleUniform a b = do x <- doubleStdUniform- return (a + x * (b - a))+ return (lerp a b x) -- |@realFloatUniform a b@ computes a uniform random value in the range [a,b) for -- any 'RealFloat' type@@ -179,7 +184,7 @@ realFloatUniform 0 1 = realFloatStdUniform realFloatUniform a b = do x <- realFloatStdUniform- return (a + x * (b - a))+ return (lerp a b x) -- |@fixedUniform a b@ computes a uniform random 'Fixed' value in the range -- [a,b), with any desired precision.@@ -302,10 +307,16 @@ -- Integer has no StdUniform... -$( replicateInstances ''Int (integralTypes \\ [''Integer]) [d|- instance CDF StdUniform Int where cdf ~StdUniform = boundedStdUniformCDF- |])-+instance CDF StdUniform Word8 where cdf _ = integralUniformCDF minBound maxBound+instance CDF StdUniform Word16 where cdf _ = integralUniformCDF minBound maxBound+instance CDF StdUniform Word32 where cdf _ = integralUniformCDF minBound maxBound+instance CDF StdUniform Word64 where cdf _ = integralUniformCDF minBound maxBound+instance CDF StdUniform Word where cdf _ = integralUniformCDF minBound maxBound+instance CDF StdUniform Int8 where cdf _ = integralUniformCDF minBound maxBound+instance CDF StdUniform Int16 where cdf _ = integralUniformCDF minBound maxBound+instance CDF StdUniform Int32 where cdf _ = integralUniformCDF minBound maxBound+instance CDF StdUniform Int64 where cdf _ = integralUniformCDF minBound maxBound+instance CDF StdUniform Int where cdf _ = integralUniformCDF minBound maxBound instance Distribution Uniform Float where rvarT (Uniform a b) = floatUniform a b instance Distribution Uniform Double where rvarT (Uniform a b) = doubleUniform a b
src/Data/Random/Distribution/Ziggurat.hs view
@@ -90,7 +90,7 @@ zFunc :: !(t -> t), -- |A flag indicating whether the distribution should be- -- mirrored about the origin (the ziggurat algorithm it+ -- mirrored about the origin (the ziggurat algorithm in -- its native form only samples from one-sided distributions. -- By mirroring, we can extend it to symmetric distributions -- such as the normal distribution)@@ -296,7 +296,7 @@ x 0 = v / f r x 1 = r x i | i == c = 0- x (i+1) = next i+ x i | i > 1 = next (i-1) x _ = error "zigguratXs: programming error! this case should be impossible!" next i = let x_i = xs!!i
src/Data/Random/RVar.hs view
@@ -5,7 +5,8 @@ RankNTypes, MultiParamTypeClasses, FlexibleInstances, - GADTs+ GADTs,+ ScopedTypeVariables #-} -- |Random variables. An 'RVar' is a sampleable random variable. Because@@ -141,10 +142,15 @@ -- For non-standard liftings or those where you would rather not introduce a -- 'Lift' instance, see 'runRVarTWith'. {-# INLINE runRVarT #-}-runRVarT :: (Lift n m, RandomSource m s) => RVarT n a -> s -> m a+runRVarT :: + forall n m s a.+ (Lift n m, RandomSource m s) + => RVarT n a -> s -> m a runRVarT (RVarT m) src = runPromptT return bindP bindN m where+ bindP :: forall t x. Prim t -> (t -> m x) -> m x bindP prim cont = getRandomPrimFrom src prim >>= cont+ bindN :: forall t x. n t -> (t -> m x) -> m x bindN nExp cont = lift nExp >>= cont -- |Like 'runRVarT' but allowing a user-specified lift operation. This @@ -164,10 +170,15 @@ -- > put s -- > return res {-# INLINE runRVarTWith #-}-runRVarTWith :: (RandomSource m s) => (forall t. n t -> m t) -> RVarT n a -> s -> m a+runRVarTWith :: + forall n m 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 where+ bindP :: forall t x. Prim t -> (t -> m x) -> m x bindP prim cont = getRandomPrimFrom src prim >>= cont+ bindN :: forall t x. n t -> (t -> m x) -> m x bindN nExp cont = liftN nExp >>= cont instance Functor (RVarT n) where@@ -188,7 +199,9 @@ instance Lift (RVarT Identity) (RVarT m) where lift (RVarT m) = RVarT (runPromptT return bindP bindN m) where+ bindP :: Prim a -> (a -> PromptT Prim m b) -> PromptT Prim m b bindP prim cont = prompt prim >>= cont+ bindN :: Identity a -> (a -> PromptT Prim m b) -> PromptT Prim m b bindN idExp cont = cont (runIdentity idExp) instance T.MonadIO m => T.MonadIO (RVarT m) where
src/Data/Random/Source/PureMT.hs view
@@ -4,7 +4,8 @@ MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances,- GADTs, RankNTypes+ GADTs, RankNTypes,+ ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -80,10 +81,13 @@ -- > src <- newIORef (pureMT 1234) -- OR: newPureMT >>= newIORef -- > x <- sampleFrom src (uniform 0 100) -- OR: runRVar (uniform 0 100) src -- > print x-getRandomPrimFromMTRef :: (Monad m, ModifyRef sr m PureMT) => sr -> Prim a -> m a+getRandomPrimFromMTRef ::+ forall sr m t.+ (Monad m, ModifyRef sr m PureMT) => sr -> Prim t -> m t getRandomPrimFromMTRef ref = getRandomPrimBy getThing where {-# INLINE getThing #-}+ getThing :: forall a. (PureMT -> (a, PureMT)) -> m a getThing thing = atomicModifyReference ref $ \(!oldMT) -> case thing oldMT of (!w, !newMT) -> (newMT, w) @@ -113,10 +117,14 @@ -- -- Of course, the initial 'PureMT' state could also be obtained by any other -- convenient means, such as 'newPureMT' if you don't care what seed is used.-getRandomPrimFromMTState :: MonadState PureMT m => Prim a -> m a+getRandomPrimFromMTState :: + forall m t.+ MonadState PureMT m + => Prim t -> m t getRandomPrimFromMTState = getRandomPrimBy getThing where {-# INLINE getThing #-}+ getThing :: forall a. (PureMT -> (a, PureMT)) -> m a getThing thing = do !mt <- get let (!ws, !newMt) = thing mt
src/Data/Random/Source/StdGen.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs,- BangPatterns, RankNTypes+ BangPatterns, RankNTypes,+ ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -83,14 +84,16 @@ -- See "Data.Random.Source.PureMT".'getRandomPrimFromMTRef' for more detailed -- usage hints - this function serves exactly the same purpose except for a -- 'StdGen' generator instead of a 'PureMT' generator.-getRandomPrimFromRandomGenRef :: (Monad m, ModifyRef sr m g, RandomGen g) =>- sr -> Prim a -> m a+getRandomPrimFromRandomGenRef :: + forall sr m g t.+ (Monad m, ModifyRef sr m g, RandomGen g) =>+ sr -> Prim t -> m t getRandomPrimFromRandomGenRef ref prim | supported prim = genPrim prim getThing | otherwise = runPromptM (getRandomPrimFromRandomGenRef ref) (decomposePrimWhere supported prim) where {-# INLINE supported #-}- supported :: Prim a -> Bool+ supported :: forall a. Prim a -> Bool supported PrimWord8 = True supported PrimWord16 = True supported PrimWord32 = True@@ -100,7 +103,7 @@ supported _ = False {-# INLINE genPrim #-}- genPrim :: (RandomGen g) => Prim a -> (forall b. (g -> (b, g)) -> (b -> a) -> c) -> c+ genPrim :: forall a c g. (RandomGen g) => Prim a -> (forall b. (g -> (b, g)) -> (b -> a) -> c) -> c genPrim PrimWord8 f = f (randomR (0, 0xff)) (fromIntegral :: Int -> Word8) genPrim PrimWord16 f = f (randomR (0, 0xffff)) (fromIntegral :: Int -> Word16) genPrim PrimWord32 f = f (randomR (0, 0xffffffff)) (fromInteger)@@ -110,6 +113,7 @@ genPrim p _ = error ("getRandomPrimFromRandomGenRef: genPrim called for unsupported prim " ++ show p) {-# INLINE getThing #-}+ getThing :: forall a b. (g -> (a, g)) -> (a -> b) -> m b getThing thing f = atomicModifyReference ref $ \(!oldMT) -> case thing oldMT of (!w, !newMT) -> (newMT, f w) @@ -124,11 +128,15 @@ -- for a 'StdGen' generator instead of a 'PureMT' generator. {-# SPECIALIZE getRandomPrimFromRandomGenState :: Prim a -> State StdGen a #-} {-# SPECIALIZE getRandomPrimFromRandomGenState :: Monad m => Prim a -> StateT StdGen m a #-}-getRandomPrimFromRandomGenState :: (RandomGen g, MonadState g m) => Prim a -> m a+getRandomPrimFromRandomGenState :: + forall g m t.+ (RandomGen g, MonadState g m) + => Prim t -> m t getRandomPrimFromRandomGenState prim = runPromptM genSupported (decomposePrimWhere supported prim) where {-# INLINE genSupported #-}+ genSupported :: forall a. Prim a -> m a genSupported prim = genPrim prim getThing {-# INLINE supported #-}@@ -142,7 +150,7 @@ supported _ = False {-# INLINE genPrim #-}- genPrim :: (RandomGen g) => Prim a -> (forall b. (g -> (b, g)) -> (b -> a) -> c) -> c+ genPrim :: Prim a -> (forall b. (g -> (b, g)) -> (b -> a) -> c) -> c genPrim PrimWord8 f = f (randomR (0, 0xff)) (fromIntegral :: Int -> Word8) genPrim PrimWord16 f = f (randomR (0, 0xffff)) (fromIntegral :: Int -> Word16) genPrim PrimWord32 f = f (randomR (0, 0xffffffff)) (fromInteger)@@ -156,6 +164,7 @@ genPrim p _ = error ("getRandomPrimFromRandomGenState: genPrim called for unsupported prim " ++ show p) {-# INLINE getThing #-}+ getThing :: forall a b. (g -> (a, g)) -> (a -> b) -> m b getThing thing f = do !oldGen <- get case thing oldGen of