module QuantLib.Math.Copulas
        ( Copula (..),
          Copulas (..)
        ) where

{-| Copula type class.
 -| Normally instance should implement only copulaFunc.
 -| Method copula provides a precheck for [0..1] range for x and y but real implementation is in copulaFunc
 -}
class Copula a where
        copula :: a -> Double -> Double -> Maybe Double
        copula a
t = (Double -> Double -> Maybe Double)
-> Double -> Double -> Maybe Double
precheckRange (a -> Double -> Double -> Maybe Double
forall a. Copula a => a -> Double -> Double -> Maybe Double
copulaFunc a
t)
        copulaFunc :: a -> Double -> Double -> Maybe Double

-- Copula must be in [0,1] range
precheckRange :: (Double->Double->Maybe Double) -> Double -> Double -> Maybe Double
precheckRange :: (Double -> Double -> Maybe Double)
-> Double -> Double -> Maybe Double
precheckRange Double -> Double -> Maybe Double
f Double
x Double
y
        | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.0 Bool -> Bool -> Bool
|| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1.0
        Bool -> Bool -> Bool
|| Double
yDouble -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.0 Bool -> Bool -> Bool
|| Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1.0
                = Double -> Double -> Maybe Double
f Double
x Double
y
        | Bool
otherwise
                = Maybe Double
forall a. Maybe a
Nothing

{-| Copula data types with parameters required by the concrete copula definition
 -}
data Copulas = ClaytonCopula Double -- ^ Clayton copula
        | MinCopula -- ^ Min copula
        | MaxCopula -- ^ Max copula
        | AliMikhailHaqCopula Double -- ^ Ali-Mikhail-Haq copula
        | FarlieGumbelMorgensternCopula Double -- ^ Farlie-Gumbel-Morgenstern copula
        | FrankCopula Double -- ^ Frank copula
        | GalambosCopula Double -- ^ Galambos copula
        | GaussianCopula Double -- ^ Gaussian copula /Not implemented yet!/
        | GumbelCopula Double -- ^ Gumbel copula
        | HuslerReissCopula Double -- ^ Husler-Reiss copula /Not implemented yet!/
        | IndependentCopula -- ^ Independent copula
        | MarshallOlkinCopula Double Double -- ^ Marshall-Olkin copula
        | PlackettCopula Double -- ^ Plackett copula

instance Copula Copulas where
        copulaFunc :: Copulas -> Double -> Double -> Maybe Double
copulaFunc (ClaytonCopula Double
theta)                    = Double -> Double -> Double -> Maybe Double
claytonCopula Double
theta
        copulaFunc Copulas
MinCopula                                = Double -> Double -> Maybe Double
forall a. Ord a => a -> a -> Maybe a
minCopula
        copulaFunc Copulas
MaxCopula                                = Double -> Double -> Maybe Double
forall a. (Fractional a, Ord a) => a -> a -> Maybe a
maxCopula
        copulaFunc (AliMikhailHaqCopula Double
theta)              = Double -> Double -> Double -> Maybe Double
forall a. (Fractional a, Ord a) => a -> a -> a -> Maybe a
aliMikhailHaqCopula Double
theta
        copulaFunc (FarlieGumbelMorgensternCopula Double
theta)    = Double -> Double -> Double -> Maybe Double
forall a. (Fractional a, Ord a) => a -> a -> a -> Maybe a
farlieGumbelMorgenstern Double
theta
        copulaFunc (FrankCopula Double
theta)                      = Double -> Double -> Double -> Maybe Double
forall a. (Eq a, Floating a) => a -> a -> a -> Maybe a
frankCopula Double
theta
        copulaFunc (GalambosCopula Double
theta)                   = Double -> Double -> Double -> Maybe Double
forall a. (Floating a, Ord a) => a -> a -> a -> Maybe a
galambosCopula Double
theta
        copulaFunc (GaussianCopula Double
rho)                     = Double -> Double -> Double -> Maybe Double
forall a t t1 a1. (Fractional a, Ord a) => a -> t -> t1 -> Maybe a1
gaussianCopula Double
rho
        copulaFunc (GumbelCopula Double
theta)                     = Double -> Double -> Double -> Maybe Double
forall a. (Floating a, Ord a) => a -> a -> a -> Maybe a
gumbelCopula Double
theta
        copulaFunc (HuslerReissCopula Double
theta)                = Double -> Double -> Double -> Maybe Double
forall a. (Fractional a, Ord a) => a -> a -> a -> Maybe a
huslerReissCopula Double
theta
        copulaFunc Copulas
IndependentCopula                        = Double -> Double -> Maybe Double
forall a. Num a => a -> a -> Maybe a
independentCopula
        copulaFunc (MarshallOlkinCopula Double
a Double
b)                = Double -> Double -> Double -> Double -> Maybe Double
forall a. (Floating a, Ord a) => a -> a -> a -> a -> Maybe a
marshallOlkinCopula Double
a Double
b
        copulaFunc (PlackettCopula Double
theta)                   = Double -> Double -> Double -> Maybe Double
forall a. (Floating a, Ord a) => a -> a -> a -> Maybe a
plackettCopula Double
theta

{- Private implementations   -}

{-# ANN aliMikhailHaqCopula "NoHerbie" #-}
aliMikhailHaqCopula :: (Fractional a, Ord a) => a -> a -> a -> Maybe a
aliMikhailHaqCopula :: a -> a -> a -> Maybe a
aliMikhailHaqCopula a
theta a
x a
y
        | a
theta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= -a
1.0 Bool -> Bool -> Bool
&& a
theta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1.0
                = a -> Maybe a
forall a. a -> Maybe a
Just ((a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
y)a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
1.0 a -> a -> a
forall a. Num a => a -> a -> a
- a
theta a -> a -> a
forall a. Num a => a -> a -> a
* (a
1.0a -> a -> a
forall a. Num a => a -> a -> a
-a
x)a -> a -> a
forall a. Num a => a -> a -> a
*(a
1.0a -> a -> a
forall a. Num a => a -> a -> a
-a
y)))
        | Bool
otherwise
                = Maybe a
forall a. Maybe a
Nothing

{-# ANN farlieGumbelMorgenstern "NoHerbie" #-}
farlieGumbelMorgenstern :: (Fractional a, Ord a) => a -> a -> a -> Maybe a
farlieGumbelMorgenstern :: a -> a -> a -> Maybe a
farlieGumbelMorgenstern a
theta a
x a
y
        | a
theta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= -a
1.0 Bool -> Bool -> Bool
&& a
theta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1.0
                = a -> Maybe a
forall a. a -> Maybe a
Just (a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
thetaa -> a -> a
forall a. Num a => a -> a -> a
*a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
ya -> a -> a
forall a. Num a => a -> a -> a
*(a
1.0a -> a -> a
forall a. Num a => a -> a -> a
-a
x)a -> a -> a
forall a. Num a => a -> a -> a
*(a
1.0a -> a -> a
forall a. Num a => a -> a -> a
-a
y))
        | Bool
otherwise
                = Maybe a
forall a. Maybe a
Nothing

{-|  Original code and algorithm from the Quantlib project
     implemented in Haskell by Nicholas Pezolano
                                  npezolano "at" gmail.com
-}
{-# ANN claytonCopula "NoHerbie" #-}
claytonCopula :: Double -> Double -> Double -> Maybe Double
claytonCopula :: Double -> Double -> Double -> Maybe Double
claytonCopula Double
theta Double
x Double
y
  |  Double
theta Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0
  Bool -> Bool -> Bool
|| Double
theta Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< -Double
1.0
   = Maybe Double
forall a. Maybe a
Nothing

   | Bool
otherwise
   = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max( (Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (-Double
theta) ) Double -> Double -> Double
forall a. Num a => a -> a -> a
+   (Double
y Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (-Double
theta)Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1.0)  Double -> Double -> Double
forall a. Floating a => a -> a -> a
**   (-Double
1.0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
theta)) Double
0

minCopula ::  Ord a => a -> a -> Maybe a
minCopula :: a -> a -> Maybe a
minCopula a
x a
y = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
forall a. Ord a => a -> a -> a
min a
x a
y)

maxCopula ::  (Fractional a, Ord a) => a -> a -> Maybe a
maxCopula :: a -> a -> Maybe a
maxCopula a
x a
y = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
forall a. Ord a => a -> a -> a
max a
0.0 (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
ya -> a -> a
forall a. Num a => a -> a -> a
-a
1.0))

frankCopula ::  (Eq a, Floating a) => a -> a -> a -> Maybe a
frankCopula :: a -> a -> a -> Maybe a
frankCopula a
theta a
x a
y
    | a
theta     a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0.0 = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (-a
1.0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
theta a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
log (a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ (a -> a
forall a. Floating a => a -> a
exp (-a
thetaa -> a -> a
forall a. Num a => a -> a -> a
*a
x) a -> a -> a
forall a. Num a => a -> a -> a
- a
1.0) a -> a -> a
forall a. Num a => a -> a -> a
* (a -> a
forall a. Floating a => a -> a
exp (-a
thetaa -> a -> a
forall a. Num a => a -> a -> a
*a
y) a -> a -> a
forall a. Num a => a -> a -> a
-a
1.0) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a -> a
forall a. Floating a => a -> a
exp (-a
theta) a -> a -> a
forall a. Num a => a -> a -> a
- a
1.0)   ))

{-# ANN galambosCopula "NoHerbie" #-}
galambosCopula ::  (Floating a, Ord a) => a -> a -> a -> Maybe a
galambosCopula :: a -> a -> a -> Maybe a
galambosCopula a
theta a
x a
y
    | a
theta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0.0  = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise     = a -> Maybe a
forall a. a -> Maybe a
Just (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
exp ( ( (-a -> a
forall a. Floating a => a -> a
log a
x) a -> a -> a
forall a. Floating a => a -> a -> a
** (-a
theta) a -> a -> a
forall a. Num a => a -> a -> a
+ (-a -> a
forall a. Floating a => a -> a
log a
y) a -> a -> a
forall a. Floating a => a -> a -> a
** (-a
theta) ) a -> a -> a
forall a. Floating a => a -> a -> a
** (-a
1.0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
theta)  ))

gaussianCopula ::  (Fractional a, Ord a) => a -> t -> t1 -> Maybe a1
gaussianCopula :: a -> t -> t1 -> Maybe a1
gaussianCopula a
rho t
_ t1
_
    | a
rho a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= -a
1.0 Bool -> Bool -> Bool
&& a
rho a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1.0 = Maybe a1
forall a. HasCallStack => a
undefined
    | Bool
otherwise                 = Maybe a1
forall a. Maybe a
Nothing

{-# ANN gumbelCopula "NoHerbie" #-}
gumbelCopula ::  (Floating a, Ord a) => a -> a -> a -> Maybe a
gumbelCopula :: a -> a -> a -> Maybe a
gumbelCopula a
theta a
x a
y
    | a
theta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1.0  = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a
forall a. Floating a => a -> a
exp ( - ( (-a -> a
forall a. Floating a => a -> a
log a
x) a -> a -> a
forall a. Floating a => a -> a -> a
** a
theta a -> a -> a
forall a. Num a => a -> a -> a
+ (-a -> a
forall a. Floating a => a -> a
log a
y) a -> a -> a
forall a. Floating a => a -> a -> a
** a
theta) a -> a -> a
forall a. Floating a => a -> a -> a
** (a
1.0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
theta)))
    | Bool
otherwise     = Maybe a
forall a. Maybe a
Nothing

huslerReissCopula :: (Fractional a, Ord a) => a -> a -> a -> Maybe a
huslerReissCopula :: a -> a -> a -> Maybe a
huslerReissCopula a
theta a
_ a
_
    | a
theta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0.0   = Maybe a
forall a. HasCallStack => a
undefined
    | Bool
otherwise     = Maybe a
forall a. Maybe a
Nothing

independentCopula ::  Num a => a -> a -> Maybe a
independentCopula :: a -> a -> Maybe a
independentCopula a
x a
y = a -> Maybe a
forall a. a -> Maybe a
Just (a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
y)

marshallOlkinCopula :: (Floating a, Ord a) => a -> a -> a -> a -> Maybe a
marshallOlkinCopula :: a -> a -> a -> a -> Maybe a
marshallOlkinCopula a
a a
b a
x a
y
    | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0.0 Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0.0  = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
forall a. Ord a => a -> a -> a
min (a
y a -> a -> a
forall a. Num a => a -> a -> a
* (a
x a -> a -> a
forall a. Floating a => a -> a -> a
** (a
1a -> a -> a
forall a. Num a => a -> a -> a
-a
a))) (a
x a -> a -> a
forall a. Num a => a -> a -> a
* (a
y a -> a -> a
forall a. Floating a => a -> a -> a
** (a
1a -> a -> a
forall a. Num a => a -> a -> a
-a
b))))
    | Bool
otherwise             = Maybe a
forall a. Maybe a
Nothing

{-# ANN plackettCopula "NoHerbie" #-}
plackettCopula ::  (Floating a, Ord a) => a -> a -> a -> Maybe a
plackettCopula :: a -> a -> a -> Maybe a
plackettCopula a
theta a
x a
y
    | a
theta a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0.0 Bool -> Bool -> Bool
&& a
theta a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
1.0  = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (a
sumXyTheta1 a -> a -> a
forall a. Num a => a -> a -> a
- a -> a
forall a. Floating a => a -> a
sqrt (a
sumXyTheta1 a -> a -> a
forall a. Num a => a -> a -> a
* a
sumXyTheta1 a -> a -> a
forall a. Num a => a -> a -> a
- a
4.0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y a -> a -> a
forall a. Num a => a -> a -> a
* a
theta a -> a -> a
forall a. Num a => a -> a -> a
* a
theta1))a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
theta1)
    | Bool
otherwise                     = Maybe a
forall a. Maybe a
Nothing
        where   sumXy :: a
sumXy           = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y
                theta1 :: a
theta1          = a
theta a -> a -> a
forall a. Num a => a -> a -> a
- a
1.0
                sumXyTheta1 :: a
sumXyTheta1     = a
1.0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
theta1 a -> a -> a
forall a. Num a => a -> a -> a
* a
sumXy