random-fu 0.2.1.0 → 0.2.1.1
raw patch · 11 files changed
+75/−46 lines, 11 filesdep ~base
Dependency ranges changed: base
Files
- random-fu.cabal +9/−2
- src/Data/Random/Distribution/Bernoulli.hs +1/−1
- src/Data/Random/Distribution/Beta.hs +1/−1
- src/Data/Random/Distribution/Categorical.hs +30/−21
- src/Data/Random/Distribution/Exponential.hs +1/−1
- src/Data/Random/Distribution/Gamma.hs +2/−2
- src/Data/Random/Distribution/Multinomial.hs +1/−1
- src/Data/Random/Distribution/Poisson.hs +1/−1
- src/Data/Random/Distribution/Rayleigh.hs +1/−1
- src/Data/Random/Distribution/Uniform.hs +3/−3
- src/Data/Random/List.hs +25/−12
random-fu.cabal view
@@ -1,5 +1,5 @@ name: random-fu-version: 0.2.1.0+version: 0.2.1.1 stability: provisional cabal-version: >= 1.6@@ -29,6 +29,11 @@ a fair bit slower than straight C implementations of the same algorithms. .+ Changes in 0.2.1.1: Changed some one-field data types+ to newtypes, updated types for GHC 7.4's removal of Eq + and Show from the context of Num, and added RVarT versions+ of random variables in Data.Random.List+ . Changes in 0.2.1.0: Exposed Categorical type (it had been hidden by accident a few version ago), gave it a Read instance, and dropped a @@ -45,7 +50,8 @@ new random-fu. The end-user interface is mostly the same. tested-with: GHC == 6.10.4, GHC == 6.12.1, GHC == 6.12.3,- GHC == 7.0.1, GHC == 7.0.2, GHC == 7.0.4+ GHC == 7.0.1, GHC == 7.0.2, GHC == 7.0.4,+ GHC == 7.2.2, GHC == 7.4.1-rc1 source-repository head type: git@@ -117,4 +123,5 @@ if impl(ghc == 7.2.1) -- Doesn't work under GHC 7.2.1 due to -- http://hackage.haskell.org/trac/ghc/ticket/5410+ -- (7.2.2 is fine though, as long as random-source is new enough) Buildable: False
src/Data/Random/Distribution/Bernoulli.hs view
@@ -53,7 +53,7 @@ | x `gte` f = cdf (Bernoulli p) False | otherwise = 0 -data Bernoulli b a = Bernoulli b+newtype Bernoulli b a = Bernoulli b instance (Fractional b, Ord b, Distribution StdUniform b) => Distribution (Bernoulli b) Bool
src/Data/Random/Distribution/Beta.hs view
@@ -16,7 +16,7 @@ {-# SPECIALIZE fractionalBeta :: Float -> Float -> RVarT m Float #-} {-# SPECIALIZE fractionalBeta :: Double -> Double -> RVarT m Double #-}-fractionalBeta :: (Fractional a, Distribution Gamma a, Distribution StdUniform a) => a -> a -> RVarT m a+fractionalBeta :: (Fractional a, Eq a, Distribution Gamma a, Distribution StdUniform a) => a -> a -> RVarT m a fractionalBeta 1 1 = stdUniformT fractionalBeta a b = do x <- gammaT a 1
src/Data/Random/Distribution/Categorical.hs view
@@ -54,14 +54,14 @@ -- |Construct a 'Categorical' distribution from a list of weighted categories, -- where the weights do not necessarily sum to 1.-fromWeightedList :: Fractional p => [(p,a)] -> Categorical p a+fromWeightedList :: (Fractional p, Eq p) => [(p,a)] -> Categorical p a fromWeightedList = normalizeCategoricalPs . fromList -- |Construct a 'Categorical' distribution from a list of observed outcomes. -- Equivalent events will be grouped and counted, and the probabilities of each -- event in the returned distribution will be proportional to the number of -- occurrences of that event.-fromObservations :: (Fractional p, Ord a) => [a] -> Categorical p a+fromObservations :: (Fractional p, Eq p, Ord a) => [a] -> Categorical p a fromObservations = fromWeightedList . map (genericLength &&& head) . group . sort -- The following description refers to the public interface. For those reading@@ -73,11 +73,12 @@ -- The sum of the probabilities must be 1, and no event should have a zero -- or negative probability (at least, at time of sampling; very clever users -- can do what they want with the numbers before sampling, just make sure --- that if you're one of those clever ones, you normalize before sampling).+-- that if you're one of those clever ones, you at least eliminate negative +-- weights before sampling). newtype Categorical p a = Categorical (V.Vector (p, a)) deriving Eq -instance (Num p, Show a) => Show (Categorical p a) where+instance (Num p, Show p, Show a) => Show (Categorical p a) where showsPrec p cat = showParen (p>10) ( showString "fromList " . showsPrec 11 (toList cat)@@ -96,22 +97,29 @@ | otherwise = do u <- uniformT 0 (fst (V.last ds)) - let p i = fst (ds V.! i)+ let -- by construction, p is monotone; (i < j) ==> (p i <= p j)+ p i = fst (ds V.! i) x i = snd (ds V.! i) - -- find the smallest entry whose cumulative probability is- -- greater than or equal to u- -- invariant: p j >= u- -- variant: at every step, either i increases or j decreases.+ -- findEvent+ -- ===========+ -- invariants: (i <= j), (u <= p j), ((i == 0) || (p i < u))+ -- (the last one means 'i' does not increase unless it bounds 'p' below 'u')+ -- variant: either i increases or j decreases.+ -- upon termination: ∀ k. if (k < j) then (p k < u) else (u <= p k)+ -- (that is, the chosen event 'x j' is the first one whose + -- associated cumulative probability 'p j' is greater than + -- or equal to 'u') findEvent i j- | i >= j = x j- | p m >= u = findEvent i m+ | j <= i = x j+ | u <= p m = findEvent i m | otherwise = findEvent (max m (i+1)) j where -- midpoint rounding down+ -- (i < j) ==> (m < j) m = (i + j) `div` 2 - return (findEvent 0 (n-1))+ return $! if u <= 0 then x 0 else findEvent 0 (n-1) where n = V.length ds @@ -161,20 +169,20 @@ mapCategoricalPs f (Categorical ds) = Categorical (V.map (first f) ds) -- |Adjust all the weights of a categorical distribution so that they --- sum to unity.-normalizeCategoricalPs :: (Fractional p) => Categorical p e -> Categorical p e+-- sum to unity and remove all events whose probability is zero.+normalizeCategoricalPs :: (Fractional p, Eq p) => Categorical p e -> Categorical p e normalizeCategoricalPs orig@(Categorical ds) = if V.null ds then orig else runST $ do let n = V.length ds lastP <- newSTRef 0- dups <- newSTRef 0+ nDups <- newSTRef 0 normalized <- V.thaw ds - let skip = modifySTRef' dups (1+)+ let skip = modifySTRef' nDups (1+) save i p x = do- d <- readSTRef dups+ d <- readSTRef nDups MV.write normalized (i-d) (p, x) sequence_@@ -185,26 +193,27 @@ then skip else do save i (p * scale) x- writeSTRef lastP p+ writeSTRef lastP $! p | i <- [0..n-1] ] -- force last element to 1- d <- readSTRef dups+ d <- readSTRef nDups MV.write normalized (n-d-1) (1,lastX) Categorical <$> V.unsafeFreeze (MV.unsafeSlice 0 (n-d) normalized) where (ps, lastX) = V.last ds scale = recip ps +-- |strict 'modifySTRef' modifySTRef' :: STRef s a -> (a -> a) -> ST s () modifySTRef' x f = do v <- readSTRef x let fv = f v fv `seq` writeSTRef x fv --- |Simplify a categorical distribution by combining equivalent categories (the new--- category will have a probability equal to the sum of all the originals).+-- |Simplify a categorical distribution by combining equivalent events (the new+-- event will have a probability equal to the sum of all the originals). collectEvents :: (Ord e, Num p, Ord p) => Categorical p e -> Categorical p e collectEvents = collectEventsBy compare ((sum *** head) . unzip)
src/Data/Random/Distribution/Exponential.hs view
@@ -10,7 +10,7 @@ import Data.Random.Distribution import Data.Random.Distribution.Uniform -data Exponential a = Exp a+newtype Exponential a = Exp a floatingExponential :: (Floating a, Distribution StdUniform a) => a -> RVarT m a floatingExponential lambdaRecip = do
src/Data/Random/Distribution/Gamma.hs view
@@ -71,8 +71,8 @@ erlangT :: (Distribution (Erlang a) b) => a -> RVarT m b erlangT a = rvarT (Erlang a) -data Gamma a = Gamma a a-data Erlang a b = Erlang a+data Gamma a = Gamma a a+newtype Erlang a b = Erlang a instance (Floating a, Ord a, Distribution Normal a, Distribution StdUniform a) => Distribution Gamma a where {-# SPECIALIZE instance Distribution Gamma Double #-}
src/Data/Random/Distribution/Multinomial.hs view
@@ -14,7 +14,7 @@ data Multinomial p a where Multinomial :: [p] -> a -> Multinomial p [a] -instance (Num a, Fractional p, Distribution (Binomial p) a) => Distribution (Multinomial p) [a] where+instance (Num a, Eq a, Fractional p, Distribution (Binomial p) a) => Distribution (Multinomial p) [a] where -- TODO: implement faster version based on Categorical for small n, large (length ps) rvarT (Multinomial ps0 t) = go t ps0 (tailSums ps0) id where
src/Data/Random/Distribution/Poisson.hs view
@@ -62,7 +62,7 @@ poissonT :: (Distribution (Poisson b) a) => b -> RVarT m a poissonT mu = rvarT (Poisson mu) -data Poisson b a = Poisson b+newtype Poisson b a = Poisson b $( replicateInstances ''Int integralTypes [d| instance ( RealFloat b
src/Data/Random/Distribution/Rayleigh.hs view
@@ -10,7 +10,7 @@ import Data.Random.Distribution import Data.Random.Distribution.Uniform -floatingRayleigh :: (Floating a, Distribution StdUniform a) => a -> RVarT m a+floatingRayleigh :: (Floating a, Eq a, Distribution StdUniform a) => a -> RVarT m a floatingRayleigh s = do u <- stdUniformPosT return (s * sqrt (-2 * log u))
src/Data/Random/Distribution/Uniform.hs view
@@ -246,15 +246,15 @@ -- |Like 'stdUniform', but returns only positive or zero values. Not -- exported because it is not truly uniform: nonzero values are twice -- as likely as zero on signed types.-stdUniformNonneg :: (Distribution StdUniform a, Num a) => RVarT m a+stdUniformNonneg :: (Distribution StdUniform a, Num a, Eq a) => RVarT m a stdUniformNonneg = fmap abs stdUniformT -- |Like 'stdUniform' but only returns positive values.-stdUniformPos :: (Distribution StdUniform a, Num a) => RVar a+stdUniformPos :: (Distribution StdUniform a, Num a, Eq a) => RVar a stdUniformPos = stdUniformPosT -- |Like 'stdUniform' but only returns positive values.-stdUniformPosT :: (Distribution StdUniform a, Num a) => RVarT m a+stdUniformPosT :: (Distribution StdUniform a, Num a, Eq a) => RVarT m a stdUniformPosT = iterateUntil (/= 0) stdUniformNonneg -- |A definition of a uniform distribution over the type @t@. See also 'uniform'.
src/Data/Random/List.hs view
@@ -10,17 +10,24 @@ -- Every element has equal probability of being chosen. Because it is a -- pure 'RVar' it has no memory - that is, it \"draws with replacement.\" randomElement :: [a] -> RVar a-randomElement [] = error "randomElement: empty list!"-randomElement xs = do- n <- uniform 0 (length xs - 1)+randomElement = randomElementT+++randomElementT :: [a] -> RVarT m a+randomElementT [] = error "randomElementT: empty list!"+randomElementT xs = do+ n <- uniformT 0 (length xs - 1) return (xs !! n) -- | A random variable that returns the given list in an arbitrary shuffled -- order. Every ordering of the list has equal probability. shuffle :: [a] -> RVar [a]-shuffle [] = return []-shuffle xs = do- is <- zipWithM (\_ i -> uniform 0 i) (tail xs) [1..]+shuffle = shuffleT++shuffleT :: [a] -> RVarT m [a]+shuffleT [] = return []+shuffleT xs = do+ is <- zipWithM (\_ i -> uniformT 0 i) (tail xs) [1..] return (SRS.shuffle xs (reverse is)) @@ -29,15 +36,21 @@ -- the length is known in advance. Avoids needing to traverse the list to -- discover its length. Each ordering has equal probability. shuffleN :: Int -> [a] -> RVar [a]-shuffleN n xs = shuffleNofM n n xs+shuffleN = shuffleNT +shuffleNT :: Int -> [a] -> RVarT m [a]+shuffleNT n xs = shuffleNofMT n n xs+ -- | A random variable that selects N arbitrary elements of a list of known length M. shuffleNofM :: Int -> Int -> [a] -> RVar [a]-shuffleNofM 0 _ _ = return []-shuffleNofM n m xs- | n > m = error "shuffleNofM: n > m"+shuffleNofM = shuffleNofMT++shuffleNofMT :: Int -> Int -> [a] -> RVarT m [a]+shuffleNofMT 0 _ _ = return []+shuffleNofMT n m xs+ | n > m = error "shuffleNofMT: n > m" | n >= 0 = do- is <- sequence [uniform 0 i | i <- take n [m-1, m-2 ..1]]+ is <- sequence [uniformT 0 i | i <- take n [m-1, m-2 ..1]] return (take n $ SRS.shuffle (take m xs) is)-shuffleNofM _ _ _ = error "shuffleNofM: negative length specified"+shuffleNofMT _ _ _ = error "shuffleNofMT: negative length specified"