{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-| Measure that we need for calculating prices
-}
module Convex.Measures(
  -- * Measures

  -- ** Mean
  Mean(..),
  getMean,
  countOne,
  countMany,

  -- ** Exponential weighted mean
  ExponentialWeightedMean(..),
  countExponentialWeightedMean,
  getExponentialWeightedMean,
  emptyEwm,

  -- ** Variance
  Variance(..),
  emptyVariance,
  observe,
  getVariance
  ) where

import           Data.Aeson      (FromJSON, ToJSON)
import           Data.Maybe      (fromMaybe)
import           GHC.Generics    (Generic)
import           Numeric.Natural (Natural)

{-| Arithmetic mean
-}
data Mean = Mean
  { Mean -> Natural
mCount :: !Natural
  , Mean -> Integer
mSum   :: !Integer
  }
  deriving stock (Mean -> Mean -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mean -> Mean -> Bool
$c/= :: Mean -> Mean -> Bool
== :: Mean -> Mean -> Bool
$c== :: Mean -> Mean -> Bool
Eq, Eq Mean
Mean -> Mean -> Bool
Mean -> Mean -> Ordering
Mean -> Mean -> Mean
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mean -> Mean -> Mean
$cmin :: Mean -> Mean -> Mean
max :: Mean -> Mean -> Mean
$cmax :: Mean -> Mean -> Mean
>= :: Mean -> Mean -> Bool
$c>= :: Mean -> Mean -> Bool
> :: Mean -> Mean -> Bool
$c> :: Mean -> Mean -> Bool
<= :: Mean -> Mean -> Bool
$c<= :: Mean -> Mean -> Bool
< :: Mean -> Mean -> Bool
$c< :: Mean -> Mean -> Bool
compare :: Mean -> Mean -> Ordering
$ccompare :: Mean -> Mean -> Ordering
Ord, Int -> Mean -> ShowS
[Mean] -> ShowS
Mean -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mean] -> ShowS
$cshowList :: [Mean] -> ShowS
show :: Mean -> String
$cshow :: Mean -> String
showsPrec :: Int -> Mean -> ShowS
$cshowsPrec :: Int -> Mean -> ShowS
Show, forall x. Rep Mean x -> Mean
forall x. Mean -> Rep Mean x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mean x -> Mean
$cfrom :: forall x. Mean -> Rep Mean x
Generic)
  deriving anyclass ([Mean] -> Encoding
[Mean] -> Value
Mean -> Encoding
Mean -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Mean] -> Encoding
$ctoEncodingList :: [Mean] -> Encoding
toJSONList :: [Mean] -> Value
$ctoJSONList :: [Mean] -> Value
toEncoding :: Mean -> Encoding
$ctoEncoding :: Mean -> Encoding
toJSON :: Mean -> Value
$ctoJSON :: Mean -> Value
ToJSON, Value -> Parser [Mean]
Value -> Parser Mean
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Mean]
$cparseJSONList :: Value -> Parser [Mean]
parseJSON :: Value -> Parser Mean
$cparseJSON :: Value -> Parser Mean
FromJSON)

instance Semigroup Mean where
  Mean
l <> :: Mean -> Mean -> Mean
<> Mean
r = Mean{mCount :: Natural
mCount = Mean -> Natural
mCount Mean
l forall a. Num a => a -> a -> a
+ Mean -> Natural
mCount Mean
r, mSum :: Integer
mSum = Mean -> Integer
mSum Mean
l forall a. Num a => a -> a -> a
+ Mean -> Integer
mSum Mean
r}

instance Monoid Mean where
  mempty :: Mean
mempty = Natural -> Integer -> Mean
Mean Natural
0 Integer
0

-- | Count one observation
countOne :: Integer -> Mean
countOne :: Integer -> Mean
countOne = Natural -> Integer -> Mean
countMany Natural
1

-- | Count many observations of the same value (ie. count the value with a higher weight)
countMany :: Natural -> Integer -> Mean
countMany :: Natural -> Integer -> Mean
countMany = Natural -> Integer -> Mean
Mean

-- | Get the mean if at least one value has been observed
getMean :: Mean -> Maybe Double
getMean :: Mean -> Maybe Double
getMean Mean{Natural
mCount :: Natural
mCount :: Mean -> Natural
mCount, Integer
mSum :: Integer
mSum :: Mean -> Integer
mSum} | Natural
mCount forall a. Ord a => a -> a -> Bool
> Natural
0 = forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
mSum forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
mCount)
                           | Bool
otherwise  = forall a. Maybe a
Nothing

data ExponentialWeightedMean =
  ExponentialWeightedMean
    { ExponentialWeightedMean -> Double
ewmCount :: !Double
    , ExponentialWeightedMean -> Double
ewmSum   :: !Double
    }
  deriving stock (ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
$c/= :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
== :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
$c== :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
Eq, Eq ExponentialWeightedMean
ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
ExponentialWeightedMean -> ExponentialWeightedMean -> Ordering
ExponentialWeightedMean
-> ExponentialWeightedMean -> ExponentialWeightedMean
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExponentialWeightedMean
-> ExponentialWeightedMean -> ExponentialWeightedMean
$cmin :: ExponentialWeightedMean
-> ExponentialWeightedMean -> ExponentialWeightedMean
max :: ExponentialWeightedMean
-> ExponentialWeightedMean -> ExponentialWeightedMean
$cmax :: ExponentialWeightedMean
-> ExponentialWeightedMean -> ExponentialWeightedMean
>= :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
$c>= :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
> :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
$c> :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
<= :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
$c<= :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
< :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
$c< :: ExponentialWeightedMean -> ExponentialWeightedMean -> Bool
compare :: ExponentialWeightedMean -> ExponentialWeightedMean -> Ordering
$ccompare :: ExponentialWeightedMean -> ExponentialWeightedMean -> Ordering
Ord, Int -> ExponentialWeightedMean -> ShowS
[ExponentialWeightedMean] -> ShowS
ExponentialWeightedMean -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExponentialWeightedMean] -> ShowS
$cshowList :: [ExponentialWeightedMean] -> ShowS
show :: ExponentialWeightedMean -> String
$cshow :: ExponentialWeightedMean -> String
showsPrec :: Int -> ExponentialWeightedMean -> ShowS
$cshowsPrec :: Int -> ExponentialWeightedMean -> ShowS
Show, forall x. Rep ExponentialWeightedMean x -> ExponentialWeightedMean
forall x. ExponentialWeightedMean -> Rep ExponentialWeightedMean x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExponentialWeightedMean x -> ExponentialWeightedMean
$cfrom :: forall x. ExponentialWeightedMean -> Rep ExponentialWeightedMean x
Generic)
  deriving anyclass ([ExponentialWeightedMean] -> Encoding
[ExponentialWeightedMean] -> Value
ExponentialWeightedMean -> Encoding
ExponentialWeightedMean -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExponentialWeightedMean] -> Encoding
$ctoEncodingList :: [ExponentialWeightedMean] -> Encoding
toJSONList :: [ExponentialWeightedMean] -> Value
$ctoJSONList :: [ExponentialWeightedMean] -> Value
toEncoding :: ExponentialWeightedMean -> Encoding
$ctoEncoding :: ExponentialWeightedMean -> Encoding
toJSON :: ExponentialWeightedMean -> Value
$ctoJSON :: ExponentialWeightedMean -> Value
ToJSON, Value -> Parser [ExponentialWeightedMean]
Value -> Parser ExponentialWeightedMean
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExponentialWeightedMean]
$cparseJSONList :: Value -> Parser [ExponentialWeightedMean]
parseJSON :: Value -> Parser ExponentialWeightedMean
$cparseJSON :: Value -> Parser ExponentialWeightedMean
FromJSON)

emptyEwm :: ExponentialWeightedMean
emptyEwm :: ExponentialWeightedMean
emptyEwm = Double -> Double -> ExponentialWeightedMean
ExponentialWeightedMean Double
0 Double
0

-- | Add an observation of the 'Mean' to the exp. weighted mean,
--   discounting the past observations by a factor.
--   A good factor is 0.9 or 0.95
countExponentialWeightedMean :: Double -> ExponentialWeightedMean -> Mean -> ExponentialWeightedMean
countExponentialWeightedMean :: Double
-> ExponentialWeightedMean -> Mean -> ExponentialWeightedMean
countExponentialWeightedMean Double
factor ExponentialWeightedMean{ewmCount :: ExponentialWeightedMean -> Double
ewmCount = Double
oldCount, ewmSum :: ExponentialWeightedMean -> Double
ewmSum = Double
oldSum } Mean{Natural
mCount :: Natural
mCount :: Mean -> Natural
mCount, Integer
mSum :: Integer
mSum :: Mean -> Integer
mSum} =
  ExponentialWeightedMean
    { ewmCount :: Double
ewmCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
mCount forall a. Num a => a -> a -> a
+ Double
factor forall a. Num a => a -> a -> a
* Double
oldCount
    , ewmSum :: Double
ewmSum   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
mSum   forall a. Num a => a -> a -> a
+ Double
factor forall a. Num a => a -> a -> a
* Double
oldSum
    }

-- | Get the exp. weighted mean if at least one value has been observed
getExponentialWeightedMean :: ExponentialWeightedMean -> Maybe Double
getExponentialWeightedMean :: ExponentialWeightedMean -> Maybe Double
getExponentialWeightedMean ExponentialWeightedMean{Double
ewmCount :: Double
ewmCount :: ExponentialWeightedMean -> Double
ewmCount, Double
ewmSum :: Double
ewmSum :: ExponentialWeightedMean -> Double
ewmSum} | Double
ewmCount forall a. Eq a => a -> a -> Bool
/= Double
0 = forall a. a -> Maybe a
Just (Double
ewmSum forall a. Fractional a => a -> a -> a
/ Double
ewmCount)
                                                                     | Bool
otherwise = forall a. Maybe a
Nothing

data Variance =
  Variance
    { Variance -> Mean
vMean :: !Mean
    , Variance -> Natural
vN    :: !Natural
    , Variance -> Double
vM2   :: !Double
    }
  deriving stock (Variance -> Variance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variance -> Variance -> Bool
$c/= :: Variance -> Variance -> Bool
== :: Variance -> Variance -> Bool
$c== :: Variance -> Variance -> Bool
Eq, Eq Variance
Variance -> Variance -> Bool
Variance -> Variance -> Ordering
Variance -> Variance -> Variance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Variance -> Variance -> Variance
$cmin :: Variance -> Variance -> Variance
max :: Variance -> Variance -> Variance
$cmax :: Variance -> Variance -> Variance
>= :: Variance -> Variance -> Bool
$c>= :: Variance -> Variance -> Bool
> :: Variance -> Variance -> Bool
$c> :: Variance -> Variance -> Bool
<= :: Variance -> Variance -> Bool
$c<= :: Variance -> Variance -> Bool
< :: Variance -> Variance -> Bool
$c< :: Variance -> Variance -> Bool
compare :: Variance -> Variance -> Ordering
$ccompare :: Variance -> Variance -> Ordering
Ord, Int -> Variance -> ShowS
[Variance] -> ShowS
Variance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variance] -> ShowS
$cshowList :: [Variance] -> ShowS
show :: Variance -> String
$cshow :: Variance -> String
showsPrec :: Int -> Variance -> ShowS
$cshowsPrec :: Int -> Variance -> ShowS
Show, forall x. Rep Variance x -> Variance
forall x. Variance -> Rep Variance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Variance x -> Variance
$cfrom :: forall x. Variance -> Rep Variance x
Generic)
  deriving anyclass ([Variance] -> Encoding
[Variance] -> Value
Variance -> Encoding
Variance -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Variance] -> Encoding
$ctoEncodingList :: [Variance] -> Encoding
toJSONList :: [Variance] -> Value
$ctoJSONList :: [Variance] -> Value
toEncoding :: Variance -> Encoding
$ctoEncoding :: Variance -> Encoding
toJSON :: Variance -> Value
$ctoJSON :: Variance -> Value
ToJSON, Value -> Parser [Variance]
Value -> Parser Variance
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Variance]
$cparseJSONList :: Value -> Parser [Variance]
parseJSON :: Value -> Parser Variance
$cparseJSON :: Value -> Parser Variance
FromJSON)

emptyVariance :: Variance
emptyVariance :: Variance
emptyVariance = Variance{vMean :: Mean
vMean = forall a. Monoid a => a
mempty, vN :: Natural
vN = Natural
0, vM2 :: Double
vM2 = Double
0 }

observe :: Variance -> Mean -> Variance
observe :: Variance -> Mean -> Variance
observe Variance{Mean
vMean :: Mean
vMean :: Variance -> Mean
vMean, Natural
vN :: Natural
vN :: Variance -> Natural
vN, Double
vM2 :: Double
vM2 :: Variance -> Double
vM2} Mean
observation =
  -- Adapted from https://hackage.haskell.org/package/foldl-1.4.12/docs/src/Control.Foldl.html#variance
  let
    n' :: Natural
n' = Natural
vN forall a. Num a => a -> a -> a
+ Natural
1
    mean' :: Mean
mean' = Mean
vMean forall a. Semigroup a => a -> a -> a
<> Mean
observation
    delta :: Double
delta = forall a. a -> Maybe a -> a
fromMaybe Double
0 (Mean -> Maybe Double
getMean Mean
observation) forall a. Num a => a -> a -> a
- forall a. a -> Maybe a -> a
fromMaybe Double
0 (Mean -> Maybe Double
getMean Mean
vMean)
    m2' :: Double
m2' = Double
vM2 forall a. Num a => a -> a -> a
+ Double
delta forall a. Num a => a -> a -> a
* Double
delta forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
vN forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n')
  in Variance{vMean :: Mean
vMean = Mean
mean', vN :: Natural
vN = Natural
n', vM2 :: Double
vM2 = Double
m2'}

getVariance :: Variance -> Maybe Double
getVariance :: Variance -> Maybe Double
getVariance Variance{Natural
vN :: Natural
vN :: Variance -> Natural
vN, Double
vM2 :: Double
vM2 :: Variance -> Double
vM2} | Natural
vN forall a. Ord a => a -> a -> Bool
> Natural
0 = forall a. a -> Maybe a
Just (Double
vM2 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
vN)
                              | Bool
otherwise = forall a. Maybe a
Nothing