{-# LANGUAGE
        MultiParamTypeClasses, FlexibleInstances, FlexibleContexts,
        UndecidableInstances
  #-}

{-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints #-}

module Data.Random.Distribution.ChiSquare where

import Data.Random.RVar
import Data.Random.Distribution
import Data.Random.Distribution.Gamma

import Numeric.SpecFunctions

chiSquare :: Distribution ChiSquare t => Integer -> RVar t
chiSquare :: Integer -> RVar t
chiSquare = ChiSquare t -> RVar t
forall (d :: * -> *) t. Distribution d t => d t -> RVar t
rvar (ChiSquare t -> RVar t)
-> (Integer -> ChiSquare t) -> Integer -> RVar t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ChiSquare t
forall b. Integer -> ChiSquare b
ChiSquare

chiSquareT :: Distribution ChiSquare t => Integer -> RVarT m t
chiSquareT :: Integer -> RVarT m t
chiSquareT = ChiSquare t -> RVarT m t
forall (d :: * -> *) t (n :: * -> *).
Distribution d t =>
d t -> RVarT n t
rvarT (ChiSquare t -> RVarT m t)
-> (Integer -> ChiSquare t) -> Integer -> RVarT m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ChiSquare t
forall b. Integer -> ChiSquare b
ChiSquare

newtype ChiSquare b = ChiSquare Integer

instance (Fractional t, Distribution Gamma t) => Distribution ChiSquare t where
    rvarT :: ChiSquare t -> RVarT n t
rvarT (ChiSquare Integer
0) = t -> RVarT n t
forall (m :: * -> *) a. Monad m => a -> m a
return t
0
    rvarT (ChiSquare Integer
n)
        | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0     = t -> t -> RVarT n t
forall a (m :: * -> *). Distribution Gamma a => a -> a -> RVarT m a
gammaT (t
0.5 t -> t -> t
forall a. Num a => a -> a -> a
* Integer -> t
forall a. Num a => Integer -> a
fromInteger Integer
n) t
2
        | Bool
otherwise = [Char] -> RVarT n t
forall a. HasCallStack => [Char] -> a
error [Char]
"chi-square distribution: degrees of freedom must be positive"

instance (Real t, Distribution ChiSquare t) => CDF ChiSquare t where
    cdf :: ChiSquare t -> t -> Double
cdf (ChiSquare Integer
n) t
x = Double -> Double -> Double
incompleteGamma (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
n) (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* t -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac t
x)