{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
-- |
-- Module    : Statistics.Distribution.StudentT
-- Copyright : (c) 2011 Aleksey Khudyakov
-- License   : BSD3
--
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : portable
--
-- Student-T distribution
module Statistics.Distribution.StudentT (
    StudentT
    -- * Constructors
  , studentT
  , studentTE
  , studentTUnstandardized
    -- * Accessors
  , studentTndf
  ) where

import Control.Applicative
import Data.Aeson          (FromJSON(..), ToJSON, Value(..), (.:))
import Data.Binary         (Binary(..))
import Data.Data           (Data, Typeable)
import GHC.Generics        (Generic)
import Numeric.SpecFunctions (
  logBeta, incompleteBeta, invIncompleteBeta, digamma)

import qualified Statistics.Distribution as D
import Statistics.Distribution.Transform (LinearTransform (..))
import Statistics.Internal


-- | Student-T distribution
newtype StudentT = StudentT { StudentT -> Double
studentTndf :: Double }
                   deriving (StudentT -> StudentT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StudentT -> StudentT -> Bool
$c/= :: StudentT -> StudentT -> Bool
== :: StudentT -> StudentT -> Bool
$c== :: StudentT -> StudentT -> Bool
Eq, Typeable, Typeable StudentT
StudentT -> DataType
StudentT -> Constr
(forall b. Data b => b -> b) -> StudentT -> StudentT
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> StudentT -> u
forall u. (forall d. Data d => d -> u) -> StudentT -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StudentT -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StudentT -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StudentT -> m StudentT
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StudentT -> m StudentT
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StudentT
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StudentT -> c StudentT
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StudentT)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StudentT)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StudentT -> m StudentT
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StudentT -> m StudentT
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StudentT -> m StudentT
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StudentT -> m StudentT
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StudentT -> m StudentT
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StudentT -> m StudentT
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StudentT -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StudentT -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> StudentT -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StudentT -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StudentT -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StudentT -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StudentT -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StudentT -> r
gmapT :: (forall b. Data b => b -> b) -> StudentT -> StudentT
$cgmapT :: (forall b. Data b => b -> b) -> StudentT -> StudentT
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StudentT)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StudentT)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StudentT)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StudentT)
dataTypeOf :: StudentT -> DataType
$cdataTypeOf :: StudentT -> DataType
toConstr :: StudentT -> Constr
$ctoConstr :: StudentT -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StudentT
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StudentT
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StudentT -> c StudentT
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StudentT -> c StudentT
Data, forall x. Rep StudentT x -> StudentT
forall x. StudentT -> Rep StudentT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StudentT x -> StudentT
$cfrom :: forall x. StudentT -> Rep StudentT x
Generic)

instance Show StudentT where
  showsPrec :: Int -> StudentT -> ShowS
showsPrec Int
i (StudentT Double
ndf) = forall a. Show a => [Char] -> a -> Int -> ShowS
defaultShow1 [Char]
"studentT" Double
ndf Int
i
instance Read StudentT where
  readPrec :: ReadPrec StudentT
readPrec = forall a r. Read a => [Char] -> (a -> Maybe r) -> ReadPrec r
defaultReadPrecM1 [Char]
"studentT" Double -> Maybe StudentT
studentTE

instance ToJSON StudentT
instance FromJSON StudentT where
  parseJSON :: Value -> Parser StudentT
parseJSON (Object Object
v) = do
    Double
ndf <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"studentTndf"
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ Double -> [Char]
errMsg Double
ndf) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Maybe StudentT
studentTE Double
ndf
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

instance Binary StudentT where
  put :: StudentT -> Put
put = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. StudentT -> Double
studentTndf
  get :: Get StudentT
get = do
    Double
ndf <- forall t. Binary t => Get t
get
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ Double -> [Char]
errMsg Double
ndf) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> Maybe StudentT
studentTE Double
ndf

-- | Create Student-T distribution. Number of parameters must be positive.
studentT :: Double -> StudentT
studentT :: Double -> StudentT
studentT Double
ndf = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Double -> [Char]
errMsg Double
ndf) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Double -> Maybe StudentT
studentTE Double
ndf

-- | Create Student-T distribution. Number of parameters must be positive.
studentTE :: Double -> Maybe StudentT
studentTE :: Double -> Maybe StudentT
studentTE Double
ndf
  | Double
ndf forall a. Ord a => a -> a -> Bool
> Double
0   = forall a. a -> Maybe a
Just (Double -> StudentT
StudentT Double
ndf)
  | Bool
otherwise = forall a. Maybe a
Nothing

errMsg :: Double -> String
errMsg :: Double -> [Char]
errMsg Double
_ = forall a. [Char] -> [Char] -> a
modErr [Char]
"studentT" [Char]
"non-positive number of degrees of freedom"


instance D.Distribution StudentT where
  cumulative :: StudentT -> Double -> Double
cumulative      = StudentT -> Double -> Double
cumulative
  complCumulative :: StudentT -> Double -> Double
complCumulative = StudentT -> Double -> Double
complCumulative

instance D.ContDistr StudentT where
  density :: StudentT -> Double -> Double
density    d :: StudentT
d@(StudentT Double
ndf) Double
x = forall a. Floating a => a -> a
exp (StudentT -> Double -> Double
logDensityUnscaled StudentT
d Double
x) forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
sqrt Double
ndf
  logDensity :: StudentT -> Double -> Double
logDensity d :: StudentT
d@(StudentT Double
ndf) Double
x = StudentT -> Double -> Double
logDensityUnscaled StudentT
d Double
x forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
log (forall a. Floating a => a -> a
sqrt Double
ndf)
  quantile :: StudentT -> Double -> Double
quantile = StudentT -> Double -> Double
quantile

cumulative :: StudentT -> Double -> Double
cumulative :: StudentT -> Double -> Double
cumulative (StudentT Double
ndf) Double
x
  | Double
x forall a. Ord a => a -> a -> Bool
> Double
0     = Double
1 forall a. Num a => a -> a -> a
- Double
0.5 forall a. Num a => a -> a -> a
* Double
ibeta
  | Bool
otherwise = Double
0.5 forall a. Num a => a -> a -> a
* Double
ibeta
  where
    ibeta :: Double
ibeta = Double -> Double -> Double -> Double
incompleteBeta (Double
0.5 forall a. Num a => a -> a -> a
* Double
ndf) Double
0.5 (Double
ndf forall a. Fractional a => a -> a -> a
/ (Double
ndf forall a. Num a => a -> a -> a
+ Double
xforall a. Num a => a -> a -> a
*Double
x))

complCumulative :: StudentT -> Double -> Double
complCumulative :: StudentT -> Double -> Double
complCumulative (StudentT Double
ndf) Double
x
  | Double
x forall a. Ord a => a -> a -> Bool
> Double
0     = Double
0.5 forall a. Num a => a -> a -> a
* Double
ibeta
  | Bool
otherwise = Double
1 forall a. Num a => a -> a -> a
- Double
0.5 forall a. Num a => a -> a -> a
* Double
ibeta
  where
    ibeta :: Double
ibeta = Double -> Double -> Double -> Double
incompleteBeta (Double
0.5 forall a. Num a => a -> a -> a
* Double
ndf) Double
0.5 (Double
ndf forall a. Fractional a => a -> a -> a
/ (Double
ndf forall a. Num a => a -> a -> a
+ Double
xforall a. Num a => a -> a -> a
*Double
x))


logDensityUnscaled :: StudentT -> Double -> Double
logDensityUnscaled :: StudentT -> Double -> Double
logDensityUnscaled (StudentT Double
ndf) Double
x =
    forall a. Floating a => a -> a
log (Double
ndf forall a. Fractional a => a -> a -> a
/ (Double
ndf forall a. Num a => a -> a -> a
+ Double
xforall a. Num a => a -> a -> a
*Double
x)) forall a. Num a => a -> a -> a
* (Double
0.5 forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
+ Double
ndf)) forall a. Num a => a -> a -> a
- Double -> Double -> Double
logBeta Double
0.5 (Double
0.5 forall a. Num a => a -> a -> a
* Double
ndf)

quantile :: StudentT -> Double -> Double
quantile :: StudentT -> Double -> Double
quantile (StudentT Double
ndf) Double
p
  | Double
p forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
p forall a. Ord a => a -> a -> Bool
<= Double
1 =
    let x :: Double
x = Double -> Double -> Double -> Double
invIncompleteBeta (Double
0.5 forall a. Num a => a -> a -> a
* Double
ndf) Double
0.5 (Double
2 forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
min Double
p (Double
1 forall a. Num a => a -> a -> a
- Double
p))
    in case forall a. Floating a => a -> a
sqrt forall a b. (a -> b) -> a -> b
$ Double
ndf forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- Double
x) forall a. Fractional a => a -> a -> a
/ Double
x of
         Double
r | Double
p forall a. Ord a => a -> a -> Bool
< Double
0.5   -> -Double
r
           | Bool
otherwise -> Double
r
  | Bool
otherwise = forall a. [Char] -> [Char] -> a
modErr [Char]
"quantile" forall a b. (a -> b) -> a -> b
$ [Char]
"p must be in [0,1] range. Got: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Double
p


instance D.MaybeMean StudentT where
  maybeMean :: StudentT -> Maybe Double
maybeMean (StudentT Double
ndf) | Double
ndf forall a. Ord a => a -> a -> Bool
> Double
1   = forall a. a -> Maybe a
Just Double
0
                           | Bool
otherwise = forall a. Maybe a
Nothing

instance D.MaybeVariance StudentT where
  maybeVariance :: StudentT -> Maybe Double
maybeVariance (StudentT Double
ndf) | Double
ndf forall a. Ord a => a -> a -> Bool
> Double
2   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Double
ndf forall a. Fractional a => a -> a -> a
/ (Double
ndf forall a. Num a => a -> a -> a
- Double
2)
                               | Bool
otherwise = forall a. Maybe a
Nothing

instance D.Entropy StudentT where
  entropy :: StudentT -> Double
entropy (StudentT Double
ndf) =
    Double
0.5 forall a. Num a => a -> a -> a
* (Double
ndfforall a. Num a => a -> a -> a
+Double
1) forall a. Num a => a -> a -> a
* (Double -> Double
digamma ((Double
1forall a. Num a => a -> a -> a
+Double
ndf)forall a. Fractional a => a -> a -> a
/Double
2) forall a. Num a => a -> a -> a
- Double -> Double
digamma(Double
ndfforall a. Fractional a => a -> a -> a
/Double
2))
    forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
log (forall a. Floating a => a -> a
sqrt Double
ndf)
    forall a. Num a => a -> a -> a
+ Double -> Double -> Double
logBeta (Double
ndfforall a. Fractional a => a -> a -> a
/Double
2) Double
0.5

instance D.MaybeEntropy StudentT where
  maybeEntropy :: StudentT -> Maybe Double
maybeEntropy = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Entropy d => d -> Double
D.entropy

instance D.ContGen StudentT where
  genContVar :: forall g (m :: * -> *).
StatefulGen g m =>
StudentT -> g -> m Double
genContVar = forall d g (m :: * -> *).
(ContDistr d, StatefulGen g m) =>
d -> g -> m Double
D.genContinuous

-- | Create an unstandardized Student-t distribution.
studentTUnstandardized :: Double -- ^ Number of degrees of freedom
                       -> Double -- ^ Central value (0 for standard Student T distribution)
                       -> Double -- ^ Scale parameter
                       -> LinearTransform StudentT
studentTUnstandardized :: Double -> Double -> Double -> LinearTransform StudentT
studentTUnstandardized Double
ndf Double
mu Double
sigma
  | Double
sigma forall a. Ord a => a -> a -> Bool
> Double
0 = forall d. Double -> Double -> d -> LinearTransform d
LinearTransform Double
mu Double
sigma forall a b. (a -> b) -> a -> b
$ Double -> StudentT
studentT Double
ndf
  | Bool
otherwise = forall a. [Char] -> [Char] -> a
modErr [Char]
"studentTUnstandardized" forall a b. (a -> b) -> a -> b
$ [Char]
"sigma must be > 0. Got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
sigma

modErr :: String -> String -> a
modErr :: forall a. [Char] -> [Char] -> a
modErr [Char]
fun [Char]
msg = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Statistics.Distribution.StudentT." forall a. [a] -> [a] -> [a]
++ [Char]
fun forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
msg