diff --git a/hquantlib.cabal b/hquantlib.cabal --- a/hquantlib.cabal +++ b/hquantlib.cabal @@ -1,5 +1,5 @@ name: hquantlib -version: 0.0.2.3 +version: 0.0.2.4 license: LGPL license-file: LICENSE author: Pavel Ryzhov @@ -19,7 +19,7 @@ source-repository this type: git location: https://github.com/paulrzcz/hquantlib.git - tag: 0.0.2.3 + tag: 0.0.2.4 flag optimize description : Enable optimizations for library and benchmarks @@ -37,12 +37,13 @@ QuantLib.PricingEngines QuantLib.PricingEngines.BlackFormula QuantLib.Quotes - QuantLib.VolatilityModel QuantLib.Time QuantLib.TimeSeries QuantLib.Money QuantLib.Math QuantLib.Math.Copulas + QuantLib.Models + QuantLib.Models.Volatility QuantLib.Prices QuantLib.Position QuantLib.Options @@ -62,13 +63,15 @@ QuantLib.Math.InverseNormal build-depends: - base >3 && <5, - time >= 1.2.0.0, - containers >= 0.4.0.0, - hmatrix >= 0.11.0.0, - hmatrix-special >= 0.1.1, - parallel >= 3.1.0.0, - mersenne-random >= 1.0.0.0 + base >3 && <5, + time >= 1.4.0.0 && < 1.5.0.0, + containers >= 0.5.0.0 && < 0.6.0.0, + hmatrix >= 0.14.0.0 && < 0.15.0.0, + hmatrix-special >= 0.2.0 && < 0.3.0, + parallel >= 3.2.0.0 && < 3.3.0.0, + mersenne-random >= 1.0.0.1 && < 2.0.0.0, + statistics >= 0.10.4.0 && < 0.11.0.0, + vector >= 0.10.0.0 && < 0.11.0.0 hs-source-dirs: src ghc-options: -Wall @@ -81,9 +84,9 @@ main-is : Test.hs hs-source-dirs : src build-depends : base, - test-framework >= 0.6, - test-framework-hunit >= 0.2.7, - test-framework-quickcheck2 >= 0.2.12.0, - QuickCheck >= 2.4.0, - HUnit >= 1.2.4.0 + test-framework >= 0.8 && < 0.9, + test-framework-hunit >= 0.3.0 && < 0.4.0, + test-framework-quickcheck2 >= 0.3.0.0 && < 0.4.0, + QuickCheck >= 2.5.0 && < 2.6.0, + HUnit >= 1.2.5.2 && < 2.0.0.0 diff --git a/src/QuantLib/Math/Copulas.hs b/src/QuantLib/Math/Copulas.hs --- a/src/QuantLib/Math/Copulas.hs +++ b/src/QuantLib/Math/Copulas.hs @@ -23,19 +23,19 @@ {-| Copula data types with parameters required by the concrete copula definition -} -data Copulas = ClaytonCopula Double - | MinCopula - | MaxCopula - | AliMikhailHaqCopula Double - | FarlieGumbelMorgensternCopula Double - | FrankCopula Double - | GalambosCopula Double - | GaussianCopula Double - | GumbelCopula Double - | HuslerReissCopula Double - | IndependentCopula - | MarshallOlkinCopula Double Double - | PlackettCopula Double +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 (ClaytonCopula theta) = claytonCopula theta @@ -80,7 +80,7 @@ | otherwise = Just $ max( (x ** (-theta) ) + (y ** (-theta)-1.0) ** (-1.0/theta)) 0 - + minCopula :: Ord a => a -> a -> Maybe a minCopula x y = Just (min x y) @@ -98,7 +98,7 @@ | otherwise = Just (x * y * exp ( ( (-log x) ** (-theta) + (-log y) ** (-theta) ) ** (-1.0/theta) )) gaussianCopula :: (Fractional a, Ord a) => a -> t -> t1 -> Maybe a1 -gaussianCopula rho x y +gaussianCopula rho _ _ | rho >= -1.0 && rho <= 1.0 = undefined | otherwise = Nothing @@ -107,7 +107,8 @@ | theta >= 1.0 = Just (exp ( - ( (-log x) ** theta + (-log y) ** theta) ** (1.0/theta))) | otherwise = Nothing -huslerReissCopula theta x y +huslerReissCopula :: (Fractional a, Ord a) => a -> a -> a -> Maybe a +huslerReissCopula theta _ _ | theta > 0.0 = undefined | otherwise = Nothing diff --git a/src/QuantLib/Models.hs b/src/QuantLib/Models.hs new file mode 100644 --- /dev/null +++ b/src/QuantLib/Models.hs @@ -0,0 +1,5 @@ +module QuantLib.Models + ( module QuantLib.Models.Volatility + ) where + +import QuantLib.Models.Volatility diff --git a/src/QuantLib/Models/Volatility.hs b/src/QuantLib/Models/Volatility.hs new file mode 100644 --- /dev/null +++ b/src/QuantLib/Models/Volatility.hs @@ -0,0 +1,100 @@ +module QuantLib.Models.Volatility + ( Volatility + , Estimation (..) + , VolatilityEstimator (..) + , VolatilityEstimatorAlgorithm (..) + ) where + +import QuantLib.Prices (IntervalPrice(..)) +import QuantLib.TimeSeries (IntervalPriceSeries) + +import qualified Data.Map as M +import Statistics.Sample (stdDev, fastVarianceUnbiased) +import qualified Data.Vector.Unboxed as U + +-- | 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 (Show, 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 (Show, Eq, Enum) + +instance VolatilityEstimator VolatilityEstimatorAlgorithm where + estimate ParkinsonEstimator = parkinson + estimate SimpleEstimator = simple + estimate SimpleDriftLessEstimator = simpleDriftLess + estimate GarmanKlass5Estimator = garmanKlass5 + estimate RogersSatchelEstimator = rogersSatchel + estimate YangZhangEstimator = yangZhang + +{- Private implementation -} + +-- we assume that the array is already sorted by time stamp +toLogArray :: IntervalPriceSeries -> U.Vector Double +toLogArray prices = U.fromList $ zipWith delog bars (tail bars) + where + bars = map snd $ M.toAscList prices + delog x0 x1 = log (ipClose x1/ipClose x0) + +simple :: IntervalPriceSeries -> Estimation +simple = Estimation . stdDev . toLogArray + +simpleDriftLess :: IntervalPriceSeries -> Estimation +simpleDriftLess = Estimation . sqrt . divByN . U.foldl' accum (T 0.0 0) . toLogArray + where + accum (T a n) b = T (a + b*b) (n + 1) + divByN (T a n) = a / fromIntegral n + +parkinson :: IntervalPriceSeries -> Estimation +parkinson = Estimation . sqrt . divByN . M.foldl' summate (T 0.0 0) + where + divByN (T a n) = a / (4*log 2) / fromIntegral n + summate (T a n) (IntervalPrice _ l h _) = T (a + logBase l h ** 2) (n + 1) + +garmanKlass5 :: IntervalPriceSeries -> Estimation +garmanKlass5 = Estimation . sqrt . combine . M.foldl' point (TT 0.0 0.0 0) + where + logConst = 2.0 * log 2.0 - 1.0 + combine (TT a b n) = (0.5*a - logConst*b) / fromIntegral n + point (TT a b n) (IntervalPrice o l h c) = TT (a + logBase l h ** 2) (b + logBase o c ** 2) (n + 1) + +rogersSatchel :: IntervalPriceSeries -> Estimation +rogersSatchel = Estimation . sqrt . varRS + +varRS :: IntervalPriceSeries -> Double +varRS = combine . M.foldl' point (T 0.0 0) + where + combine (T a n) = a / fromIntegral n + point (T a n) (IntervalPrice o h l c) = + T (a + logBase c h * logBase o h + logBase c l * logBase o l) (n + 1) + +toSimpleLogWith :: (IntervalPrice -> Double) -> IntervalPriceSeries -> U.Vector Double +toSimpleLogWith f = U.fromList . map (f . snd) . M.toAscList + +yangZhang :: IntervalPriceSeries -> Estimation +yangZhang prices = Estimation $ sqrt (varO + k * varC + (1.0 - k) * varRS prices) + where + n = fromIntegral $ M.size prices + k = 0.34/(1.34 + (n + 1) / (n - 1)) + opens = toSimpleLogWith (log . ipOpen) prices + closes = toSimpleLogWith (log . ipClose) prices + varO = fastVarianceUnbiased opens + varC = fastVarianceUnbiased closes + +-- Strict data structure for efficient folds + +data T = T {-# UNPACK #-} !Double {-# UNPACK #-} !Int +data TT = TT {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Int diff --git a/src/QuantLib/Prices.hs b/src/QuantLib/Prices.hs --- a/src/QuantLib/Prices.hs +++ b/src/QuantLib/Prices.hs @@ -1,5 +1,7 @@ module QuantLib.Prices - ( module QuantLib.Prices + ( PriceType (..) + , CallPrice (..) + , IntervalPrice (..) ) where -- | Price types @@ -20,5 +22,3 @@ ipLow :: Double, ipClose :: Double } deriving (Show, Eq) - - diff --git a/src/QuantLib/TimeSeries.hs b/src/QuantLib/TimeSeries.hs --- a/src/QuantLib/TimeSeries.hs +++ b/src/QuantLib/TimeSeries.hs @@ -2,8 +2,12 @@ ( module QuantLib.TimeSeries ) where +import QuantLib.Prices(IntervalPrice) import Data.Time.LocalTime import qualified Data.Map as M -- | Time series type TimeSeries m = M.Map LocalTime m + +-- | Interval price time series +type IntervalPriceSeries = TimeSeries IntervalPrice diff --git a/src/QuantLib/VolatilityModel.hs b/src/QuantLib/VolatilityModel.hs deleted file mode 100644 --- a/src/QuantLib/VolatilityModel.hs +++ /dev/null @@ -1,60 +0,0 @@ -module QuantLib.VolatilityModel - ( module QuantLib.VolatilityModel - ) where - -import QuantLib.Prices -import QuantLib.TimeSeries -import qualified Data.Map as M - --- | Volatility type -type Volatility = Double - --- | Volatility time series -type VolatilitySeries = TimeSeries Volatility - --- | The estimator of time series of doubles -class DoubleVolatilityEstimator a where - dveCalculate :: a->TimeSeries Double->VolatilitySeries - --- | The calculator of volatility for interval price -class IntervalPointCalculator a where - ipcCalculatePoint :: a->IntervalPrice->Volatility - --- | Interval price volatility estimator -class IntervalVolatilityEstimator a where - iveCalculate :: IntervalPointCalculator b => a->b->TimeSeries IntervalPrice->VolatilitySeries - --- | Simple local estimator -data SimpleLocalEstimator = SimpleLocalEstimator { - sleYearFraction :: Double - } deriving (Show, Eq) - -instance DoubleVolatilityEstimator SimpleLocalEstimator where - dveCalculate (SimpleLocalEstimator yf) series = M.fromList result - where - (result, _) = M.foldrWithKey volFunc ([], Nothing) series - volFunc _ s (xs, Nothing) = (xs, Just s) - volFunc k s (xs, Just s0) = ((k, estimator s0 s):xs, Just s) - estimator s0 s1 = abs (log (s1 / s0) ) / yf - --- | Garman-Klass interval estimators -data GarmanKlass = GarmanKlass { - gkYearFraction :: Double - } deriving (Show, Eq) - -instance IntervalVolatilityEstimator GarmanKlass where - iveCalculate (GarmanKlass yf) ipc series = M.fromList result - where result = M.foldrWithKey volFunc [] series - volFunc k s xs = (k, abs (calculatePoint s) / yf):xs - calculatePoint = ipcCalculatePoint ipc - --- | Types of Garman-Klass estimators -data GarmanKlassPoint = GarmanKlassSimpleSigma - | ParkinsonSigma - -instance IntervalPointCalculator GarmanKlassPoint where - ipcCalculatePoint GarmanKlassSimpleSigma (IntervalPrice open _ _ close) = log (close/open) ** 2 - - ipcCalculatePoint ParkinsonSigma (IntervalPrice o h l _) = (u-d)**2 / 4.0 / log 2.0 - where u = log (h/o) - d = log (l/o)