module QuantLib.Models.Volatility
    ( Volatility
    , Estimation (..)
    , VolatilityEstimator (..)
    , VolatilityEstimatorAlgorithm (..)
    ) where

import           QuantLib.Prices     (IntervalPrice (..))
import           QuantLib.TimeSeries (IntervalPriceSeries)

import qualified Data.Map            as M
import qualified Data.Vector.Unboxed as U
import           Statistics.Sample   (fastVarianceUnbiased, stdDev)

-- | Volatility type
type Volatility = Double

-- | Estimation type with strictness as it is usually required only one 'Double' to process
data Estimation = Estimation {-# UNPACK #-} !Volatility
    deriving (Int -> Estimation -> ShowS
[Estimation] -> ShowS
Estimation -> String
(Int -> Estimation -> ShowS)
-> (Estimation -> String)
-> ([Estimation] -> ShowS)
-> Show Estimation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Estimation] -> ShowS
$cshowList :: [Estimation] -> ShowS
show :: Estimation -> String
$cshow :: Estimation -> String
showsPrec :: Int -> Estimation -> ShowS
$cshowsPrec :: Int -> Estimation -> ShowS
Show, Estimation -> Estimation -> Bool
(Estimation -> Estimation -> Bool)
-> (Estimation -> Estimation -> Bool) -> Eq Estimation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Estimation -> Estimation -> Bool
$c/= :: Estimation -> Estimation -> Bool
== :: Estimation -> Estimation -> Bool
$c== :: Estimation -> Estimation -> Bool
Eq)

-- | Type class of volatility estimators
class VolatilityEstimator algorithm where
    -- | The estimation procedure that takes a series of 'QuantLib.Prices.IntervalPrice'
    estimate :: algorithm -> IntervalPriceSeries -> Estimation

data VolatilityEstimatorAlgorithm = SimpleEstimator -- ^ Simple estimator with drift
    | SimpleDriftLessEstimator    -- ^ Simple estimator without drift
    | ParkinsonEstimator          -- ^ Parkinson number
    | GarmanKlass5Estimator       -- ^ Garman-Klass estimator
    | RogersSatchelEstimator      -- ^ Rogers-Stachel estimator
    | YangZhangEstimator          -- ^ Yang-Zhang estimator
    deriving (Int -> VolatilityEstimatorAlgorithm -> ShowS
[VolatilityEstimatorAlgorithm] -> ShowS
VolatilityEstimatorAlgorithm -> String
(Int -> VolatilityEstimatorAlgorithm -> ShowS)
-> (VolatilityEstimatorAlgorithm -> String)
-> ([VolatilityEstimatorAlgorithm] -> ShowS)
-> Show VolatilityEstimatorAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VolatilityEstimatorAlgorithm] -> ShowS
$cshowList :: [VolatilityEstimatorAlgorithm] -> ShowS
show :: VolatilityEstimatorAlgorithm -> String
$cshow :: VolatilityEstimatorAlgorithm -> String
showsPrec :: Int -> VolatilityEstimatorAlgorithm -> ShowS
$cshowsPrec :: Int -> VolatilityEstimatorAlgorithm -> ShowS
Show, VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> Bool
(VolatilityEstimatorAlgorithm
 -> VolatilityEstimatorAlgorithm -> Bool)
-> (VolatilityEstimatorAlgorithm
    -> VolatilityEstimatorAlgorithm -> Bool)
-> Eq VolatilityEstimatorAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> Bool
$c/= :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> Bool
== :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> Bool
$c== :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> Bool
Eq, Int -> VolatilityEstimatorAlgorithm
VolatilityEstimatorAlgorithm -> Int
VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm]
VolatilityEstimatorAlgorithm -> VolatilityEstimatorAlgorithm
VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm]
VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm
-> [VolatilityEstimatorAlgorithm]
(VolatilityEstimatorAlgorithm -> VolatilityEstimatorAlgorithm)
-> (VolatilityEstimatorAlgorithm -> VolatilityEstimatorAlgorithm)
-> (Int -> VolatilityEstimatorAlgorithm)
-> (VolatilityEstimatorAlgorithm -> Int)
-> (VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm])
-> (VolatilityEstimatorAlgorithm
    -> VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm])
-> (VolatilityEstimatorAlgorithm
    -> VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm])
-> (VolatilityEstimatorAlgorithm
    -> VolatilityEstimatorAlgorithm
    -> VolatilityEstimatorAlgorithm
    -> [VolatilityEstimatorAlgorithm])
-> Enum VolatilityEstimatorAlgorithm
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm
-> [VolatilityEstimatorAlgorithm]
$cenumFromThenTo :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm
-> [VolatilityEstimatorAlgorithm]
enumFromTo :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm]
$cenumFromTo :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm]
enumFromThen :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm]
$cenumFromThen :: VolatilityEstimatorAlgorithm
-> VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm]
enumFrom :: VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm]
$cenumFrom :: VolatilityEstimatorAlgorithm -> [VolatilityEstimatorAlgorithm]
fromEnum :: VolatilityEstimatorAlgorithm -> Int
$cfromEnum :: VolatilityEstimatorAlgorithm -> Int
toEnum :: Int -> VolatilityEstimatorAlgorithm
$ctoEnum :: Int -> VolatilityEstimatorAlgorithm
pred :: VolatilityEstimatorAlgorithm -> VolatilityEstimatorAlgorithm
$cpred :: VolatilityEstimatorAlgorithm -> VolatilityEstimatorAlgorithm
succ :: VolatilityEstimatorAlgorithm -> VolatilityEstimatorAlgorithm
$csucc :: VolatilityEstimatorAlgorithm -> VolatilityEstimatorAlgorithm
Enum)

instance VolatilityEstimator VolatilityEstimatorAlgorithm where
    estimate :: VolatilityEstimatorAlgorithm -> IntervalPriceSeries -> Estimation
estimate VolatilityEstimatorAlgorithm
ParkinsonEstimator       = IntervalPriceSeries -> Estimation
parkinson
    estimate VolatilityEstimatorAlgorithm
SimpleEstimator          = IntervalPriceSeries -> Estimation
simple
    estimate VolatilityEstimatorAlgorithm
SimpleDriftLessEstimator = IntervalPriceSeries -> Estimation
simpleDriftLess
    estimate VolatilityEstimatorAlgorithm
GarmanKlass5Estimator    = IntervalPriceSeries -> Estimation
garmanKlass5
    estimate VolatilityEstimatorAlgorithm
RogersSatchelEstimator   = IntervalPriceSeries -> Estimation
rogersSatchel
    estimate VolatilityEstimatorAlgorithm
YangZhangEstimator       = IntervalPriceSeries -> Estimation
yangZhang

{- Private implementation -}

-- we assume that the array is already sorted by time stamp
toLogArray :: IntervalPriceSeries -> U.Vector Double
toLogArray :: IntervalPriceSeries -> Vector Double
toLogArray IntervalPriceSeries
prices = [Double] -> Vector Double
forall a. Unbox a => [a] -> Vector a
U.fromList ([Double] -> Vector Double) -> [Double] -> Vector Double
forall a b. (a -> b) -> a -> b
$ (IntervalPrice -> IntervalPrice -> Double)
-> [IntervalPrice] -> [IntervalPrice] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith IntervalPrice -> IntervalPrice -> Double
delog [IntervalPrice]
bars ([IntervalPrice] -> [IntervalPrice]
forall a. [a] -> [a]
tail [IntervalPrice]
bars)
    where
        bars :: [IntervalPrice]
bars        = ((LocalTime, IntervalPrice) -> IntervalPrice)
-> [(LocalTime, IntervalPrice)] -> [IntervalPrice]
forall a b. (a -> b) -> [a] -> [b]
map (LocalTime, IntervalPrice) -> IntervalPrice
forall a b. (a, b) -> b
snd ([(LocalTime, IntervalPrice)] -> [IntervalPrice])
-> [(LocalTime, IntervalPrice)] -> [IntervalPrice]
forall a b. (a -> b) -> a -> b
$ IntervalPriceSeries -> [(LocalTime, IntervalPrice)]
forall k a. Map k a -> [(k, a)]
M.toAscList IntervalPriceSeries
prices
        delog :: IntervalPrice -> IntervalPrice -> Double
delog IntervalPrice
x0 IntervalPrice
x1 = Double -> Double
forall a. Floating a => a -> a
log (IntervalPrice -> Double
ipClose IntervalPrice
x1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/IntervalPrice -> Double
ipClose IntervalPrice
x0)

simple :: IntervalPriceSeries -> Estimation
simple :: IntervalPriceSeries -> Estimation
simple = Double -> Estimation
Estimation (Double -> Estimation)
-> (IntervalPriceSeries -> Double)
-> IntervalPriceSeries
-> Estimation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
stdDev (Vector Double -> Double)
-> (IntervalPriceSeries -> Vector Double)
-> IntervalPriceSeries
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalPriceSeries -> Vector Double
toLogArray

{-# ANN simpleDriftLess "NoHerbie" #-}
simpleDriftLess :: IntervalPriceSeries -> Estimation
simpleDriftLess :: IntervalPriceSeries -> Estimation
simpleDriftLess = Double -> Estimation
Estimation (Double -> Estimation)
-> (IntervalPriceSeries -> Double)
-> IntervalPriceSeries
-> Estimation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double)
-> (IntervalPriceSeries -> Double) -> IntervalPriceSeries -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Double
divByN (T -> Double)
-> (IntervalPriceSeries -> T) -> IntervalPriceSeries -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T -> Double -> T) -> T -> Vector Double -> T
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
U.foldl' T -> Double -> T
accum (Double -> Int -> T
T Double
0.0 Int
0) (Vector Double -> T)
-> (IntervalPriceSeries -> Vector Double)
-> IntervalPriceSeries
-> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalPriceSeries -> Vector Double
toLogArray
    where
        accum :: T -> Double -> T
accum (T Double
a Int
n) Double
b = Double -> Int -> T
T (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
b) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        divByN :: T -> Double
divByN (T Double
a Int
n)  = Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

parkinson :: IntervalPriceSeries -> Estimation
parkinson :: IntervalPriceSeries -> Estimation
parkinson = Double -> Estimation
Estimation (Double -> Estimation)
-> (IntervalPriceSeries -> Double)
-> IntervalPriceSeries
-> Estimation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double)
-> (IntervalPriceSeries -> Double) -> IntervalPriceSeries -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Double
divByN (T -> Double)
-> (IntervalPriceSeries -> T) -> IntervalPriceSeries -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T -> IntervalPrice -> T) -> T -> IntervalPriceSeries -> T
forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' T -> IntervalPrice -> T
summate (Double -> Int -> T
T Double
0.0 Int
0)
    where
        divByN :: T -> Double
divByN (T Double
a Int
n) = Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
4Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
forall a. Floating a => a -> a
log Double
2) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        summate :: T -> IntervalPrice -> T
summate (T Double
a Int
n) (IntervalPrice Double
_ Double
l Double
h Double
_) = Double -> Int -> T
T (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
l Double
h Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

garmanKlass5 :: IntervalPriceSeries -> Estimation
garmanKlass5 :: IntervalPriceSeries -> Estimation
garmanKlass5 = Double -> Estimation
Estimation (Double -> Estimation)
-> (IntervalPriceSeries -> Double)
-> IntervalPriceSeries
-> Estimation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double)
-> (IntervalPriceSeries -> Double) -> IntervalPriceSeries -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Double
combine (TT -> Double)
-> (IntervalPriceSeries -> TT) -> IntervalPriceSeries -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TT -> IntervalPrice -> TT) -> TT -> IntervalPriceSeries -> TT
forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' TT -> IntervalPrice -> TT
point (Double -> Double -> Int -> TT
TT Double
0.0 Double
0.0 Int
0)
    where
        logConst :: Double
logConst = Double
2.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log Double
2.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1.0
        combine :: TT -> Double
combine (TT Double
a Double
b Int
n) = (Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
logConstDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
b) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        point :: TT -> IntervalPrice -> TT
point (TT Double
a Double
b Int
n) (IntervalPrice Double
o Double
l Double
h Double
c) = Double -> Double -> Int -> TT
TT (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
l Double
h Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2) (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
o Double
c Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

rogersSatchel :: IntervalPriceSeries -> Estimation
rogersSatchel :: IntervalPriceSeries -> Estimation
rogersSatchel = Double -> Estimation
Estimation (Double -> Estimation)
-> (IntervalPriceSeries -> Double)
-> IntervalPriceSeries
-> Estimation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double)
-> (IntervalPriceSeries -> Double) -> IntervalPriceSeries -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalPriceSeries -> Double
varRS

varRS :: IntervalPriceSeries -> Double
varRS :: IntervalPriceSeries -> Double
varRS = T -> Double
combine (T -> Double)
-> (IntervalPriceSeries -> T) -> IntervalPriceSeries -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T -> IntervalPrice -> T) -> T -> IntervalPriceSeries -> T
forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' T -> IntervalPrice -> T
point (Double -> Int -> T
T Double
0.0 Int
0)
    where
        combine :: T -> Double
combine (T Double
a Int
n) = Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        point :: T -> IntervalPrice -> T
point (T Double
a Int
n) (IntervalPrice Double
o Double
h Double
l Double
c) =
            Double -> Int -> T
T (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
c Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
o Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
c Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
o Double
l) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

toSimpleLogWith :: (IntervalPrice -> Double) -> IntervalPriceSeries -> U.Vector Double
toSimpleLogWith :: (IntervalPrice -> Double) -> IntervalPriceSeries -> Vector Double
toSimpleLogWith IntervalPrice -> Double
f = [Double] -> Vector Double
forall a. Unbox a => [a] -> Vector a
U.fromList ([Double] -> Vector Double)
-> (IntervalPriceSeries -> [Double])
-> IntervalPriceSeries
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LocalTime, IntervalPrice) -> Double)
-> [(LocalTime, IntervalPrice)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (IntervalPrice -> Double
f (IntervalPrice -> Double)
-> ((LocalTime, IntervalPrice) -> IntervalPrice)
-> (LocalTime, IntervalPrice)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalTime, IntervalPrice) -> IntervalPrice
forall a b. (a, b) -> b
snd) ([(LocalTime, IntervalPrice)] -> [Double])
-> (IntervalPriceSeries -> [(LocalTime, IntervalPrice)])
-> IntervalPriceSeries
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalPriceSeries -> [(LocalTime, IntervalPrice)]
forall k a. Map k a -> [(k, a)]
M.toAscList

{-# ANN yangZhang "NoHerbie" #-}
yangZhang :: IntervalPriceSeries -> Estimation
yangZhang :: IntervalPriceSeries -> Estimation
yangZhang IntervalPriceSeries
prices = Double -> Estimation
Estimation (Double -> Estimation) -> Double -> Estimation
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
sqrt (Double
varO Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
varC Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k) Double -> Double -> Double
forall a. Num a => a -> a -> a
* IntervalPriceSeries -> Double
varRS IntervalPriceSeries
prices)
    where
        n :: Double
n        = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ IntervalPriceSeries -> Int
forall k a. Map k a -> Int
M.size IntervalPriceSeries
prices
        k :: Double
k        = Double
0.34Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
1.34 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1))
        opens :: Vector Double
opens    = (IntervalPrice -> Double) -> IntervalPriceSeries -> Vector Double
toSimpleLogWith (Double -> Double
forall a. Floating a => a -> a
log (Double -> Double)
-> (IntervalPrice -> Double) -> IntervalPrice -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalPrice -> Double
ipOpen) IntervalPriceSeries
prices
        closes :: Vector Double
closes   = (IntervalPrice -> Double) -> IntervalPriceSeries -> Vector Double
toSimpleLogWith (Double -> Double
forall a. Floating a => a -> a
log (Double -> Double)
-> (IntervalPrice -> Double) -> IntervalPrice -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntervalPrice -> Double
ipClose) IntervalPriceSeries
prices
        varO :: Double
varO     = Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
fastVarianceUnbiased Vector Double
opens
        varC :: Double
varC     = Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
fastVarianceUnbiased Vector Double
closes

-- Strict data structure for efficient folds

data T = T {-# UNPACK #-} !Double {-# UNPACK #-} !Int
data TT = TT {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Int