module Gev.Frechet
    (
      FrechetDistribution
     -- * constructors
    , frechetDist
    , frechetDistMaybe
     -- * accessors
    , location
    , scale
    , shape
    ) where

import qualified Gev

data FrechetDistribution = Frechet {
      FrechetDistribution -> Double
location :: {-# UNPACK #-} !Double
    , FrechetDistribution -> Double
scale    :: {-# UNPACK #-} !Double
    , FrechetDistribution -> Double
shape    :: {-# UNPACK #-} !Double
    } deriving (FrechetDistribution -> FrechetDistribution -> Bool
(FrechetDistribution -> FrechetDistribution -> Bool)
-> (FrechetDistribution -> FrechetDistribution -> Bool)
-> Eq FrechetDistribution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrechetDistribution -> FrechetDistribution -> Bool
$c/= :: FrechetDistribution -> FrechetDistribution -> Bool
== :: FrechetDistribution -> FrechetDistribution -> Bool
$c== :: FrechetDistribution -> FrechetDistribution -> Bool
Eq)

instance Show FrechetDistribution where
    show :: FrechetDistribution -> String
show (Frechet Double
loc Double
sc Double
sh) = ShowS
forall a. Show a => a -> String
show String
"Frechet Distribution; loc: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", scale: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
sc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and shape: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
sh

-- error message when initiating Frechet with scale parameter less than 0.
frechetErrMsg :: Double -> Double -> Double -> String
frechetErrMsg :: Double -> Double -> Double -> String
frechetErrMsg Double
loc Double
scale Double
sh = String
"Gev.Frechet: " 
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"loc = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
loc
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" scale = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
scale
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" schape = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
sh
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but both the scale and shape parameters must be positive!"

-- | create Frechet Dist, where scale parameter must be greater than 0.
frechetDistMaybe :: Double -> Double -> Double -> Maybe FrechetDistribution
frechetDistMaybe :: Double -> Double -> Double -> Maybe FrechetDistribution
frechetDistMaybe Double
loc Double
sc Double
sh
    | Double
sc Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
sh Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0    = FrechetDistribution -> Maybe FrechetDistribution
forall a. a -> Maybe a
Just (FrechetDistribution -> Maybe FrechetDistribution)
-> FrechetDistribution -> Maybe FrechetDistribution
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> FrechetDistribution
Frechet Double
loc Double
sc Double
sh
    | Bool
otherwise = Maybe FrechetDistribution
forall a. Maybe a
Nothing

-- | create Frechet Dist, where scale parameter must be greater than 0.
frechetDist :: Double -> Double -> Double -> FrechetDistribution
frechetDist :: Double -> Double -> Double -> FrechetDistribution
frechetDist Double
loc Double
sc Double
sh = FrechetDistribution
-> (FrechetDistribution -> FrechetDistribution)
-> Maybe FrechetDistribution
-> FrechetDistribution
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> FrechetDistribution
forall a. HasCallStack => String -> a
error (String -> FrechetDistribution) -> String -> FrechetDistribution
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> String
frechetErrMsg Double
loc Double
sc Double
sh) FrechetDistribution -> FrechetDistribution
forall a. a -> a
id (Maybe FrechetDistribution -> FrechetDistribution)
-> Maybe FrechetDistribution -> FrechetDistribution
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Maybe FrechetDistribution
frechetDistMaybe Double
loc Double
sc Double
sh

-- | The CDF of the Frechet distribution
cdfFrechet :: FrechetDistribution -> Double -> Double
cdfFrechet :: FrechetDistribution -> Double -> Double
cdfFrechet (Frechet Double
loc Double
sc Double
sh) Double
x
    | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0     = Double
0
    | Bool
otherwise  = Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ - (Double
y Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
pow)
        where 
            y :: Double
y   = (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
loc) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sc
            pow :: Double
pow = - Double
sh

-- | The PDF of the Frechet distribution
pdfFrechet :: FrechetDistribution -> Double -> Double
pdfFrechet :: FrechetDistribution -> Double -> Double
pdfFrechet (Frechet Double
loc Double
sc Double
sh) Double
x =
    let y :: Double
y       = (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
loc) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sc
        const :: Double
const   = Double
sh Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sc
        expterm :: Double
expterm = Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ - (Double
y Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (- Double
sh))
        middle :: Double
middle  = Double
y Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (-Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
sh)
    in Double
const Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
middle Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
expterm

-- Quantile function of the Frechet Distribution
quantileFrechet :: FrechetDistribution -> Double -> Double
quantileFrechet :: FrechetDistribution -> Double -> Double
quantileFrechet (Frechet Double
loc Double
sc Double
sh) Double
x
    | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 = Double
loc Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sc Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
logexp Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
pow)
    | Bool
otherwise      =
        String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Gev.FrechetDistribution.quantile: The given value must be between 0 and 1, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
x
    where 
        logexp :: Double
logexp = - Double -> Double
forall a. Floating a => a -> a
log Double
x
        pow :: Double
pow    = - Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sh

-- | Gev.Distribution instance implementation for the Frechet Distribution
instance Gev.Distribution FrechetDistribution where
    cdf :: FrechetDistribution -> Double -> Double
cdf      = FrechetDistribution -> Double -> Double
cdfFrechet
    pdf :: FrechetDistribution -> Double -> Double
pdf      = FrechetDistribution -> Double -> Double
pdfFrechet
    quantile :: FrechetDistribution -> Double -> Double
quantile = FrechetDistribution -> Double -> Double
quantileFrechet