{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
module Statistics.Distribution.StudentT (
StudentT
, studentT
, studentTE
, studentTUnstandardized
, 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
newtype StudentT = StudentT { StudentT -> Double
studentTndf :: Double }
deriving (StudentT -> StudentT -> Bool
(StudentT -> StudentT -> Bool)
-> (StudentT -> StudentT -> Bool) -> Eq StudentT
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
Constr
DataType
Typeable StudentT =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StudentT -> c StudentT)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StudentT)
-> (StudentT -> Constr)
-> (StudentT -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> StudentT -> StudentT)
-> (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 u. (forall d. Data d => d -> u) -> StudentT -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> StudentT -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StudentT -> m StudentT)
-> Data StudentT
StudentT -> Constr
StudentT -> DataType
(forall b. Data b => b -> b) -> StudentT -> StudentT
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StudentT -> c StudentT
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cStudentT :: Constr
$tStudentT :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> StudentT -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StudentT -> u
gmapQ :: (forall d. Data d => d -> u) -> StudentT -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StudentT -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable StudentT
Data, (forall x. StudentT -> Rep StudentT x)
-> (forall x. Rep StudentT x -> StudentT) -> Generic StudentT
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 i :: Int
i (StudentT ndf :: Double
ndf) = String -> Double -> Int -> ShowS
forall a. Show a => String -> a -> Int -> ShowS
defaultShow1 "studentT" Double
ndf Int
i
instance Read StudentT where
readPrec :: ReadPrec StudentT
readPrec = String -> (Double -> Maybe StudentT) -> ReadPrec StudentT
forall a r. Read a => String -> (a -> Maybe r) -> ReadPrec r
defaultReadPrecM1 "studentT" Double -> Maybe StudentT
studentTE
instance ToJSON StudentT
instance FromJSON StudentT where
parseJSON :: Value -> Parser StudentT
parseJSON (Object v :: Object
v) = do
Double
ndf <- Object
v Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: "studentTndf"
Parser StudentT
-> (StudentT -> Parser StudentT)
-> Maybe StudentT
-> Parser StudentT
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser StudentT
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser StudentT) -> String -> Parser StudentT
forall a b. (a -> b) -> a -> b
$ Double -> String
errMsg Double
ndf) StudentT -> Parser StudentT
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StudentT -> Parser StudentT)
-> Maybe StudentT -> Parser StudentT
forall a b. (a -> b) -> a -> b
$ Double -> Maybe StudentT
studentTE Double
ndf
parseJSON _ = Parser StudentT
forall (f :: * -> *) a. Alternative f => f a
empty
instance Binary StudentT where
put :: StudentT -> Put
put = Double -> Put
forall t. Binary t => t -> Put
put (Double -> Put) -> (StudentT -> Double) -> StudentT -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StudentT -> Double
studentTndf
get :: Get StudentT
get = do
Double
ndf <- Get Double
forall t. Binary t => Get t
get
Get StudentT
-> (StudentT -> Get StudentT) -> Maybe StudentT -> Get StudentT
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get StudentT
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get StudentT) -> String -> Get StudentT
forall a b. (a -> b) -> a -> b
$ Double -> String
errMsg Double
ndf) StudentT -> Get StudentT
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StudentT -> Get StudentT) -> Maybe StudentT -> Get StudentT
forall a b. (a -> b) -> a -> b
$ Double -> Maybe StudentT
studentTE Double
ndf
studentT :: Double -> StudentT
studentT :: Double -> StudentT
studentT ndf :: Double
ndf = StudentT -> (StudentT -> StudentT) -> Maybe StudentT -> StudentT
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> StudentT
forall a. HasCallStack => String -> a
error (String -> StudentT) -> String -> StudentT
forall a b. (a -> b) -> a -> b
$ Double -> String
errMsg Double
ndf) StudentT -> StudentT
forall a. a -> a
id (Maybe StudentT -> StudentT) -> Maybe StudentT -> StudentT
forall a b. (a -> b) -> a -> b
$ Double -> Maybe StudentT
studentTE Double
ndf
studentTE :: Double -> Maybe StudentT
studentTE :: Double -> Maybe StudentT
studentTE ndf :: Double
ndf
| Double
ndf Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = StudentT -> Maybe StudentT
forall a. a -> Maybe a
Just (Double -> StudentT
StudentT Double
ndf)
| Bool
otherwise = Maybe StudentT
forall a. Maybe a
Nothing
errMsg :: Double -> String
errMsg :: Double -> String
errMsg _ = String -> ShowS
forall a. String -> String -> a
modErr "studentT" "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 ndf :: Double
ndf) x :: Double
x = Double -> Double
forall a. Floating a => a -> a
exp (StudentT -> Double -> Double
logDensityUnscaled StudentT
d Double
x) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sqrt Double
ndf
logDensity :: StudentT -> Double -> Double
logDensity d :: StudentT
d@(StudentT ndf :: Double
ndf) x :: Double
x = StudentT -> Double -> Double
logDensityUnscaled StudentT
d Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
log (Double -> Double
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 ndf :: Double
ndf) x :: Double
x
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = 1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- 0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ibeta
| Bool
otherwise = 0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ibeta
where
ibeta :: Double
ibeta = Double -> Double -> Double -> Double
incompleteBeta (0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ndf) 0.5 (Double
ndf Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
ndf Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x))
complCumulative :: StudentT -> Double -> Double
complCumulative :: StudentT -> Double -> Double
complCumulative (StudentT ndf :: Double
ndf) x :: Double
x
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = 0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ibeta
| Bool
otherwise = 1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- 0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ibeta
where
ibeta :: Double
ibeta = Double -> Double -> Double -> Double
incompleteBeta (0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ndf) 0.5 (Double
ndf Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
ndf Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x))
logDensityUnscaled :: StudentT -> Double -> Double
logDensityUnscaled :: StudentT -> Double -> Double
logDensityUnscaled (StudentT ndf :: Double
ndf) x :: Double
x =
Double -> Double
forall a. Floating a => a -> a
log (Double
ndf Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
ndf Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ndf)) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
logBeta 0.5 (0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ndf)
quantile :: StudentT -> Double -> Double
quantile :: StudentT -> Double -> Double
quantile (StudentT ndf :: Double
ndf) p :: Double
p
| Double
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Double
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 =
let x :: Double
x = Double -> Double -> Double -> Double
invIncompleteBeta (0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ndf) 0.5 (2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
p (1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
p))
in case Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
ndf Double -> Double -> Double
forall a. Num a => a -> a -> a
* (1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
x of
r :: Double
r | Double
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0.5 -> -Double
r
| Bool
otherwise -> Double
r
| Bool
otherwise = String -> String -> Double
forall a. String -> String -> a
modErr "quantile" (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ "p must be in [0,1] range. Got: "String -> ShowS
forall a. [a] -> [a] -> [a]
++Double -> String
forall a. Show a => a -> String
show Double
p
instance D.MaybeMean StudentT where
maybeMean :: StudentT -> Maybe Double
maybeMean (StudentT ndf :: Double
ndf) | Double
ndf Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 1 = Double -> Maybe Double
forall a. a -> Maybe a
Just 0
| Bool
otherwise = Maybe Double
forall a. Maybe a
Nothing
instance D.MaybeVariance StudentT where
maybeVariance :: StudentT -> Maybe Double
maybeVariance (StudentT ndf :: Double
ndf) | Double
ndf Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 2 = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$! Double
ndf Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
ndf Double -> Double -> Double
forall a. Num a => a -> a -> a
- 2)
| Bool
otherwise = Maybe Double
forall a. Maybe a
Nothing
instance D.Entropy StudentT where
entropy :: StudentT -> Double
entropy (StudentT ndf :: Double
ndf) =
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
ndfDouble -> Double -> Double
forall a. Num a => a -> a -> a
+1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double
digamma ((1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
ndf)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
digamma(Double
ndfDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2))
Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
log (Double -> Double
forall a. Floating a => a -> a
sqrt Double
ndf)
Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double -> Double
logBeta (Double
ndfDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2) 0.5
instance D.MaybeEntropy StudentT where
maybeEntropy :: StudentT -> Maybe Double
maybeEntropy = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double)
-> (StudentT -> Double) -> StudentT -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StudentT -> Double
forall d. Entropy d => d -> Double
D.entropy
instance D.ContGen StudentT where
genContVar :: StudentT -> Gen (PrimState m) -> m Double
genContVar = StudentT -> Gen (PrimState m) -> m Double
forall d (m :: * -> *).
(ContDistr d, PrimMonad m) =>
d -> Gen (PrimState m) -> m Double
D.genContinuous
studentTUnstandardized :: Double
-> Double
-> Double
-> LinearTransform StudentT
studentTUnstandardized :: Double -> Double -> Double -> LinearTransform StudentT
studentTUnstandardized ndf :: Double
ndf mu :: Double
mu sigma :: Double
sigma
| Double
sigma Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Double -> Double -> StudentT -> LinearTransform StudentT
forall d. Double -> Double -> d -> LinearTransform d
LinearTransform Double
mu Double
sigma (StudentT -> LinearTransform StudentT)
-> StudentT -> LinearTransform StudentT
forall a b. (a -> b) -> a -> b
$ Double -> StudentT
studentT Double
ndf
| Bool
otherwise = String -> String -> LinearTransform StudentT
forall a. String -> String -> a
modErr "studentTUnstandardized" (String -> LinearTransform StudentT)
-> String -> LinearTransform StudentT
forall a b. (a -> b) -> a -> b
$ "sigma must be > 0. Got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
sigma
modErr :: String -> String -> a
modErr :: String -> String -> a
modErr fun :: String
fun msg :: String
msg = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "Statistics.Distribution.StudentT." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fun String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg