Commits

Aleksey Khudyakov  committed 9edf6b2

Drop code for combinators. They are to be superceded by
condensed tables in mwc-random

  • Participants
  • Parent commits 5c712d5

Comments (0)

Files changed (1)

File System/Random/MWC/Monad.hs

                                , uniformR
                                , standard
                                , normal
-                                 -- * Combining monads 
-                               , equiprobable
-                               , choices
                                  -- * Seed management
                                , save
                                ) where
 
 ----------------------------------------------------------------
 
--- | 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 #-}
-
-
-
-----------------------------------------------------------------
-
 -- | Save current seed for future reuse
 save :: PrimMonad m => Rand m Seed
 save = Rand MWC.save