R/asympVarianceEstim_KRTS.R

In TempStable: A Collection of Methods to Estimate Parameters of Different Tempered Stable Distributions

##### ML#####
.asymptoticVarianceEstimML_KRTS <- function(data, EstimObj,
                                           type = "KRTS",
                                           eps,
                                           algo,
                                           regularization,
                                           WeightingMatrix,
                                           t_scheme,
                                           alphaReg,
                                           t_free,
                                           subdivisions,
                                           IntegrationMethod,
                                           randomIntegrationLaw,
                                           s_min,
                                           s_max,
                                           ncond,
                                           IterationControl,
                                           ...) {
    asymptoticVarianceEstimML_KRTS(thetaEst = EstimObj$Estim$par,
                                  n_sample = length(data), type = type,
                                  eps = eps,
                                  algo = algo,
                                  regularization = regularization,
                                  WeightingMatrix =
                                    WeightingMatrix,
                                  t_scheme = t_scheme,
                                  alphaReg = alphaReg,
                                  t_free = t_free,
                                  subdivisions = subdivisions,
                                  IntegrationMethod =
                                    IntegrationMethod,
                                  randomIntegrationLaw =
                                    randomIntegrationLaw,
                                  s_min = s_min,
                                  s_max = s_max,
                                  ncond = ncond,
                                  IterationControl = IterationControl,
                                  ...)
}

asymptoticVarianceEstimML_KRTS <- function(thetaEst, n_sample,
                                          type = "KRTS",
                                          subdivisions = 100,
                                          eps,
                                          algo,
                                          regularization,
                                          WeightingMatrix,
                                          t_scheme,
                                          alphaReg,
                                          t_free,
                                          IntegrationMethod,
                                          randomIntegrationLaw,
                                          s_min,
                                          s_max,
                                          ncond,
                                          IterationControl,
                                          ...) {
    NameParamsObjectsTemp(invFisherMatrix_KRTS(as.numeric(thetaEst),
                                              subdivisions)/n_sample,
                          type = type)
}


invFisherMatrix_KRTS <- function(theta, subdivisions = 100) {
    mat <- matrix(NA, 8, 8)
    integrand <- function(x, i, j) {
        invf <- 1/VectorialDensity_KRTS(theta, x)
        df <- jacVectorialDensity_KRTS(theta, x)
        y <- invf * df[, i] * df[, j]
    }
    for (i in 1:8) {
        for (j in 1:i) {
            mat[i, j] <- stats::integrate(f = integrand, lower = -Inf, upper = Inf,
                                   i = i, j = j,
                                   subdivisions = subdivisions)$value
            mat[j, i] <- mat[i, j]
        }
    }
    solve(mat)
}

VectorialDensity_KRTS <- function(theta, xi) {
    dKRTS(xi, theta[1], theta[2], theta[3], theta[4], theta[5], theta[6],
          theta[7], theta[8])
}

jacVectorialDensity_KRTS <- function(theta, xi) {
    NumDeriv_jacobian_KRTS(fctToDeriv = VectorialDensity_KRTS,
                          WhereFctIsEvaluated = theta, xi = xi)
}

NumDeriv_jacobian_KRTS <- function(fctToDeriv, WhereFctIsEvaluated, ...) {
    numDeriv::jacobian(fctToDeriv, WhereFctIsEvaluated, method = "Richardson",
             method.args = list(), ...)
}

##### GMM#####
.asymptoticVarianceEstimGMM_KRTS <- function(data, EstimObj,
                                            type = "KRTS", eps,
                                            algo,
                                            regularization,
                                            WeightingMatrix,
                                            t_scheme,
                                            alphaReg,
                                            t_free,
                                            subdivisions,
                                            IntegrationMethod,
                                            randomIntegrationLaw,
                                            s_min,
                                            s_max,
                                            ncond,
                                            IterationControl,
                                            ...) {
    V <- solve(GMMasymptoticVarianceEstim_KRTS(theta = EstimObj$Estim$par,
                                              t = EstimObj$tEstim, x = data,
                                              eps = eps,
                                              algo = algo,
                                              regularization = regularization,
                                              WeightingMatrix =
                                                WeightingMatrix,
                                              t_scheme = t_scheme,
                                              alphaReg = alphaReg,
                                              t_free = t_free,
                                              subdivisions = subdivisions,
                                              IntegrationMethod =
                                                IntegrationMethod,
                                              randomIntegrationLaw =
                                                randomIntegrationLaw,
                                              s_min = s_min,
                                              s_max = s_max,
                                              ncond = ncond,
                                              IterationControl =
                                                IterationControl,
                                              ...))/length(data)
    NameParamsObjects(V, type = type)
}

##### CGMM#####
.asymptoticVarianceEstimCgmm_KRTS <- function(data, EstimObj,
                                             type = "KRTS",
                                             eps,
                                             algo,
                                             regularization,
                                             WeightingMatrix,
                                             t_scheme,
                                             alphaReg,
                                             t_free,
                                             subdivisions,
                                             IntegrationMethod,
                                             randomIntegrationLaw,
                                             s_min,
                                             s_max,
                                             ncond,
                                             IterationControl,
                                             ...) {
    V <- ComputeCovarianceCgmm_KRTS(theta = EstimObj$Estim$par,
                                   thetaHat = EstimObj$Estim$par, x = data,
                                   eps = eps,
                                   algo = algo,
                                   regularization = regularization,
                                   WeightingMatrix =
                                     WeightingMatrix,
                                   t_scheme = t_scheme,
                                   alphaReg = alphaReg,
                                   t_free = t_free,
                                   subdivisions = subdivisions,
                                   IntegrationMethod =
                                     IntegrationMethod,
                                   randomIntegrationLaw =
                                     randomIntegrationLaw,
                                   s_min = s_min,
                                   s_max = s_max,
                                   ncond = ncond,
                                   IterationControl = IterationControl,
                                   ...)
    NameParamsObjects(Mod(ComputeCutOffInverse(V))/length(data), type = type)
}

ComputeCovarianceCgmm_KRTS <- function(theta, Cmat = NULL, x, alphaReg,
                                      thetaHat, s_min, s_max, subdivisions = 50,
                                      IntegrationMethod = c("Uniform",
                                                            "Simpson"),
                                      randomIntegrationLaw = c("norm",
                                                               "unif"), ...) {
    n <- length(x)
    IntegrationMethod <- match.arg(IntegrationMethod)
    randomIntegrationLaw <- match.arg(randomIntegrationLaw)
    CovMat <- ComputeCgmmFcts_KRTS(Fct = "Covariance", theta = theta,
                                  Cmat = Cmat, x = x, Weighting = "optimal",
                                  alphaReg = alphaReg, thetaHat = thetaHat,
                                  s_min = s_min, s_max = s_max,
                                  subdivisions = subdivisions,
                                  IntegrationMethod = IntegrationMethod,
                                  randomIntegrationLaw = randomIntegrationLaw,
                                  ...)
    CovMat/(n - 8)
}

##### GMC#####
# .asymptoticVarianceEstimGMC_KRTS <- function(data, EstimObj,
#                                             type = "KRTS", eps,
#                                             algo,
#                                             regularization,
#                                             WeightingMatrix,
#                                             t_scheme,
#                                             alphaReg,
#                                             t_free,
#                                             subdivisions,
#                                             IntegrationMethod,
#                                             randomIntegrationLaw,
#                                             s_min,
#                                             s_max,
#                                             ncond,
#                                             IterationControl,
#                                             ...) {
#     V <- solve(GMCasymptoticVarianceEstim_KRTS(theta = EstimObj$Estim$par,
#                                               ncond = EstimObj$ncond, x = data,
#                                               eps = eps,
#                                               algo = algo,
#                                               regularization = regularization,
#                                               WeightingMatrix =
#                                                 WeightingMatrix,
#                                               t_scheme = t_scheme,
#                                               alphaReg = alphaReg,
#                                               t_free = t_free,
#                                               subdivisions = subdivisions,
#                                               IntegrationMethod =
#                                                 IntegrationMethod,
#                                               randomIntegrationLaw =
#                                                 randomIntegrationLaw,
#                                               s_min = s_min,
#                                               s_max = s_max,
#                                               IterationControl =
#                                                 IterationControl,
#                                               ...))/length(data)
#     NameParamsObjects(V, type = type)
# }
#
# GMCasymptoticVarianceEstim_KRTS <- function(..., theta, x, ncond,
#                                            WeightingMatrix, alphaReg = 0.01,
#                                            regularization = "Tikhonov", eps) {
#     K <- ComputeGMCWeightingMatrix_KRTS(theta = theta, x = x, ncond = ncond,
#                                        WeightingMatrix = WeightingMatrix, ...)
#     B <- jacobianSampleRealCFMoment_KRTS(t, theta)
#     fct <- function(G) ComputeInvKbyG_KRTS(K = K, G = G, alphaReg = alphaReg,
#                                           regularization = regularization,
#                                           eps = eps)
#     invKcrossB <- apply(X = B, MARGIN = 2, FUN = fct)
#     crossprod(B, invKcrossB)
# }