Triangular.hs

{-# LANGUAGE DeriveDataTypeable #-}
-- |
-- Module    : Statistics.Distribution.Triangular
-- Copyright : (c) 2010 Karamaan Group
--
-- The triangular distribution. This is the distribution of a random 
-- variable with lower limit a, mode c and upper limit b.

module Statistics.Distribution.Triangular
    (
      TriangularDistribution
    -- * Constructors
    , fromParams
    -- * Accessors
    , tridistA
    , tridistB
    , tridistC
    ) where

import Data.Generics
import qualified Statistics.Distribution as D

data TriangularDistribution = TriDist {
  tridistA :: Double, -- min
  tridistB :: Double, -- max
  tridistC :: Double  -- mode
} deriving (Eq, Read, Show, Typeable, Data)

instance D.Distribution TriangularDistribution where
  density (TriDist a b c) x
    | (a <= x) && (x <= c) = (2 * (x - a)) / ((b - a) * (c - a))
    | (c <= x) && (x <= b) = (2 * (b - x)) / ((b - a) * (b - c))
    | otherwise         = 0
  {-# INLINE density #-}

  cumulative (TriDist a b c) x
    | a > x             = 0
    | (a <= x) && (x <= c) = ((x - a) ^ 2) / ((b - a) * (c - a))
    | (c <= x) && (x <= b) = 1 - ((b - x) ^ 2) / ((b - a) * (b - c))
    | otherwise         = 1
  {-# INLINE cumulative #-}

  quantile (TriDist a b c) p   = calc ((c - a) / (b - a))
    where calc p0
            | p < p0    = sqrt ((b-a) * (c-a) * p) + a
            | p == p0   = c
            | otherwise = b - sqrt ((b-a) * (b-c) * (1-p))
  {-# INLINE quantile #-}

instance D.Variance TriangularDistribution where
    variance (TriDist a b c) =
      (a^2 + b^2 + c^2 - (a*b) - (a*c) - (b*c)) / 18
    {-# INLINE variance #-}

instance D.Mean TriangularDistribution where
    mean (TriDist a b c) = (a + b + c) / 3
    {-# INLINE mean #-}

fromParams :: Double -> Double -> Double -> TriangularDistribution
fromParams a b c 
    | (c > b) || (c < a) = error $ "Triangular Distribution: Parameter " ++ (show c)
                          ++ " is expected to be between the parameters " 
                          ++ (show a) ++ " and " ++ (show b) ++ "."
    | b < a             = error $ "Triangular Distribution: Parameter " ++ (show b)
                          ++ " is expected to be greater than parameter " ++ (show a) ++ "."
    | otherwise         = TriDist a b c
{-# INLINE fromParams #-}