-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Random.Distribution.Gamma
-- Copyright   :  (c) Matthew Donadio 2003
-- License     :  GPL
--
-- Maintainer  :  m.p.donadio@ieee.org
-- Stability   :  experimental
-- Portability :  portable
--
-- UNTESTED
--
-- Module for transforming a list of uniform random variables into a
-- list of gamma random variables.
--
-- @ f(x) = lambda * exp(-lambda*x) * (lambda * x)^(t-1) \/ Gamma(t) @
--
-- Reference: Ross
--
----------------------------------------------------------------------------

module Numeric.Random.Distribution.Gamma (gamma) where

-- * Functions

-- | Generates a list of gamma random variables from a list
-- of uniforms via the inverse transformation method

gamma :: Int       -- ^ n
      -> Double    -- ^ lambda
      -> [Double]  -- ^ U
      -> [Double]  -- ^ X

gamma :: Int -> Double -> [Double] -> [Double]
gamma Int
n Double
lambda [Double]
u = Double
x forall a. a -> [a] -> [a]
: Int -> Double -> [Double] -> [Double]
gamma Int
n Double
lambda [Double]
u'
    where x :: Double
x = -forall a. Floating a => a -> a
log (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (forall a. Int -> [a] -> [a]
take Int
n [Double]
u)) forall a. Fractional a => a -> a -> a
/ Double
lambda
	  u' :: [Double]
u' = forall a. Int -> [a] -> [a]
drop Int
n [Double]
u