Merge pull request #8 from bgamari/master

Add stretched exponential distribution
haskell-numerics · Jun 1, 2012 · 7f8a927 · 7f8a927
2 parents 21889b8 + dd6cf5f
commit 7f8a927
Show file tree

Hide file tree

Showing 2 changed files with 33 additions and 0 deletions.
diff --git a/random-fu/random-fu.cabal b/random-fu/random-fu.cabal
@@ -78,6 +78,7 @@ Library
                         Data.Random.Distribution.ChiSquare
                         Data.Random.Distribution.Dirichlet
                         Data.Random.Distribution.Exponential
+                        Data.Random.Distribution.StretchedExponential
                         Data.Random.Distribution.Gamma
                         Data.Random.Distribution.Multinomial
                         Data.Random.Distribution.Normal

diff --git a/random-fu/src/Data/Random/Distribution/StretchedExponential.hs b/random-fu/src/Data/Random/Distribution/StretchedExponential.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE
+    MultiParamTypeClasses,
+    FlexibleInstances, FlexibleContexts,
+    UndecidableInstances
+  #-}
+
+module Data.Random.Distribution.StretchedExponential where
+
+import Data.Random.RVar
+import Data.Random.Distribution
+import Data.Random.Distribution.Uniform
+
+newtype StretchedExponential a = StretchedExp (a,a)
+
+floatingStretchedExponential :: (Floating a, Distribution StdUniform a) => a -> a -> RVarT m a
+floatingStretchedExponential beta lambdaRecip = do
+    x <- stdUniformT
+    return (negate (log (1-x))**(1/beta) * lambdaRecip)
+
+floatingStretchedExponentialCDF :: Real a => a -> a -> a -> Double
+floatingStretchedExponentialCDF beta lambdaRecip x = 1 - exp (negate (realToFrac x / realToFrac lambdaRecip)**(realToFrac beta))
+
+stretchedExponential :: Distribution StretchedExponential a => a -> a -> RVar a
+stretchedExponential beta lambdaRecip = rvar $ StretchedExp (beta, lambdaRecip)
+
+stretchedExponentialT :: Distribution StretchedExponential a => a -> a -> RVarT m a
+stretchedExponentialT beta lambdaRecip = rvarT $ StretchedExp (beta, lambdaRecip)
+
+instance (Floating a, Distribution StdUniform a) => Distribution StretchedExponential a where
+    rvarT (StretchedExp (beta,lambdaRecip)) = floatingStretchedExponential beta lambdaRecip
+instance (Real a, Distribution StretchedExponential a) => CDF StretchedExponential a where
+    cdf  (StretchedExp (beta,lambdaRecip)) = floatingStretchedExponentialCDF beta lambdaRecip