mwc-random-monad 0.1 → 0.2
raw patch · 2 files changed
+66/−3 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ System.Random.MWC.Monad: choices :: PrimMonad m => [(Double, Rand m a)] -> Rand m a
+ System.Random.MWC.Monad: equiprobable :: PrimMonad m => [Rand m a] -> Rand m a
+ System.Random.MWC.Monad: liftR :: PrimMonad m => m a -> Rand m a
- System.Random.MWC.Monad: runWithVector :: PrimMonad m => Rand m a -> Vector Word32 -> m a
+ System.Random.MWC.Monad: runWithVector :: (Vector v Word32, PrimMonad m) => Rand m a -> v Word32 -> m a
Files
- System/Random/MWC/Monad.hs +65/−2
- mwc-random-monad.cabal +1/−1
System/Random/MWC/Monad.hs view
@@ -1,5 +1,7 @@+{-# LANGUAGE FlexibleContexts #-} module System.Random.MWC.Monad ( -- * Random monad Rand+ , liftR , RandIO , asRandIO , RandST@@ -15,6 +17,9 @@ , uniformR , standard , normal+ -- * Combining monads + , equiprobable+ , choices -- * Seed management , save ) where@@ -24,8 +29,12 @@ import Control.Monad.ST (ST) import Control.Monad.Primitive (PrimMonad, PrimState) -import Data.Vector.Unboxed (Vector)+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Generic as G+import Data.Ord import Data.Word (Word32)+import Debug.Trace import qualified System.Random.MWC as MWC import System.Random.MWC (Gen,Variate,Seed)@@ -38,6 +47,11 @@ runRand :: Gen (PrimState m) -> m a } +-- | Lift monadic action into 'Rand' monad+liftR :: PrimMonad m => m a -> Rand m a+liftR m = Rand $ const m+{-# INLINE liftR #-}+ -- | Type synonim for ST-based Rand monad type RandST s a = Rand (ST s) a @@ -60,7 +74,7 @@ {-# INLINE runWithCreate #-} -- | By creating seed from vector of values-runWithVector :: PrimMonad m => Rand m a -> Vector Word32 -> m a+runWithVector :: (G.Vector v Word32, PrimMonad m) => Rand m a -> v Word32 -> m a runWithVector m v = runRand m =<< MWC.initialize v {-# INLINE runWithVector #-} @@ -119,6 +133,55 @@ -> Rand m Double normal m s = (+ m) . (* s) <$> standard {-# INLINE standard #-}++----------------------------------------------------------------++-- | Randomly select from list of equiprobable random sources. List must be non-empty+equiprobable :: PrimMonad m => [Rand m a] -> Rand m a+equiprobable [] = error "System.Random.MWC.Monad.equiprobable: list must be nonempty"+equiprobable xs = worker (V.fromList xs)+ where+ worker v = do+ -- uniform - 2^(-53) lies in the [0,1) range+ p <- uniform+ v V.! truncate ((p - 2^^(-53)) * fromIntegral (V.length v) :: Double)+ +-- | Randomly select from list of weighted random sources. List must+-- contain sources with positive weight. Elements with non-positive+-- weight are discarded+choices :: PrimMonad m => [(Double,Rand m a)] -> Rand m a+choices xs+ | null xs' = error "System.Random.MWC.Monad.choices: list must contain at least one nonnegative weight"+ | otherwise = traceShow (ps, V.length vect) + $ worker vect ps+ where+ xs' = filter ((>0) . fst) xs+ vect = V.fromList (map snd xs')+ ps = U.init . U.scanl' (+) 0 $ U.map (/ U.sum q) q+ where q = U.fromList (map fst xs')+ worker vect probs = do+ p <- uniform+ let i = binary probs p+ vect V.! (i - 1)++-- Binary search /Copied from vector algorithms+binary :: (Ord a, U.Unbox a) => U.Vector a -> a -> Int+binary v x = binaryRange v x 0 (U.length v)+{-# INLINE binary #-}++-- Binary search in range+binaryRange :: (Ord a, U.Unbox a) => U.Vector a -> a -> Int -> Int -> Int+binaryRange v x = loop + where+ loop i j | i >= j = j+ | otherwise = case compare (U.unsafeIndex v k) x of+ LT -> loop (k+1) j+ EQ -> k + GT -> loop i k+ where k = (i + j) `div` 2+{-# INLINE binaryRange #-}++ ----------------------------------------------------------------
mwc-random-monad.cabal view
@@ -1,5 +1,5 @@ Name: mwc-random-monad-Version: 0.1+Version: 0.2 Synopsis: Monadic interface for mwc-random License: BSD3 License-file: LICENSE