packages feed

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 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