R/RRegArchInternals.R

In gaspardcc/PMMMF:

#means
eConst<-as.integer(1)
eAr <- as.integer(2)
eMa <- as.integer(3)
eLinReg <- as.integer(4)
eStdInmean <- as.integer(5)
eVarInMean <- as.integer(6)
eArfima <- as.integer(7)
meanTypeStr <- c("Const", "Ar", "Ma", "LinReg", "StdInMean", "VarInMean", "Arfima")

#variances
eConstVar <- as.integer(1)
eArch <- as.integer(2)
eGarch <- as.integer(3)
eEgarch <- as.integer(4)
eAparch <- as.integer(5)
eTarch<- as.integer(6)
eFigarch <- as.integer(7)
eUgarch <- as.integer(8)
varTypeStr <- c("ConstVar", "Arch", "Garch", "Egarch", "Aparch", "Tarch", "Figarch", "Ugarch")


#Residuals
eNormal <- as.integer(1)
eStudent <- as.integer(2)
eGed <- as.integer(3)
eSkewt<-as.integer(4)
residTypeStr <- c("Normal", "Student", "Ged", "SkewT")

#GSL Algo type
#gsl_ConjugateFR <- as.integer(1)
#gsl_ConjugatePR <- as.integer(2)
#gsl_BFGS <- as.integer(3)
#gsl_BFGSTwo <- as.integer(4)
#gsl_Steepest <- as.integer(5)
#gsl_SimplexNM <- as.integer(6)
gslAlgoTypeStr <- c("gsl_ConjugateFR", "gsl_ConjugatePR", "gsl_BFGS", "gsl_BFGS2", "gsl_Steepest", "gsl_SimplexNM", "gsl_SimplexNM2", "gsl_SimplexNM2Rand")


#NLOPT Algo type
nloptAlgoTypeStr <- c("nlopt_gn_direct",
"nlopt_gn_direct_l",
"nlopt_gn_direct_l_rand",
"nlopt_gn_direct_noscal",
"nlopt_gn_direct_l_noscal",
"nlopt_gn_direct_l_rand_noscal",
"nlopt_gn_orig_direct",
"nlopt_gn_orig_direct_l",
"nlopt_gd_stogo",
"nlopt_gd_stogo_rand",
"nlopt_ld_lbfgs_nocedal",
"nlopt_ld_lbfgs",
"nlopt_ln_praxis",
"nlopt_ld_var1",
"nlopt_ld_var2",
"nlopt_ld_tnewton",
"nlopt_ld_tnewton_restart",
"nlopt_ld_tnewton_precond",
"nlopt_ld_tnewton_precond_restart",
"nlopt_gn_crs2_lm",
"nlopt_gn_mlsl",
"nlopt_gd_mlsl",
"nlopt_gn_mlsl_lds",
"nlopt_gd_mlsl_lds",
"nlopt_ld_mma",
"nlopt_ln_cobyla",
"nlopt_ln_newuoa",
"nlopt_ln_newuoa_bound",
"nlopt_ln_neldermead",
"nlopt_ln_sbplx",
"nlopt_ln_auglag",
"nlopt_ld_auglag",
"nlopt_ln_auglag_eq",
"nlopt_ld_auglag_eq",
"nlopt_ln_bobyqa",
"nlopt_gn_isres",
"nlopt_auglag",
"nlopt_auglag_eq",
"nlopt_g_mlsl",
"nlopt_g_mlsl_lds",
"nlopt_ld_slsqp",
"nlopt_ld_ccsaq",
"nlopt_gn_esch",
"nlopt_num_algorithms"
)

enumNloptAlgoType <- seq(0, length(nloptAlgoTypeStr)-1)

#NLOPT Error
nloptResult = cbind(c("eNlopt_failure",
"nlopt_invalid_args",
"nlopt_out_of_memory",
"nlopt_roundoff_limited",
"nlopt_forced_stop",
"nlopt_success",
"nlopt_stopval_reached",
"nlopt_ftol_reached",
"nlopt_xtol_reached",
"nlopt_maxeval_reached",
"nlopt_maxtime_reached"), c(-1,-2,-3,-4,-5,1,2,3,4,5,6))

#NLOPT AlgoName
nloptAlgoName <- c(
     "DIRECT (global, no-derivative)",
     "DIRECT-L (global, no-derivative)",
     "Randomized DIRECT-L (global, no-derivative)",
     "Unscaled DIRECT (global, no-derivative)",
     "Unscaled DIRECT-L (global, no-derivative)",
     "Unscaled Randomized DIRECT-L (global, no-derivative)",
     "Original DIRECT version (global, no-derivative)",
     "Original DIRECT-L version (global, no-derivative)",
     "StoGO (NOT COMPILED)",
     "StoGO randomized (NOT COMPILED)",
     "original L-BFGS code by Nocedal et al. (NOT COMPILED)",
     "Limited-memory BFGS (L-BFGS) (local, derivative-based)",
     "Principal-axis, praxis (local, no-derivative)",
     "Limited-memory variable-metric, rank 1 (local, derivative-based)",
     "Limited-memory variable-metric, rank 2 (local, derivative-based)",
     "Truncated Newton (local, derivative-based)",
     "Truncated Newton with restarting (local, derivative-based)",
     "Preconditioned truncated Newton (local, derivative-based)",
     "Preconditioned truncated Newton with restarting (local, derivative-based)",
     "Controlled random search (CRS2) with local mutation (global, no-derivative)",
     "Multi-level single-linkage (MLSL), random (global, no-derivative)",
     "Multi-level single-linkage (MLSL), random (global, derivative)",
     "Multi-level single-linkage (MLSL), quasi-random (global, no-derivative)",
     "Multi-level single-linkage (MLSL), quasi-random (global, derivative)",
     "Method of Moving Asymptotes (MMA) (local, derivative)",
     "COBYLA (Constrained Optimization BY Linear Approximations) (local, no-derivative)",
     "NEWUOA unconstrained optimization via quadratic models (local, no-derivative)",
     "Bound-constrained optimization via NEWUOA-based quadratic models (local, no-derivative)",
     "Nelder-Mead simplex algorithm (local, no-derivative)",
     "Sbplx variant of Nelder-Mead (re-implementation of Rowan's Subplex) (local, no-derivative)",
     "Augmented Lagrangian method (local, no-derivative)",
     "Augmented Lagrangian method (local, derivative)",
     "Augmented Lagrangian method for equality constraints (local, no-derivative)",
     "Augmented Lagrangian method for equality constraints (local, derivative)",
     "BOBYQA bound-constrained optimization via quadratic models (local, no-derivative)",
     "ISRES evolutionary constrained optimization (global, no-derivative)",
     "Augmented Lagrangian method (needs sub-algorithm)",
     "Augmented Lagrangian method for equality constraints (needs sub-algorithm)",
     "Multi-level single-linkage (MLSL), random (global, needs sub-algorithm)",
     "Multi-level single-linkage (MLSL), quasi-random (global, needs sub-algorithm)",
     "Sequential Quadratic Programming (SQP) (local, derivative)",
     "CCSA (Conservative Convex Separable Approximations) with simple quadratic approximations (local, derivative)",
     "ESCH evolutionary strategy")

setStorageMode <- function(object) UseMethod("setStorageMode")

setStorageMode.RegArchModelClass <- function(object)
{
    y <- object
    if (!is.null(y$condMean))
    {   if (is.list(y$condMean))
        {   ny <- length(y$condMean)
            z <- rep(list(NULL), ny)
            for (i in 1:ny)
            {   if (class(y$condMean[[i]]) == "condMeanClass") # Applatir la liste
                {   z[[i]] <- y$condMean[[i]][[1]]
                    class(z) <- class(y$condMean[[i]][[1]])
                }
                else
                {
                    z[[i]] <- y$condMean[[i]]
                }
                z[[i]] <- setStorageMode(z[[i]])
            }
            y$condMean <- z
        }
        else
        {   y$condMean <- setStorageMode(object$condMean)
        }
    }
    y$condVar <- setStorageMode(object$condVar)
    y$condRes <- setStorageMode(object$condRes)
    storage.mode(y) <- "list"
    return(y)
}

setStorageMode.condMeanClass <- function(object)
{
    y <- object
    for (i in 1:length(object))
        y[[i]] <- setStorageMode(object[[i]])
    storage.mode(y) <- "list"
    return(y)
}

setStorageMode.ArClass <- function(object)
{   x <- object
    storage.mode(x$meanType) <- "integer"
    storage.mode(x$nParam) <- "integer"
    storage.mode(x$nAr) <- "integer"
    storage.mode(x$Ar) <- "double"
    return(x)
}

setStorageMode.MaClass <- function(object)
{   x <- object
    storage.mode(x$meanType) <- "integer"
    storage.mode(x$nMa) <- "integer"
    storage.mode(x$nParam) <- "integer"
    storage.mode(x$Ma) <- "double"
    return(x)
}

setStorageMode.VarInMeanClass <- function(object)
{   x <- object
    storage.mode(x$meanType) <- "integer"
    storage.mode(x$nParam) <- "integer"
    storage.mode(x$Delta) <- "double"
    return(x)
}

setStorageMode.StdInMeanClass <- function(object)
{   x <- object
    storage.mode(x$meanType) <- "integer"
    storage.mode(x$nParam) <- "integer"
    storage.mode(x$Delta) <- "double"
    return(x)
}

setStorageMode.LinRegClass <- function(object)
{   x <- object
    storage.mode(x$meanType) <- "integer"
    storage.mode(x$nBeta) <- "integer"
    storage.mode(x$nParam) <- "integer"
    storage.mode(x$Beta) <- "double"
    return(x)
}

setStorageMode.ConstMeanClass <- function(object)
{   x <- object
    storage.mode(x$meanType) <- "integer"
    storage.mode(x$Const) <- "double"
    storage.mode(x$nParam) <- "integer"
    return(x)
}

setStorageMode.ArfimaClass <- function(object)
{   x <- object
    storage.mode(x$meanType) <- "integer"
    storage.mode(x$nAr) <- "integer"
    storage.mode(x$nMa) <- "integer"
    storage.mode(x$nParam) <- "integer"
    storage.mode(x$Ar) <- "double"
    storage.mode(x$Ma) <- "double"
    storage.mode(x$FracD) <- "double"
    return(x)
}


setStorageMode.CondVarClass <- function(object)
{
    return(NextMethod("setStorageMode", object))
}

setStorageMode.ConstVarClass <- function(object)
{   x <- object
    storage.mode(x$varType) <- "integer"
    storage.mode(x$ConstVar) <- "double"
    storage.mode(x$nParam) <- "integer"
    return(x)
}
setStorageMode.ArchClass <- function(object)
{   x <- object
    storage.mode(x$varType) <- "integer"
    storage.mode(x$ConstVar) <- "double"
    storage.mode(x$Arch) <- "double"
    storage.mode(x$nParam) <- "integer"
    return(x)
}

setStorageMode.GarchClass <- function(object)
{   x <- object
    storage.mode(x$varType) <- "integer"
    storage.mode(x$ConstVar) <- "double"
    storage.mode(x$Arch) <- "double"
    storage.mode(x$Garch) <- "double"
    storage.mode(x$nParam) <- "integer"
    return(x)
}

setStorageMode.TarchClass <- function(object)
{   x <- object
    storage.mode(x$varType) <- "integer"
    storage.mode(x$ConstVar) <- "double"
    storage.mode(x$ArchPlus) <- "double"
    storage.mode(x$ArchMinus) <- "double"
    storage.mode(x$nParam) <- "integer"
    return(x)
}

setStorageMode.EgarchClass <- function(object)
{   x <- object
    storage.mode(x$varType) <- "integer"
    storage.mode(x$ConstVar) <- "double"
    storage.mode(x$Arch) <- "double"
    storage.mode(x$Garch) <- "double"
    storage.mode(x$Teta) <- "double"
    storage.mode(x$Gamma) <- "double"
    storage.mode(x$nParam) <- "integer"
    return(x)
}

setStorageMode.AparchClass <- function(object)
{   x <- object
    storage.mode(x$varType) <- "integer"
    storage.mode(x$ConstVar) <- "double"
    storage.mode(x$Arch) <- "double"
    storage.mode(x$Garch) <- "double"
    storage.mode(x$Delta) <- "double"
    storage.mode(x$Gamma) <- "double"
    storage.mode(x$nParam) <- "integer"
    return(x)
}

setStorageMode.FigarchClass <- function(object)
{   x <- object
    storage.mode(x$varType) <- "integer"
    storage.mode(x$ConstVar) <- "double"
    storage.mode(x$Arch) <- "double"
    storage.mode(x$Garch) <- "double"
    storage.mode(x$FracD) <- "double"
    storage.mode(x$nParam) <- "integer"
    return(x)
}

setStorageMode.UgarchClass <- function(object)
{   x <- object
    storage.mode(x$varType) <- "integer"
    storage.mode(x$ExistConstBool) <- "integer"
    storage.mode(x$BetaV) <- "double"
    storage.mode(x$ConstVar) <- "double"
    storage.mode(x$Arch) <- "double"
    storage.mode(x$Garch) <- "double"
    return(x)
}

setStorageMode.RegArchResidualsClass <- function(object)
{
    return(NextMethod("setStorageMode", object))
}

setStorageMode.normalClass <- function(object)
{   x <- object
    storage.mode(x$distrType) <- "integer"
    storage.mode(x$nParam) <- "integer"
    return(x)
}

setStorageMode.studentClass <- function(object)
{
    x<-object
    storage.mode(x$distrType) <- "integer"
    storage.mode(x$nParam) <- "integer"
    storage.mode(x$paramLaw) <- "double"
    return(x)
}

setStorageMode.gedClass <- function(object)
{
    x<-object
    storage.mode(x$distrType) <- "integer"
    storage.mode(x$nParam) <- "integer"
    storage.mode(x$paramLaw) <- "double"
    return(x)
}

setStorageMode.skewtClass <- function(object)
{
    x<-object
    storage.mode(x$distrType) <- "integer"
    storage.mode(x$nParam) <- "integer"
    storage.mode(x$paramLaw) <- "double"
    return(x)
}

setStorageMode.GSLAlgoParamClass <- function(object)
{
    x<-object
    storage.mode(x$AlgoType) <- "integer"
    storage.mode(x$StepSize) <- "double"
    storage.mode(x$Tol) <- "double"
    storage.mode(x$StopValue) <- "double"
    storage.mode(x$NMaxIter) <- "integer"
    storage.mode(x$NMaxSeconds) <- "integer"
    storage.mode(x$Verbose) <- "integer"
    return(x)
}

setStorageMode.NLOPTAlgoParam <- function(object)
{
    x <- object
    storage.mode(x$Algo) <- "integer"
    storage.mode(x$MaxComputeTime) <- "double"
    storage.mode(x$StopValue) <- "double"
    storage.mode(x$fTol) <- "double"
    storage.mode(x$xTol) <- "double"
    storage.mode(x$Verbose) <- "integer"
    storage.mode(x$MaxFuncEval) <- "double"
    return(x)
}