Nothing
R/rgarch-methods.R
In rgarch: Flexible GARCH modelling in R
#################################################################################
##
## R package rgarch by Alexios Ghalanos Copyright (C) 2008, 2009, 2010, 2011
## This file is part of the R package rgarch.
##
## The R package rgarch is free software: you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation, either version 3 of the License, or
## (at your option) any later version.
##
## The R package rgarch is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
#################################################################################
#----------------------------------------------------------------------------------
# univariate spec method
#----------------------------------------------------------------------------------
ugarchspec = function(variance.model = list(model = "sGARCH", garchOrder = c(1,1),
submodel = NULL, external.regressors = NULL, variance.targeting = FALSE),
mean.model = list(armaOrder = c(1,1), include.mean = TRUE, garchInMean = FALSE,
inMeanType = 1, arfima = FALSE, external.regressors = NULL),
distribution.model = "norm", start.pars = list(), fixed.pars = list(), ...)
{
UseMethod("ugarchspec")
}
.ugarchspec = function(variance.model = list(model = "sGARCH", garchOrder = c(1,1),
submodel = NULL, external.regressors = NULL, variance.targeting = FALSE),
mean.model = list(armaOrder = c(1,1), include.mean = TRUE, garchInMean = FALSE,
inMeanType = 1, arfima = FALSE, external.regressors = NULL),
distribution.model = "norm", start.pars = list(), fixed.pars = list())
{
# some checks and preparation to be passed on to specific models by switch
# distribution model
dmodel = list()
if(is.null(distribution.model)) dmodel$distribution = "norm"
valid.distribution = c("norm", "snorm", "std", "sstd","ged", "sged", "nig", "ghyp", "jsu")
distribution = distribution.model
if(!is.character(distribution[1]))
stop("\nugarchspec-->error: cond.distribution argument must be a character")
if(!any(distribution==valid.distribution))
stop("\nugarchspec-->error: the cond.distribution does not appear to be a valid choice.")
if(length(distribution)!=1) distribution = distribution[1]
dmodel$distribution = distribution
dmodel$distno = which(distribution == valid.distribution)
di = .DistributionBounds(distribution)
dmodel$include.dlambda = di$include.dlambda
dmodel$include.skew = di$include.skew
dmodel$include.shape = di$include.shape
# variance model:
vmodel = list()
valid.model = c("sGARCH", "eGARCH", "gjrGARCH", "tGARCH", "fGARCH", "iGARCH", "apARCH")
if(is.null(variance.model$model)){
vmodel$model = "sGARCH"
} else{
vmodel$model = variance.model$model[1]
if(!is.character(vmodel$model))
stop("\nugarchspec-->error: garch model argument must be a character.\n", call. = FALSE)
if(!any(vmodel$model == valid.model))
stop("\nugarchspec-->error: the garch model does not appear to be a valid choice.\n", call. = FALSE)
if(vmodel$model == "fiGARCH"){
vmodel$submodel = variance.model$submodel
valid.submodel = c("BBM", "Chung")
if(is.null(vmodel$submodel))
stop("\nugarchspec-->error: NULL not allowed for the submodel when model is of type fiGARCH.\n", call. = FALSE)
if(!any(vmodel$submodel==valid.submodel))
stop("\nugarchspec-->error: the fiGARCH submodel does not appear to be a valid choice. Valid choices are BBM and Chung.\n", call. = FALSE)
}
if(vmodel$model == "fGARCH"){
vmodel$submodel = variance.model$submodel
valid.submodel = c("GARCH","TGARCH","AVGARCH","NGARCH","NAGARCH","APARCH","ALLGARCH","GJRGARCH")
if(is.null(vmodel$submodel))
stop("\nugarchspec-->error: NULL not allowed for the submodel when model is of type fGARCH.\n", call. = FALSE)
if(!any(vmodel$submodel == valid.submodel))
stop("\nugarchspec-->error: the fGARCH submodel does not appear to be a valid choice. See documentation for valid choices.\n", call. = FALSE)
}
}
if(is.null(variance.model$garchOrder)){
if(vmodel$model == "anstGARCH"){
vmodel$garchOrder = c(1, 1, 1, 1)
} else{
vmodel$garchOrder = c(1, 1)
}
} else{
if(vmodel$model == "anstGARCH"){
if( length(variance.model$garchOrder) == 2 ) vmodel$garchOrder = c(vmodel$garchOrder[1], vmodel$garchOrder[2], 0, 0) else vmodel$garchOrder = variance.model$garchOrder
} else{
vmodel$garchOrder = variance.model$garchOrder
}
}
vmodel$external.regressors = variance.model$external.regressors
if(is.null(variance.model$variance.targeting)) vmodel$targeting = FALSE else vmodel$targeting = variance.model$variance.targeting
model = vmodel$model
# mean model:
mmodel=list()
if(is.null(mean.model$armaOrder))
mmodel$armaOrder = c(1,1) else mmodel$armaOrder = mean.model$armaOrder
if(is.null(mean.model$include.mean))
mmodel$include.mean = TRUE else mmodel$include.mean = mean.model$include.mean
if(is.null(mean.model$garchInMean) || !mean.model$garchInMean){
mmodel$garchInMean = FALSE
mmodel$inMeanType = 0
} else{
mmodel$garchInMean = mean.model$garchInMean
if(is.null(mean.model$inMeanType)) mmodel$inMeanType = 1 else mmodel$inMeanType = mean.model$inMeanType
}
if(is.null(mean.model$arfima))
mmodel$arfima = FALSE else mmodel$arfima = mean.model$arfima
mmodel$external.regressors = mean.model$external.regressors
spec = switch(model,
sGARCH = .sgarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
fGARCH = .fgarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
eGARCH = .egarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
gjrGARCH = .gjrgarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
apARCH = .aparchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
iGARCH = .igarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
#anstGARCH = .anstgarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars)
#fiGARCH = .fiGARCHspec(vmodel, mmodel, dmodel, start.pars,...),
#fiAPARCH = .fiAPARCHspec(vmodel, mmodel, dmodel, start.pars,...),
#fiEGARCH = .fiEGARCHspec(vmodel, mmodel, dmodel, start.pars,...),
#hyGARCH = .hyGARCHspec(vmodel, mmodel, dmodel, start.pars,...))
)
return(spec)
}
setMethod(f = "ugarchspec", definition = .ugarchspec)
# extract spec from fit object
getspec = function(object)
{
UseMethod("getspec")
}
.getspec = function(object)
{
spec = ugarchspec(variance.model = list(model = object@model$model, garchOrder = object@model$garchOrder,
submodel = object@model$submodel, external.regressors = object@model$vexdata),
mean.model = list(armaOrder = object@model$armaOrder, include.mean = object@model$include.mean,
garchInMean = object@model$garchInMean, inMeanType = object@model$inMeanType,
arfima = object@model$arfima, external.regressors = object@model$mexdata),
distribution.model = object@model$distribution, start.pars = object@model$start.pars,
fixed.pars = object@model$start.pars)
return(spec)
}
setMethod(f = "getspec", signature(object = "uGARCHfit"), definition = .getspec)
#----------------------------------------------------------------------------------
# univariate filter method
#----------------------------------------------------------------------------------
ugarchfilter = function(spec, data, out.sample = 0, n.old = NULL, ...)
{
UseMethod("ugarchfilter")
}
setMethod("ugarchfilter", signature(spec = "sGARCHspec"), .sgarchfilter)
setMethod("ugarchfilter", signature(spec = "fGARCHspec"), .fgarchfilter)
setMethod("ugarchfilter", signature(spec = "eGARCHspec"), .egarchfilter)
setMethod("ugarchfilter", signature(spec = "gjrGARCHspec"), .gjrgarchfilter)
setMethod("ugarchfilter", signature(spec = "apARCHspec"), .aparchfilter)
setMethod("ugarchfilter", signature(spec="iGARCHspec"), .igarchfilter)
#setMethod("ugarchfilter", signature(spec="anstGARCHspec"), .anstgarchfilter)
#----------------------------------------------------------------------------------
# univariate fit method
#----------------------------------------------------------------------------------
ugarchfit = function(spec, data, out.sample = 0, solver = "solnp", solver.control = list(),
fit.control = list(stationarity = 1, fixed.se = 0, scale = 0), ...)
{
UseMethod("ugarchfit")
}
setMethod("ugarchfit", signature(spec = "sGARCHspec"), .sgarchfit)
setMethod("ugarchfit", signature(spec = "fGARCHspec"), .fgarchfit)
setMethod("ugarchfit", signature(spec = "eGARCHspec"), .egarchfit)
setMethod("ugarchfit", signature(spec = "gjrGARCHspec"), .gjrgarchfit)
setMethod("ugarchfit", signature(spec = "apARCHspec"), .aparchfit)
setMethod("ugarchfit", signature(spec="iGARCHspec"), .igarchfit)
#setMethod("ugarchfit", signature(spec="anstGARCHspec"), .anstgarchfit)
#----------------------------------------------------------------------------------
# univariate forecast method
#----------------------------------------------------------------------------------
ugarchforecast = function(fitORspec, data = NULL, n.ahead = 10, n.roll = 0, out.sample = 0,
external.forecasts = list(mregfor = NULL, vregfor = NULL), ...)
{
UseMethod("ugarchforecast")
}
setMethod("ugarchforecast", signature(fitORspec = "sGARCHfit"), .sgarchforecast)
setMethod("ugarchforecast", signature(fitORspec = "fGARCHfit"), .fgarchforecast)
setMethod("ugarchforecast", signature(fitORspec = "eGARCHfit"), .egarchforecast)
setMethod("ugarchforecast", signature(fitORspec = "gjrGARCHfit"), .gjrgarchforecast)
setMethod("ugarchforecast", signature(fitORspec = "apARCHfit"), .aparchforecast)
setMethod("ugarchforecast", signature(fitORspec = "iGARCHfit"), .igarchforecast)
#setMethod("ugarchforecast", signature(fitORspec = "anstGARCHfit"), .anstgarchforecast)
#alternative dispath method:
# we use the fitORspec rather than a method with fit, spec and data with missing
# methods as this requires implicit declaration of arguments
setMethod("ugarchforecast", signature(fitORspec = "sGARCHspec"), .sgarchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "fGARCHspec"), .fgarchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "eGARCHspec"), .egarchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "gjrGARCHspec"), .gjrgarchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "apARCHspec"), .aparchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "iGARCHspec"), .igarchforecast2)
#setMethod("ugarchforecast", signature(fitORspec = "anstGARCHspec"), .anstgarchforecast2)
#----------------------------------------------------------------------------------
# univariate forecast performance measure
#----------------------------------------------------------------------------------
fpm = function(object, ...)
{
UseMethod("fpm")
}
setMethod("fpm", signature(object = "uGARCHforecast"), .fpm)
#----------------------------------------------------------------------------------
# univariate simulation method
#----------------------------------------------------------------------------------
ugarchsim = function(fit, n.sim = 1000, n.start = 0, m.sim = 1,
startMethod = c("unconditional","sample"),
presigma = NA, prereturns = NA, preresiduals = NA, rseed = NA,
custom.dist = list(name = NA, distfit = NA), mexsimdata = NULL,
vexsimdata = NULL, ...)
{
UseMethod("ugarchsim")
}
setMethod("ugarchsim", signature(fit = "sGARCHfit"), .sgarchsim)
setMethod("ugarchsim", signature(fit = "fGARCHfit"), .fgarchsim)
setMethod("ugarchsim", signature(fit = "eGARCHfit"), .egarchsim)
setMethod("ugarchsim", signature(fit = "gjrGARCHfit"), .gjrgarchsim)
setMethod("ugarchsim", signature(fit = "apARCHfit"), .aparchsim)
setMethod("ugarchsim", signature(fit = "iGARCHfit"), .igarchsim)
#setMethod("ugarchsim", signature(fit = "anstGARCHfit"), .anstgarchsim)
#----------------------------------------------------------------------------------
# univariate path simulation method
#----------------------------------------------------------------------------------
ugarchpath = function(spec, n.sim = 1000, n.start = 0, m.sim = 1,
presigma = NA, prereturns = NA, preresiduals = NA, rseed = NA,
custom.dist = list(name = NA, distfit = NA), mexsimdata = NULL,
vexsimdata = NULL, ...)
{
UseMethod("ugarchpath")
}
setMethod("ugarchpath", signature(spec = "sGARCHspec"), .sgarchpath)
setMethod("ugarchpath", signature(spec = "fGARCHspec"), .fgarchpath)
setMethod("ugarchpath", signature(spec = "eGARCHspec"), .egarchpath)
setMethod("ugarchpath", signature(spec = "gjrGARCHspec"), .gjrgarchpath)
setMethod("ugarchpath", signature(spec = "apARCHspec"), .aparchpath)
setMethod("ugarchpath", signature(spec = "iGARCHspec"), .igarchpath)
#setMethod("ugarchpath", signature(spec = "anstGARCHspec"), .anstgarchpath)
#----------------------------------------------------------------------------------
# univariate garch roll
#----------------------------------------------------------------------------------
# methods to recursively predict/filter/compare with refitting at every N points.
ugarchroll = function(spec, data, n.ahead = 1, forecast.length = 500,
refit.every = 25, refit.window = c("recursive", "moving"), parallel = FALSE,
parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2),
solver = "solnp", fit.control = list(), solver.control = list() ,
calculate.VaR = TRUE, VaR.alpha = c(0.01, 0.05), ...)
{
setMethod("ugarchroll")
}
setMethod("ugarchroll", signature(spec = "sGARCHspec"), definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "iGARCHspec"), definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "gjrGARCHspec"),definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "eGARCHspec"), definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "fGARCHspec"), definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "apARCHspec"), definition = .rollfdensity)
#setMethod("ugarchroll", signature(spec = "anstGARCHspec"), definition = .rollfdensity)
#----------------------------------------------------------------------------------
# univariate garch parameter distribution
#----------------------------------------------------------------------------------
ugarchdistribution = function(fitORspec, data = NULL, n.sim = 2000, n.start = 1,
m.sim = 100, recursive = FALSE, recursive.length = 6000, recursive.window = 1000,
presigma = NA, prereturns = NA, preresiduals = NA, rseed = NA,
custom.dist = list(name = NA, distfit = NA), mexsimdata = NULL,
vexsimdata = NULL, fit.control = list(), solver = "solnp",
solver.control = list(), parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
setMethod("ugarchdistribution")
}
setMethod("ugarchdistribution", signature(fitORspec = "uGARCHfit"), .ugarchdistribution)
setMethod("ugarchdistribution", signature(fitORspec = "uGARCHspec"), .ugarchdistribution)
#----------------------------------------------------------------------------------
# univariate garch bootstrap based forecast distribution
#----------------------------------------------------------------------------------
ugarchboot = function(fitORspec, data = NULL, method = c("Partial", "Full"), n.ahead = 10,
n.bootfit = 100, n.bootpred = 500, out.sample = 0, rseed = NA, solver = "solnp",
solver.control = list(), fit.control = list(), external.forecasts = list(mregfor = NULL,
vregfor = NULL), parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2))
{
setMethod("ugarchboot")
}
setMethod("ugarchboot", signature(fitORspec = "uGARCHfit"), .ugarchbootfit)
setMethod("ugarchboot", signature(fitORspec = "uGARCHspec"), .ugarchbootspec)
#----------------------------------------------------------------------------------
# univariate plot method / seperate for fit,sim and forecast
#----------------------------------------------------------------------------------
setMethod(f = "plot", signature(x = "uGARCHfit", y = "missing"), .plotgarchfit)
setMethod(f = "plot", signature(x = "uGARCHfilter", y = "missing"), .plotgarchfilter)
setMethod(f = "plot", signature(x = "uGARCHsim", y = "missing"), .plotgarchsim)
setMethod(f = "plot", signature(x = "uGARCHforecast", y = "missing"), .plotgarchforecast)
setMethod(f = "plot", signature(x = "uGARCHpath", y = "missing"), .plotgarchpath)
setMethod(f = "plot", signature(x = "uGARCHroll", y = "missing"), .plotgarchroll)
setMethod(f = "plot", signature(x = "uGARCHdistribution", y = "missing"), .plotgarchdist)
setMethod(f = "plot", signature(x = "uGARCHboot", y = "missing"), .plotgarchboot)
#----------------------------------------------------------------------------------
# univariate show method / seperate for fit,sim and forecast
#----------------------------------------------------------------------------------
# spec show
setMethod("show",
signature(object = "uGARCHspec"),
function(object){
model = strsplit(class(object),"spec")
cat(paste("\n*----------------------------*", sep = ""))
cat(paste("\n* GARCH Model Spec *", sep = ""))
cat(paste("\n*----------------------------*", sep = ""))
cat("\n\nVariance Model\t")
cat(paste("\n-------------------------------\n",sep=""))
cat(paste("GARCH Model\t\t: ", model, "\n", sep = ""))
if(object@variance.model$model == "fGARCH"){
cat(paste("fGARCH Sub-Model: ", object@variance.model$submodel, "\n", sep = ""))
}
cat("GARCH Order\t\t:", object@variance.model$garchOrder[1:2], "\n")
if(object@variance.model$include.vex)
cat(paste("Exogenous Regressor Dimension: ",
dim(object@variance.model$vexdata)[2], "\n",sep = ""))
cat("\nMean Model")
cat(paste("\n-------------------------------\n",sep=""))
cat("AR-MA Order\t\t: ",object@mean.model$armaOrder[1:2],"\n")
cat("Include Mean\t: ", as.logical(object@mean.model$include.mean),"\n")
cat("Garch-in-Mean\t: ",as.logical(object@mean.model$garchInMean),"\n")
cat("ARFIMA\t\t\t: ", as.logical(object@mean.model$arfima),"\n")
if(object@mean.model$include.mex)
cat(paste("Exogenous Regressor Dimension: ",
dim(object@mean.model$mexdata)[2],"\n",sep=""))
cat("\nConditional Distribution Model")
cat(paste("\n-------------------------------\n",sep=""))
cat("Distribution\t: ",object@distribution.model$distribution,"\n")
cat("Includes Lambda\t: ", as.logical(object@distribution.model$include.dlambda),"\n")
cat("Includes Skew\t: ", as.logical(object@distribution.model$include.skew),"\n")
cat("Includes Shape\t: ", as.logical(object@distribution.model$include.shape),"\n\n")
invisible(object)
})
# fit show
setMethod("show",
signature(object = "uGARCHfit"),
function(object){
model = strsplit(class(object),"fit")
garchOrder = object@model$garchOrder
cat(paste("\n*---------------------------*", sep = ""))
cat(paste("\n* GARCH Model Fit *", sep = ""))
cat(paste("\n*---------------------------*", sep = ""))
cat("\n\nSpec")
cat(paste("\n--------------------------", sep = ""))
cat(paste("\nModel\t: ", model," (", garchOrder[1], ",", garchOrder[2], ")", sep=""))
if(object@model$model=="fGARCH" | object@model$model == "fiGARCH"){
cat(paste(" Sub-Model\t: ", object@model$submodel, "\n", sep = ""))
}
if(object@model$include.vex){
cat("\nExogenous Regressors in variance equation: ", object@model$vxn, "\n")
} else{
cat("\nExogenous Regressors in variance equation: none\n")
}
cat("\nInclude Mean\t: ", object@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@model$armaOrder[1],",",
as.integer(object@model$arfima),
",",object@model$armaOrder[2],")",sep=""))
cat("\nGarch-in-Mean\t: ", as.logical(object@model$garchInMean))
if(object@model$include.mex){
cat("\nExogenous Regressors in mean equation: ",object@model$mxn)
} else{
cat("\nExogenous Regressors in mean equation: none")
}
cat("\n\nConditional Distribution: ",object@model$distribution,"\n")
if(object@fit$convergence == 0){
cat("\nOptimal Parameters")
cat(paste("\n--------------------------\n", sep = ""))
print(round(object@fit$matcoef,6), digits = 5)
cat("\nRobust Standard Errors:\n")
print(round(object@fit$robust.matcoef,6), digits = 5)
if(!is.null(object@fit$hessian.message)){
cat(paste("\n", object@fit$hessian.message))
}
cat("\nLogLikelihood :", object@fit$LLH, "\n")
stdresid = object@fit$residuals/object@fit$sigma
itest = .information.test(object@fit$LLH, nObs = length(object@fit$data),
nPars=length(object@fit$coef))
itestm = matrix(0, ncol = 1, nrow = 4)
itestm[1,1] = itest$AIC
itestm[2,1] = itest$BIC
itestm[3,1] = itest$SIC
itestm[4,1] = itest$HQIC
colnames(itestm) = ""
rownames(itestm) = c("Akaike", "Bayes", "Shibata", "Hannan-Quinn")
cat("\nInformation Criteria")
cat("\n--------------------------\n")
print(itestm,digits=5)
cat("\nQ-Statistics on Standardized Residuals")
cat("\n--------------------------\n")
tmp1 = .box.test(stdresid, p = 1, df = sum(object@model$armaOrder))
print(tmp1, digits = 4)
cat("\nH0 : No serial correlation\n")
cat("\nQ-Statistics on Standardized Squared Residuals")
cat("\n--------------------------\n")
tmp2 = .box.test(stdresid, p = 2, df = sum(object@model$armaOrder))
print(tmp2, digits = 4)
cat("\nARCH LM Tests")
cat("\n--------------------------\n")
L2 = .archlmtest(stdresid, lags = 2)
L5 = .archlmtest(stdresid, lags = 5)
L10 = .archlmtest(stdresid, lags = 10)
alm = matrix(0,ncol = 3,nrow = 3)
alm[1,1:3] = c(L2$statistic, L2$parameter, L2$p.value)
alm[2,1:3] = c(L5$statistic, L5$parameter, L5$p.value)
alm[3,1:3] = c(L10$statistic, L10$parameter, L10$p.value)
colnames(alm) = c("Statistic", "DoF", "P-Value")
rownames(alm) = c("ARCH Lag[2]", "ARCH Lag[5]", "ARCH Lag[10]")
print(alm,digits = 4)
nyb = .nyblomTest(object)
colnames(nyb$IndividualStat)<-""
cat("\nNyblom stability test")
cat("\n--------------------------\n")
cat("Joint Statistic: ",round(nyb$JointStat,4))
cat("\nIndividual Statistics:")
print(nyb$IndividualStat, digits = 4)
cat("\nAsymptotic Critical Values (10% 5% 1%)")
cat("\nJoint Statistic: ", round(nyb$JointCritical, 4))
cat("\nIndividual Statistic:", round(nyb$IndividualCritical, 4))
cat("\n\n")
cat("Sign Bias Test")
cat("\n--------------------------\n")
sgtest = signbias(object)
print(sgtest, digits = 4)
cat("\n")
cat("\nAdjusted Pearson Goodness-of-Fit Test:")
cat("\n--------------------------\n")
gofm = gof(object,c(20, 30, 40, 50))
print(gofm, digits = 4)
cat("\n")
cat("\nElapsed time :", object@fit$timer,"\n\n")
} else{
cat("\nConvergence Problem:")
cat("\nSolver Message:", object@fit$message,"\n\n")
}
invisible(object)
})
# filter show
setMethod("show",
signature(object = "uGARCHfilter"),
function(object){
model = strsplit(class(object), "filter")
garchOrder = object@model$garchOrder
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n* GARCH Model Filter *", sep = ""))
cat(paste("\n*--------------------------------*", sep = ""))
cat("\n\nSpec")
cat(paste("\n--------------------------", sep = ""))
cat(paste("\nModel\t: ", model," (", garchOrder[1], ",", garchOrder[2], ")", sep=""))
if(object@model$model=="fGARCH" | object@model$model == "fiGARCH"){
cat(paste(" Sub-Model\t: ", object@model$submodel, "\n", sep = ""))
}
if(object@model$include.vex){
cat("\nExogenous Regressors in variance equation: ", object@model$vxn, "\n")
} else{
cat("\nExogenous Regressors in variance equation: none\n")
}
cat("\nInclude Mean\t: ", object@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@model$armaOrder[1],",",
as.integer(object@model$arfima),
",",object@model$armaOrder[2],")",sep=""))
cat("\nGarch-in-Mean\t: ", as.logical(object@model$garchInMean))
if(object@model$include.mex){
cat("\nExogenous Regressors in mean equation: ",object@model$mxn)
} else{
cat("\nExogenous Regressors in mean equation: none")
}
cat("\n\nConditional Distribution: ",object@model$distribution,"\n")
cat("\nFilter Parameters")
cat(paste("\n--------------------------\n", sep = ""))
print(matrix(object@filter$pars, ncol=1,
dimnames = list(names(coef(object)), "")), digits = 5)
cat("\nLogLikelihood :", object@filter$LLH, "\n")
stdresid = object@filter$residuals/object@filter$sigma
itest = infocriteria(object)
print(itest,digits=5)
cat("\nQ-Statistics on Standardized Residuals")
cat("\n--------------------------\n")
tmp1 = .box.test(stdresid, p = 1, df = sum(object@model$armaOrder))
print(tmp1, digits = 4)
cat("\nH0 : No serial correlation\n")
cat("\nQ-Statistics on Standardized Squared Residuals")
cat("\n--------------------------\n")
tmp2 = .box.test(stdresid, p = 2, df = sum(object@model$armaOrder))
print(tmp2, digits = 4)
cat("\nARCH LM Tests")
cat("\n--------------------------\n")
L2 = .archlmtest(stdresid, lags = 2)
L5 = .archlmtest(stdresid, lags = 5)
L10 = .archlmtest(stdresid, lags = 10)
alm = matrix(0,ncol = 3,nrow = 3)
alm[1,1:3] = c(L2$statistic, L2$parameter, L2$p.value)
alm[2,1:3] = c(L5$statistic, L5$parameter, L5$p.value)
alm[3,1:3] = c(L10$statistic, L10$parameter, L10$p.value)
colnames(alm) = c("Statistic", "DoF", "P-Value")
rownames(alm) = c("ARCH Lag[2]", "ARCH Lag[5]", "ARCH Lag[10]")
print(alm,digits = 4)
cat("\n\n")
cat("Sign Bias Test")
cat("\n--------------------------\n")
sgtest = signbias(object)
print(sgtest, digits = 4)
cat("\n")
cat("\nAdjusted Pearson Goodness-of-Fit Test:")
cat("\n--------------------------\n")
gofm = gof(object,c(20, 30, 40, 50))
print(gofm, digits = 4)
cat("\n")
invisible(object)
})
# sim show
setMethod("show",
signature(object = "uGARCHsim"),
function(object){
model = strsplit(class(object), "sim")
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* GARCH Model Simulation *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\nModel : ",model,sep=""))
if(object@model$model == "fGARCH" | object@model$model == "fiGARCH"){
cat(paste(" Sub-Model : ", object@model$submodel, "\n", sep = ""))
}
sim = object@simulation
dates = object@model$dates
sigma = sim$sigmaSim
series = sim$seriesSim
resids = sim$residSim
m = dim(sigma)[2]
N = dim(sigma)[1]
cat(paste("\nHorizon: ",N))
cat(paste("\nSimulations: ",m,"\n",sep=""))
sd1 = apply(sigma^2, 2, FUN=function(x) mean(x))
sd2 = apply(sigma^2, 2, FUN=function(x) range(x))
rx1 = apply(series, 2, FUN=function(x) mean(x))
rx2 = apply(series, 2, FUN=function(x) range(x))
actual = c(0,mean(object@simulation$sigma^2), min(object@simulation$sigma^2),
max(object@simulation$sigma^2), mean(object@simulation$series),
min(object@simulation$series), max(object@simulation$series))
dd = data.frame(Seed = object@seed, Sigma2.Mean = sd1, Sigma2.Min = sd2[1,],
Sigma2.Max = sd2[2,], Series.Mean = rx1, Series.Min = rx2[1,],
Series.Max = rx2[2,])
meansim = apply(dd, 2, FUN = function(x) mean(x))
meansim[1] = 0
dd = rbind(dd, meansim, actual)
rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)", "Actual")
print(dd,digits = 3)
cat("\n\n")
})
# forecast show
setMethod("show",
signature(object = "uGARCHforecast"),
function(object){
model = strsplit(class(object),"forecast")
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* GARCH Model Forecast *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\nModel: ", model, sep = ""))
if(object@model$model == "fGARCH" | object@model$model == "fiGARCH"){
cat(paste(" Sub-Model: ", object@model$submodel, "\n", sep = ""))
}
n.ahead = object@forecast$n.ahead
cat(paste("\nHorizon: ", n.ahead, sep = ""))
cat(paste("\nRoll Steps: ",object@forecast$n.roll, sep = ""))
n.start = object@forecast$n.start
if(n.start>0) infor = ifelse(n.ahead>n.start, n.start, n.ahead) else infor = 0
cat(paste("\nOut of Sample: ", infor, "\n", sep = ""))
cat("\n0-roll forecast: \n")
zz = object@forecast$forecast[[1]]
print(zz, digits = 4)
cat("\n\n")
})
# path show
setMethod("show",
signature(object = "uGARCHpath"),
function(object){
model = strsplit(class(object), "path")
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* GARCH Model Path Simulation *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\nModel : ", model, sep = ""))
sim = object@path
sigma = sim$sigmaSim
series = sim$seriesSim
resids = sim$residSim
m = dim(sigma)[2]
N = dim(sigma)[1]
cat(paste("\nHorizon: ", N))
cat(paste("\nSimulations: ", m, "\n", sep = ""))
sd1 = apply(sigma, 2, FUN = function(x) mean(x))
sd2 = apply(sigma, 2, FUN = function(x) range(x))
rx1 = apply(series, 2, FUN = function(x) mean(x))
rx2 = apply(series, 2, FUN = function(x) range(x))
dd = data.frame(Seed = object@seed, Sigma.Mean = sd1, Sigma.Min = sd2[1,],
Sigma.Max = sd2[2,], Series.Mean = rx1, Series.Min = rx2[1,],
Series.Max = rx2[2,])
meansim = apply(dd, 2, FUN = function(x) mean(x))
meansim[1] = 0
dd = rbind(dd, meansim)
rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)")
print(dd, digits = 3)
cat("\n\n")
})
# distribution show
setMethod("show",
signature(object = "uGARCHdistribution"),
function(object){
model = object@spec@variance.model$model
submodel = object@spec@variance.model$submodel
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* GARCH Parameter Distribution *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\nModel : ", model, sep = ""))
if(model == "fGARCH"){
cat(paste("\nSubModel : ", submodel, sep = ""))
}
cat(paste("\nNo. Paths (m.sim) : ", object@dist$details$m.sim, sep = ""))
cat(paste("\nLength of Paths (n.sim) : ", object@dist$details$n.sim, sep = ""))
cat(paste("\nRecursive : ", object@dist$details$recursive, sep = ""))
if(object@dist$details$recursive){
cat(paste("\nRecursive Length : ", object@dist$details$recursive.length, sep = ""))
cat(paste("\nRecursive Window : ", object@dist$details$recursive.window, sep = ""))
}
cat("\n\n")
cat("Coefficients: True vs Simulation Mean (Window-n)\n")
nwindows = object@dist$details$nwindows
nm = object@dist$details$n.sim + (0:(nwindows-1))*object@dist$details$recursive.window
ns = matrix(0, ncol = dim(object@truecoef)[1], nrow = nwindows)
for(i in 1:nwindows){
ns[i,] = apply(as.data.frame(object, window = i), 2, FUN = function(x) mean(x, na.rm = T))
}
ns = rbind(object@truecoef[,1], ns)
colnames(ns) = rownames(object@truecoef)
rownames(ns) = c("true-coef",paste("window-", nm, sep=""))
print(as.data.frame(ns), digits=5)
for(i in 1:nwindows){
if(any(object@dist[[i]]$convergence==1)) n = length(which(object@dist[[i]]$convergence==1)) else n = 0
if(n>0) cat(paste("\nwindow-",nm[i]," no. of non-converged fits: ", n, "\n",sep=""))
}
cat("\n\n")
})
# fpm show
setMethod("show",
signature(object = "uGARCHfpm"),
function(object){
model = object@details$model
submodel = object@details$submodel
cat(paste("\n*---------------------------------------------*", sep = ""))
cat(paste("\n* GARCH Forecast Performance Measures *", sep = ""))
cat(paste("\n*---------------------------------------------*", sep = ""))
cat(paste("\nModel : ", model, sep = ""))
if(model == "fGARCH"){
cat(paste("\nSubModel : ", submodel, sep = ""))
}
cat(paste("\nn.ahead : ", object@details$n.ahead, sep = ""))
cat(paste("\nn.roll : ", object@details$n.roll, sep = ""))
cat(paste("\nfpm type : ", object@details$type, sep = ""))
if(object@details$type==2){
cat("\nForecasts w/th Mean Loss Functions\n(1-ahead rolling)\n")
fc = cbind(t(object@forecasts$series), t(object@forecasts$sigma))
fc = rbind(fc, cbind(object@seriesfpm$meanloss["mse"], object@sigmafpm$meanloss["mse"]))
fc = rbind(fc, cbind(object@seriesfpm$meanloss["mad"], object@sigmafpm$meanloss["mad"]))
fc = rbind(fc, cbind(object@seriesfpm$meanloss["dac"], NA))
fc = rbind(fc, cbind(NA, object@sigmafpm$meanloss["r2log"]))
fc = rbind(fc, cbind(NA, object@sigmafpm$meanloss["qlike"]))
colnames(fc) = c("series", "sigma")
cat("\n")
print(round(fc,6), digits = 5)
cat("\n* performance measures for sigma are based on variance")
} else{
cat("\nMean Loss Functions\n(n.ahead/n.roll)\n")
cat("\nseries\n")
fc1 = object@seriesfpm$meanloss
colnames(fc1) = colnames(object@forecasts$series)
print(t(fc1), digits=5)
cat("\nsigma\n")
fc2 = object@sigmafpm$meanloss
colnames(fc2) = colnames(object@forecasts$sigma)
print(t(fc2), digits=5)
cat("\n* performance measures for sigma are based on variance")
}
cat("\n\n")
})
# boot show
setMethod("show",
signature(object = "uGARCHboot"),
function(object){
model = object@spec@variance.model$model
submodel = object@spec@variance.model$submodel
cat(paste("\n*-----------------------------------*", sep = ""))
cat(paste("\n* GARCH Bootstrap Forecast *", sep = ""))
cat(paste("\n*-----------------------------------*", sep = ""))
cat(paste("\nModel : ", model, sep = ""))
if(model == "fGARCH"){
cat(paste("\nSubModel : ", submodel, sep = ""))
}
cat(paste("\nn.ahead : ", object@model$n.ahead, sep = ""))
cat(paste("\nBootstrap method: ",object@model$type))
forc = object@forc@forecast$forecasts[[1]]
zs = rbind(as.data.frame(object, which = "sigma", type = "summary"), forc[,"sigma"])
zr = rbind(as.data.frame(object, which = "series", type = "summary"), forc[,"series"])
rownames(zr)[6] = rownames(zs)[6] = "forecast"
hh = min(object@model$n.ahead, 10)
cat("\n\nSeries (summary):\n")
print(head(round(t(zr), 6), hh), digits = 5)
cat(".....................\n")
cat("\nSigma (summary):\n")
print(head(round(t(zs), 6),hh), digits = 5)
cat(".....................")
cat("\n\n")
})
#-------------------------------------------------------------------------
# multi-methods
setMethod("show",
signature(object = "uGARCHmultispec"),
function(object){
cat(paste("\n*-----------------------------*", sep = ""))
cat(paste("\n* GARCH Multi-Spec *", sep = ""))
cat(paste("\n*-----------------------------*", sep = ""))
N = length(object@spec)
cat(paste("\nMultiple Specifications\t: ", N, sep=""))
cat(paste("\nMulti-Spec Type\t\t\t: ", object@type, sep=""))
cat("\n")
invisible(object)
})
setMethod("show",
signature(object = "uGARCHmultifit"),
function(object){
cat(paste("\n*----------------------------*", sep = ""))
cat(paste("\n* GARCH Multi-Fit *", sep = ""))
cat(paste("\n*----------------------------*", sep = ""))
cat(paste("\nNo. Assets :", length(object@fit), sep=""))
asset.names = object@model$asset.names
if(object@model$type == "equal"){
model = strsplit(class(object@fit[[1]]),"fit")
cat(paste("\nGARCH Multi-Spec Type : Equal",sep=""))
cat(paste("\nGARCH Model Spec",sep=""))
cat(paste("\n--------------------------",sep=""))
cat(paste("\nModel : ", model,sep=""))
if(object@fit[[1]]@model$model=="fGARCH" | object@fit[[1]]@model$model == "fiGARCH"){
cat(paste(" Sub-Model : ", object@fit[[1]]@model$submodel, "\n", sep = ""))
}
if(object@fit[[1]]@model$include.vex){
cat("\nExogenous Regressors in variance equation: ", object@model$vxn, "\n")
} else{
cat("\nExogenous Regressors in variance equation: none\n")
}
cat("\nMean Equation :")
cat("\nInclude Mean : ", object@fit[[1]]@model$include.mean)
cat(paste("\nAR(FI)MA Model : (",object@fit[[1]]@model$armaOrder[1],",",
as.integer(object@fit[[1]]@model$arfima),
",",object@fit[[1]]@model$armaOrder[2],")",sep=""))
cat("\nGarch-in-Mean : ", as.logical(object@fit[[1]]@model$garchInMean))
if(object@fit[[1]]@model$include.mex){
cat("\nExogenous Regressors in mean equation: ",object@fit[[1]]@model$mxn)
} else{
cat("\nExogenous Regressors in mean equation: none")
}
cat("\nConditional Distribution: ",object@fit[[1]]@model$distribution,"\n")
cv = sapply(object@fit, FUN = function(x) x@fit$convergence)
if(any(cv != 0)){
ncv = which(cv != 0)
nncv = length(ncv)
cat("\nNo. of non converged fits: ", ncv,"\n")
if(ncv>0) cat("\nNon converged fits: ", nncv,"\n")
} else{
cat(paste("\nGARCH Model Fit", sep = ""))
cat(paste("\n--------------------------", sep = ""))
cat("\nOptimal Parameters:\n")
ll = t(likelihood(object))
rownames(ll) = "Log-Lik"
cf = coef(object)
colnames(cf) = asset.names
print(round(rbind(cf, ll), digits = 5))
cat("\n")
}
} else{
cat(paste("\nGARCH Model Fit", sep = ""))
cat(paste("\n--------------------------", sep = ""))
cat("\nOptimal Parameters:\n")
print(coef(object), digits = 5)
}
invisible(object)
})
setMethod("show",
signature(object = "uGARCHmultifilter"),
function(object){
asset.names = object@model$asset.names
cat(paste("\n*-------------------------------*", sep = ""))
cat(paste("\n* GARCH Multi-Filter *", sep = ""))
cat(paste("\n*-------------------------------*", sep = ""))
cat(paste("\nNo. Assets :", length(object@filter), sep=""))
if(object@model$type == "equal"){
cat(paste("\nGARCH Model Filter", sep = ""))
cat(paste("\n--------------------------", sep = ""))
cat("\nParameters:\n")
cf = coef(object)
colnames(cf) = asset.names
print(round(cf, digits = 5))
} else{
cat(paste("\nGARCH Model Filter", sep = ""))
cat(paste("\n--------------------------", sep = ""))
cat("\nOptimal Parameters:\n")
print(coef(object), digits = 5)
}
invisible(object)
})
setMethod("show",
signature(object = "uGARCHmultiforecast"),
function(object){
asset.names = object@model$asset.names
cat(paste("\n*---------------------------------*", sep = ""))
cat(paste("\n* GARCH Multi-Forecast *", sep = ""))
cat(paste("\n*---------------------------------*", sep = ""))
cat(paste("\nNo. Assets :", length(object@forecast), sep=""))
cat(paste("\n--------------------------\n",sep=""))
fc = as.array(object)
print(fc, digits = 5)
invisible(object)
})
#----------------------------------------------------------------------------------
# report method
#----------------------------------------------------------------------------------
report = function(object, ...)
{
UseMethod("report")
}
setMethod("report", signature(object = "uGARCHroll"), .ugarchrollreport)
#----------------------------------------------------------------------------------
# univariate fit extractors
#----------------------------------------------------------------------------------
# coef methods
.ugarchfitcoef = function(object)
{
object@fit$coef
}
setMethod("coef", signature(object = "uGARCHfit"), .ugarchfitcoef)
.ugarchfiltercoef = function(object)
{
object@filter$pars
}
setMethod("coef", signature(object = "uGARCHfilter"), .ugarchfiltercoef)
# multi-fit and multi-filter coefficients:
.ugarchmultifitcoef = function(object)
{
if(object@model$type == "equal"){
ans = sapply(object@fit, FUN = function(x) coef(x), simplify = TRUE)
} else{
ans = lapply(object@fit, FUN = function(x) coef(x))
}
return(ans)
}
setMethod("coef", signature(object = "uGARCHmultifit"), .ugarchmultifitcoef)
.ugarchmultifiltercoef = function(object)
{
ans = sapply(object@filter, FUN = function(x) coef(x), simplify = TRUE)
return(ans)
}
setMethod("coef", signature(object = "uGARCHmultifilter"), .ugarchmultifiltercoef)
#----------------------------------------------------------------------------------
# as.data.frame method for fitted object
.ugarchfitdf = function(x, row.names = NULL, optional = FALSE, ...)
{
fit = x@fit
ans = data.frame(data = fit$data, fitted = fit$fitted.values,
residuals = fit$residuals, sigma = fit$sigma)
rownames(ans) = as.character(fit$dates)
ans
}
setMethod("as.data.frame", signature(x = "uGARCHfit"), .ugarchfitdf)
#----------------------------------------------------------------------------------
# as.data.frame method for filter object
.ugarchfilterdf = function(x, row.names = NULL, optional = FALSE, ...)
{
flt = x@filter
ans = data.frame(data = flt$data, fitted = flt$data - flt$residuals,
residuals = flt$residuals, sigma = flt$sigma)
rownames(ans) = as.character(flt$dates)
ans
}
setMethod("as.data.frame", signature(x = "uGARCHfilter"), .ugarchfilterdf)
#----------------------------------------------------------------------------------
# as.data.frame method for forecast object
.ugarchfordfall = function(x, which = "sigma", aligned = TRUE, prepad = TRUE, type = 0)
{
if(aligned){
ans = .ugarchfordf1(x = x, which = which, prepad = prepad)
} else{
ans = .ugarchfordf2(x = x, which = which, type = type)
}
return(ans)
}
.ugarchfordf1 = function(x, which = "sigma", prepad = TRUE)
{
# return full frame with columns the rolls and rows the unique dates
# padded with NA for forecasts beyond n.ahead and actual filtered values
# for values before n.roll
forc = x@forecast
n.start = forc$n.start
N = x@forecast$N - n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
tp = ifelse(which == "sigma", 1, 2)
fdates = sort(unique(as.vector(sapply(forc$forecast, FUN=function(x) rownames(x)))))
tmp = matrix(NA, ncol = n.roll+1, nrow = length(fdates))
tmp[1:n.ahead, 1] = forc$forecast[[1]][,tp]
if( n.roll > 0 ){
for(i in 1:(n.roll)){
if(which == "sigma"){
if(prepad) {
tmp[1:i, i+1] = x@filter$sigma[(N):(N+i-1)]
}
} else {
if(prepad) {
tmp[1:i, i+1] = x@filter$data[(N):(N+i-1)]
}
}
tmp[(i+1):(i+n.ahead), i+1] = forc$forecast[[i+1]][,tp]
}
}
tmp = as.data.frame(tmp)
rownames(tmp) = fdates
colnames(tmp) = paste("roll-", seq(0, n.roll,by = 1), sep="")
tmp
}
# retval: 0 is the standard, returns all values
# retval: 1 returns only those values which have in sample equivalent data (for testing purposes)
# retval: 2 returns only those values which are truly forecasts without in sample data
.ugarchfordf2 = function(x, which = "sigma", type = 0, ...)
{
n.ahead = x@forecast$n.ahead
# n.start == out.sample
n.start = x@forecast$n.start
n.roll = x@forecast$n.roll
tlength = n.ahead + n.roll
mat = matrix(NA, ncol = n.roll + 1, nrow = n.ahead)
mat = sapply(x@forecast$forecast, FUN = function(x) x[, which])
if(is.vector(mat)) mat = matrix(mat, ncol = n.roll+1)
colnames(mat) = paste("roll-", seq(0, n.roll, by = 1), sep = "")
rownames(mat) = paste("t+", 1:n.ahead, sep = "")
if(n.roll==0 | type==0) return(as.data.frame(mat))
indices = apply(.embed(1:tlength, n.ahead, by = 1), 1, FUN = function(x) rev(x))
exc = which(indices>n.start)
if(type == 1){
if(length(exc)>0) mat[exc] = NA
} else{
if(length(exc)>0) mat[-exc] = NA
}
return(as.data.frame(mat))
}
# pad applies to when rollframe = "all", whether to pre-pad forecast with actual values else NA's
# post forecast values are always NA's (this relates to the out.sample option and n.roll)
.ugarchfordf = function(x, row.names = NULL, optional = FALSE, rollframe = 0,
aligned = TRUE, which = "sigma", prepad = TRUE, type = 0)
{
forc = x@forecast
n.start = forc$n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
if(!any(type==(0:2)))
stop("invalid argument for type in as.data.frame", call. = FALSE)
#if(rollframe == "all" && n.roll<=0) rollframe = 0
if(rollframe == "all") return(.ugarchfordfall(x, which, aligned, prepad, type))
# allow type to be used here as well
rollframe = as.integer(rollframe)
if(rollframe>n.roll | rollframe<0) stop("rollframe out of bounds", call. = FALSE)
indx = (rollframe+1):(rollframe+n.ahead)
exc = which(indx>n.start)
ans = forc$forecast[[rollframe+1]]
if(type == 1){
if(length(exc)>0) ans[exc,] = NA
}
if(type == 2){
if(length(exc)>0) ans[-exc,] = NA
}
return(ans)
}
setMethod("as.data.frame", signature(x = "uGARCHforecast"), .ugarchfordf)
# as.array method for forecast object
.ugarchforar = function(x, ...)
{
forc = x@forecast
n.start = forc$n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
forar = array(NA, dim = c(n.ahead, 2, n.roll+1))
for(i in 1:(n.roll+1)){
forar[,,i] = as.matrix(forc$forecast[[i]])
}
return(forar)
}
setMethod("as.array", signature(x = "uGARCHforecast"), .ugarchforar)
# as.list method for forecast object
.ugarchforlist = function(x, ...)
{
x@forecast$forecast
}
setMethod("as.list", signature(x = "uGARCHforecast"), .ugarchforlist)
# as.list method for forecast object
.ugarchmultiforlist = function(x, ...)
{
ans = lapply(x@forecast, FUN = function(x) x@forecast$forecast)
names(ans) = x@model$asset.names
ans
}
setMethod("as.list", signature(x = "uGARCHmultiforecast"), .ugarchmultiforlist)
.ugarchmultiforarray = function(x, which = "sigma", ...)
{
n = length(x@forecast)
ns = x@forecast[[1]]@forecast$n.roll
nah = x@forecast[[1]]@forecast$n.ahead
forar = array(NA, dim = c(nah, n, ns+1))
asset.names = x@model$asset.names
rnames = paste("n.ahead-", 1:nah, sep = "")
dnames = paste("n.roll-", 0:ns, sep = "")
dimnames(forar) = list(rnames, asset.names, dnames)
for(i in 1:(ns+1)) forar[,,i] = sapply(x@forecast, FUN = function(x) x@forecast$forecasts[[i]][,which])
return(forar)
}
setMethod("as.array", signature(x = "uGARCHmultiforecast"), .ugarchmultiforarray)
#----------------------------------------------------------------------------------
# as data.frame for fpm object
.ugarchfpmdf = function(x, row.names = NULL, optional = FALSE, which = "series", type = "meanloss", rollframe = 0, ...)
{
if(type == "meanloss"){
if(which == "series"){
ans = as.data.frame(x@seriesfpm$meanloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$series) else colnames(ans) ="roll_t+1"
} else{
ans = as.data.frame(x@sigmafpm$meanloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$sigma) else colnames(ans) = "roll_t+1"
}
}
if(type == "medianloss"){
if(which == "series"){
ans = as.data.frame(x@seriesfpm$medianloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$series) else colnames(ans) ="roll_t+1"
} else{
ans = as.data.frame(x@sigmafpm$medianloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$sigma) else colnames(ans) ="roll_t+1"
}
}
if(type == "loss")
{
if(which == "series"){
ans = as.data.frame(x@seriesfpm$lossfn[[rollframe+1]])
} else{
ans = as.data.frame(x@sigmafpm$lossfn[[rollframe+1]])
}
}
return(ans)
}
setMethod("as.data.frame", signature(x = "uGARCHfpm"), .ugarchfpmdf)
#----------------------------------------------------------------------------------
# as.data.frame method for distribution object
.ugarchdistdf = function(x, row.names = NULL, optional = FALSE, which = "coef", window = 1, ...)
{
n = x@dist$details$nwindows
if(window > n) stop("window size greater than actual available", call. = FALSE)
if(which == "rmse"){
ans = as.data.frame(t(x@dist[[window]]$rmse))
colnames(ans) = rownames(x@truecoef)
}
if(which == "stats"){
llh = x@dist[[window]]$likelist
persist = x@dist[[window]]$persist
uncvar = x@dist[[window]]$vlongrun
uncmean = x@dist[[window]]$mlongrun
maxret = x@dist[[window]]$simmaxdata[,1]
minret = x@dist[[window]]$simmindata[,1]
meanret = x@dist[[window]]$simmeandata[,1]
kurtosis = x@dist[[window]]$simmomdata[,1]
skewness = x@dist[[window]]$simmomdata[,2]
maxsigma = x@dist[[window]]$simmaxdata[,3]
minsigma = x@dist[[window]]$simmindata[,3]
meansigma = x@dist[[window]]$simmeandata[,3]
ans = data.frame(llh = llh, persist = persist, uncvar = uncvar, uncmean = uncmean,
maxret = maxret, minret = minret, meanret = meanret, kurtosis = kurtosis,
skewness = skewness, maxsigma = maxsigma, minsigma = minsigma, meansigma = meansigma)
}
if(which == "coef"){
cf = x@dist[[window]]$simcoef
ans = data.frame(coef = cf)
colnames(ans) = rownames(x@truecoef)
}
if(which == "coefse"){
cfe = x@dist[[window]]$simcoefse
ans = data.frame(coefse = cfe)
colnames(ans) = rownames(x@truecoef)
}
ans
}
setMethod("as.data.frame", signature(x = "uGARCHdistribution"), .ugarchdistdf)
#----------------------------------------------------------------------------------
# as.data.frame method for simulation object
.ugarchsimdf = function(x, row.names = NULL, optional = FALSE, which = "sigma")
{
# simframe: sigma, series, residuals
#sigmaSim=sigmaSim, seriesSim=seriesSim, residSim=residSim
sim = x@simulation
dates = x@model$dates
sigma = sim$sigmaSim
m = dim(sigma)[2]
N = dim(sigma)[1]
fwdd = .generatefwd(dates, N = N, dformat = "%Y-%m-%d", periodicity = "days")
if(which == "sigma"){
ans = data.frame(sigmasim = sigma)
}
if(which == "series"){
series = sim$seriesSim
ans = data.frame(seriessim = series)
}
if(which == "residuals"){
resids = sim$residSim
ans = data.frame(residsim = resids)
}
rownames(ans) = as.character(fwdd)
ans
}
setMethod("as.data.frame", signature(x = "uGARCHsim"), .ugarchsimdf)
#----------------------------------------------------------------------------------
# as.data.frame method for path simulation object
.ugarchpathdf = function(x, row.names = NULL, optional = FALSE, which = "sigma")
{
# simframe: sigma, series, residuals
#sigmaSim=sigmaSim, seriesSim=seriesSim, residSim=residSim
sim = x@path
sigma = sim$sigmaSim
m = dim(sigma)[2]
N = dim(sigma)[1]
if(which == "sigma"){
ans = data.frame(sigmasim = sigma)
}
if(which == "series"){
series = sim$seriesSim
ans = data.frame(seriessim = series)
}
if(which == "residuals"){
resids = sim$residSim
ans = data.frame(residsim = resids)
}
ans
}
setMethod("as.data.frame", signature(x = "uGARCHpath"), .ugarchpathdf)
#----------------------------------------------------------------------------------
# as.data.frame method for bootstrap object
.ugarchbootdf = function(x, row.names = NULL, optional = FALSE, which = "sigma", type = "raw", qtile = c(0.01, 0.099))
{
n.ahead = x@model$n.ahead
if(which == "sigma")
{
if(type == "raw"){
sigma = x@fsigma
ans = data.frame(bootsigma = sigma)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
}
if(type == "q"){
if(all(is.numeric(qtile)) && (all(qtile<1.0) && all(qtile >0.0))){
sigma = x@fsigma
ans = apply(sigma, 2, FUN = function(x) quantile(x, qtile))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = paste("q", qtile, sep = "")
} else{
stop("\nfor type q, the qtile value must be numeric and between (>)0 and 1(<)\n", call. = FALSE)
}
}
if(type == "summary"){
sigma = x@fsigma
ans = apply(sigma, 2, FUN = function(x) c(min(x), quantile(x, 0.25), mean(x), quantile(x, 0.75), max(x) ))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = c("min", "q0.25", "mean", "q0.75", "max")
}
}
if(which == "series")
{
if(type == "raw"){
series = x@fseries
ans = data.frame(bootseries = series)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
}
if(type == "q"){
if(all(is.numeric(qtile)) && (all(qtile<1.0) && all(qtile >0.0))){
series = x@fseries
ans = apply(series, 2, FUN = function(x) quantile(x, qtile))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = paste("q", qtile, sep = "")
} else{
stop("\nfor type q, the qtile value must be numeric and between (>)0 and 1(<)\n", call. = FALSE)
}
}
if(type == "summary"){
series = x@fseries
ans = apply(series, 2, FUN = function(x) c(min(x), quantile(x, 0.25), mean(x), quantile(x, 0.75), max(x) ))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = c("min", "q.25", "mean", "q.75", "max")
}
}
ans
}
setMethod("as.data.frame", signature(x = "uGARCHboot"), .ugarchbootdf)
#----------------------------------------------------------------------------------
# as.data.frame method for roll object
# valid which = density, fpm, coefs
.ugarchrolldf = function(x, row.names = NULL, optional = FALSE, which = "density", n.ahead = 1, refit = 1)
{
n = x@roll$n.ahead
if(n.ahead>n)
stop("n.ahead chosen exceeds roll object specification", call. = FALSE)
if(which == "coefs"){
ans = as.data.frame(x@roll$coefs)
rownames(ans) = paste("refit-", 1:dim(ans)[1], sep = "")
}
if(which == "density"){
ans = as.data.frame(x@roll$fdensity[[n.ahead]])
rownames(ans) = paste("roll-", 1:dim(ans)[1], sep = "")
}
if(which == "coefmat"){
ans = as.data.frame(x@roll$coefmat[[refit]])
}
if(which == "LLH"){
ans = as.data.frame(x@roll$LLH)
rownames(ans) = paste("refit-", 1:dim(ans)[1], sep = "")
colnames(ans) = "LLH"
}
if(which == "VaR"){
ans = as.data.frame(x@roll$VaR.out[[n.ahead]])
}
return(ans)
}
setMethod("as.data.frame", signature(x = "uGARCHroll"), .ugarchrolldf)
as.uGARCHforecast = function(object, ...)
{
setMethod("as.uGARCHforecast")
}
.roll2forc = function(object, refit = 1)
{
n = object@roll$n.refit
if(refit>n)
stop("refit chosen exceeds roll object specification", call. = FALSE)
object@forecast[[refit]]
}
setMethod("as.uGARCHforecast", signature(object = "uGARCHroll"), .roll2forc)
#----------------------------------------------------------------------------------
# residuals method
.ugarchfitresids = function(object)
{
object@fit$residuals
}
setMethod("residuals", signature(object = "uGARCHfit"), .ugarchfitresids)
.ugarchfilterresids = function(object)
{
object@filter$residuals
}
setMethod("residuals", signature(object = "uGARCHfilter"), .ugarchfilterresids)
.ugarchmultifitresids = function(object)
{
sapply(object@fit, FUN = function(x) residuals(x), simplify = TRUE)
}
setMethod("residuals", signature(object = "uGARCHmultifit"), .ugarchmultifitresids)
.ugarchmultifilterresids = function(object)
{
sapply(object@filter, FUN = function(x) residuals(x), simplify = TRUE)
}
setMethod("residuals", signature(object = "uGARCHmultifilter"), .ugarchmultifilterresids)
#----------------------------------------------------------------------------------
# sigma method
sigma = function(object, ...)
{
UseMethod("sigma")
}
.ugarchfitsigma = function(object)
{
object@fit$sigma
}
setMethod("sigma", signature(object = "uGARCHfit"), .ugarchfitsigma)
.ugarchfiltersigma = function(object)
{
object@filter$sigma
}
setMethod("sigma", signature(object = "uGARCHfilter"), .ugarchfiltersigma)
.ugarchmultifitsigma = function(object)
{
sapply(object@fit, FUN = function(x) sigma(x), simplify = TRUE)
}
setMethod("sigma", signature(object = "uGARCHmultifit"), .ugarchmultifitsigma)
.ugarchmultifiltersigma = function(object)
{
sapply(object@filter, FUN = function(x) sigma(x), simplify = TRUE)
}
setMethod("sigma", signature(object = "uGARCHmultifilter"), .ugarchmultifiltersigma)
#----------------------------------------------------------------------------------
# nyblom method
nyblom = function(object)
{
UseMethod("nyblom")
}
setMethod("nyblom", signature(object = "uGARCHfit"), .nyblomTest)
#----------------------------------------------------------------------------------
# signbias method
signbias = function(object)
{
UseMethod("signbias")
}
setMethod("signbias", signature(object = "uGARCHfit"), .signbiasTest)
setMethod("signbias", signature(object = "uGARCHfilter"), .signbiasTest)
#----------------------------------------------------------------------------------
# goodness of fit method
gof = function(object,groups)
{
UseMethod("gof")
}
setMethod("gof", signature(object = "uGARCHfit", groups = "numeric"), .gofTest)
setMethod("gof", signature(object = "uGARCHfilter", groups = "numeric"), .gofTest)
#----------------------------------------------------------------------------------
# Info Criteria method
infocriteria = function(object)
{
UseMethod("infocriteria")
}
.ugarchinfocriteria = function(object)
{
itest = .information.test(likelihood(object), nObs = length(fitted(object)),
nPars = length(coef(object)))
itestm = matrix(0, ncol = 1, nrow = 4)
itestm[1,1] = itest$AIC
itestm[2,1] = itest$BIC
itestm[3,1] = itest$SIC
itestm[4,1] = itest$HQIC
colnames(itestm) = ""
rownames(itestm) = c("Akaike", "Bayes", "Shibata", "Hannan-Quinn")
return(itestm)
}
setMethod("infocriteria", signature(object = "uGARCHfit"), .ugarchinfocriteria)
setMethod("infocriteria", signature(object = "uGARCHfilter"), .ugarchinfocriteria)
#----------------------------------------------------------------------------------
# Likelihood method
likelihood = function(object)
{
UseMethod("likelihood")
}
.ugarchfitLikelihood = function(object)
{
return(object@fit$LLH)
}
setMethod("likelihood", signature(object = "uGARCHfit"), .ugarchfitLikelihood)
.ugarchfilterLikelihood = function(object)
{
return(object@filter$LLH)
}
setMethod("likelihood", signature(object = "uGARCHfilter"), .ugarchfilterLikelihood)
.ugarchmultifilterLikelihood = function(object)
{
sapply(object@filter, FUN = function(x) likelihood(x), simplify = TRUE)
}
setMethod("likelihood", signature(object = "uGARCHmultifilter"), .ugarchmultifilterLikelihood)
.ugarchmultifitLikelihood = function(object)
{
sapply(object@fit, FUN = function(x) likelihood(x), simplify = TRUE)
}
setMethod("likelihood", signature(object = "uGARCHmultifit"), .ugarchmultifitLikelihood)
#----------------------------------------------------------------------------------
# Fitted method
.ugarchfitted = function(object)
{
return(object@fit$fitted.values)
}
setMethod("fitted", signature(object = "uGARCHfit"), .ugarchfitted)
.ugarchfiltered = function(object)
{
return(object@filter$data - object@filter$residuals)
}
setMethod("fitted", signature(object = "uGARCHfilter"), .ugarchfiltered)
.ugarchmultifiltered = function(object)
{
sapply(object@filter, FUN = function(x) x@filter$data - residuals(x), simplify = TRUE)
}
setMethod("fitted", signature(object = "uGARCHmultifilter"), .ugarchmultifiltered)
.ugarchmultifitted = function(object)
{
sapply(object@fit, FUN = function(x) x@fit$data - residuals(x), simplify = TRUE)
}
setMethod("fitted", signature(object = "uGARCHmultifit"), .ugarchmultifitted)
#----------------------------------------------------------------------------------
# newsimpact curve method (not multiplied by unconditional sigma)
newsimpact = function(object, z = seq(-0.3, 0.3, length.out = 100))
{
UseMethod("newsimpact")
}
.newsimpact = function(object, z = seq(-0.3, 0.3, length.out = 100))
{
model = object@model$model
ans = switch(model,
sGARCH = .sgarchni(z, object),
fGARCH = .fgarchni(z, object),
gjrGARCH = .gjrgarchni(z, object),
eGARCH = .egarchni(z, object),
apARCH = .aparchni(z, object),
iGARCH = .sgarchni(z, object))
#anstGARCH = .anstgarchni(z, object))
return(ans)
}
setMethod("newsimpact", signature(object = "uGARCHfit"), .newsimpact)
setMethod("newsimpact", signature(object = "uGARCHfilter"), .newsimpact)
# the underlying news impact methods
.sgarchni = function(z, fit)
{
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
cf = coef(fit)
garchOrder = fit@model$garchOrder
omega = cf["omega"]
if(garchOrder[1]) alpha = cf["alpha1"] else alpha = 0
if(garchOrder[2]) beta = cf["beta1"] else beta = 0
lrvar = rep(uncvariance(fit), length(zz))
ans = omega + beta*lrvar + alpha*zz^2
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = as.numeric(ans), zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.fgarchni = function(z, fit)
{
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
Names = names(coef(fit))
model.pars = .fgarchModel(fit@model$submodel)$parameters
garchOrder = fit@model$garchOrder
cf = coef(fit)
omega = cf["omega"]
if(any(substr(Names, 1, 5) == "alpha")){
i = which(substr(Names, 1, 5) == "alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 4) == "beta")){
i = which(substr(Names, 1, 4) == "beta")
beta = cf[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 6) == "lambda")){
i = which(substr(Names, 1, 6) == "lambda")
lambda = cf[i]
} else{
lambda = model.pars$lambda
}
# delta
if(any(substr(Names, 1, 5) == "delta")){
i = which(substr(Names, 1, 5) == "delta")
delta = cf[i]
} else{
delta = model.pars$delta
}
# gamma1
if(any(substr(Names, 1, 6) == "gamma1")){
i = which(substr(Names, 1, 6) == "gamma1")
gamma1 = cf[i]
} else{
if(garchOrder[1]>0) gamma1 = rep(model.pars$gamma1,garchOrder[1]) else gamma1 = 0
}
# fc
if(any(substr(Names, 1, 6) == "gamma2")){
i = which(substr(Names, 1, 6) == "gamma2")
gamma2 = cf[i]
} else{
if(garchOrder[1]>0) gamma2 = rep(model.pars$gamma2, garchOrder[1]) else gamma2 = 0
}
fk = model.pars$fk
kdelta = delta + fk*lambda
lrvar = rep(uncvariance(fit)^(1/2), length(zz))
ans = omega + alpha[1]*(lrvar^lambda)*(abs(zz/lrvar - gamma2[1]) - gamma1[1]*(zz/lrvar - gamma2[1]))^kdelta + beta[1]*(lrvar^lambda)
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans^(2/lambda), zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.egarchni = function(z, fit)
{
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
Names = names(coef(fit))
# gamma
cf = coef(fit)
omega = cf["omega"]
if(any(substr(Names, 1, 5) == "alpha")){
i = which(substr(Names, 1, 5) == "alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 4) == "beta")){
i = which(substr(Names, 1, 4) == "beta")
beta = cf[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gm = cf[i]
} else{
gm = 0
}
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = cf[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = cf[i]
} else{
shape = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = cf[i]
} else{
skew = 0
}
k = egarchKappa(dlambda, shape, skew, fit@model$distribution)
lrvar = rep(uncvariance(fit), length(zz))
sqlr = sqrt(lrvar)
ans=exp(omega + alpha[1]*zz/sqlr + gm[1]*(abs(zz/sqlr)-k) + beta[1]*log(lrvar))
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans, zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.gjrgarchni = function(z, fit)
{
Names = names(coef(fit))
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
cf = coef(fit)
omega = cf["omega"]
if(any(substr(Names, 1, 5) == "alpha")){
i = which(substr(Names, 1, 5) == "alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 4) == "beta")){
i = which(substr(Names, 1, 4) == "beta")
beta = cf[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gm = cf[i]
} else{
gm = 0
}
lrvar = rep(uncvariance(fit), length(zz))
ans = omega + alpha[1]*zz^2 + gm[1]*(zz^2)*(zz<0) + beta[1]*lrvar
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans, zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.aparchni = function(z, fit)
{
Names = names(coef(fit))
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
cf = coef(fit)
omega = cf["omega"]
if(any(substr(Names, 1, 5) == "alpha")){
i = which(substr(Names, 1, 5) == "alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 4) == "beta")){
i = which(substr(Names, 1, 4) == "beta")
beta = cf[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gm = coef(fit)[i]
} else{
gm=0
}
if(any(substr(Names, 1, 5)=="delta")){
i = which(substr(Names, 1, 5)=="delta")
delta = coef(fit)[i]
} else{
delta = 0
}
lrvar = rep(uncvariance(fit)^(1/2), length(zz))
ans = omega + alpha[1]*(abs(zz) - gm[1]*(zz))^delta + beta[1]*(lrvar^delta)
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans^(2/delta), zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.anstgarchni = function(z, fit)
{
Names = names(coef(fit))
if(is.null(z)){
minz = min(fit@fit$residuals)
zz = seq(minz, abs(minz), length.out = 100)
} else{
zz = z
}
distribution = fit@model$distribution
cf = coef(fit)
omega1 = cf["omega1"]
omega2 = cf["omega2"]
if(any(substr(Names, 1, 6) == "alpha1")){
i = which(substr(Names, 1, 6) == "alpha1")
alpha1 = cf[i]
} else{
alpha1 = 0
}
if(any(substr(Names, 1, 6) == "alpha2")){
i = which(substr(Names, 1, 6) == "alpha2")
alpha2 = cf[i]
} else{
alpha2 = 0
}
if(any(substr(Names, 1, 5) == "beta1")){
i = which(substr(Names, 1, 5) == "beta1")
beta1 = cf[i]
} else{
beta1 = 0
}
if(any(substr(Names, 1, 5) == "beta2")){
i = which(substr(Names, 1, 5) == "beta2")
beta2 = cf[i]
} else{
beta2 = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gm = cf[i]
} else{
gm = 0
}
lrvar = rep(uncvariance(fit), length(zz))
kappa = 1/( 1 + exp( -gm * zz ) )
ans = (1-kappa) * (omega1 + alpha1*zz^2 + beta1*lrvar) + kappa * (omega2 + alpha2*zz^2 + beta2*lrvar)
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans, zx = zz, yexpr = yexpr, xexpr = xexpr))
}
#----------------------------------------------------------------------------------
# Half-Life Method for the various garch models
# ln(0.5)/log(persistence)
halflife = function(object, pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
UseMethod("halflife")
}
.halflife1<-function(object)
{
ps = persistence(object)
hlf = log(0.5)/log(ps)
names(hlf) = "Half-Life"
return(hlf)
}
.halflife2 = function(pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
ps = persistence(pars = pars, distribution = distribution, model = model, submodel = submodel)
hlf = log(0.5)/log(ps)
names(hlf) = "Half-Life"
return(hlf)
}
setMethod("halflife",signature(object = "uGARCHfilter", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .halflife1)
setMethod("halflife",signature(object = "uGARCHfit", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .halflife1)
setMethod("halflife",signature(object = "missing", pars = "numeric",
distribution = "character", model = "character", submodel = "ANY"),
definition = .halflife2)
#----------------------------------------------------------------------------------
# Persistence
persistence = function(object, pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
UseMethod("persistence")
}
# filter method
.filterpersistence = function(object)
{
object@filter$persistence
}
setMethod("persistence", signature(object = "uGARCHfilter", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .filterpersistence)
# fit method
.persistence1 = function(object)
{
pars = coef(object)
distribution = object@model$distribution
model = object@model$model
submodel = object@model$submodel
ans = switch(model,
sGARCH = .persistsgarch(pars,distribution),
eGARCH = .persistegarch(pars,distribution),
gjrGARCH = .persistgjrgarch(pars,distribution),
apARCH = .persistaparch(pars,distribution),
fGARCH = .persistfgarch(pars,distribution,submodel),
iGARCH = 1)
#anstGARCH = .persistanstgarch(pars, distribution))
names(ans) = "persistence"
return(ans)
}
.persistence2 = function(pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
ans = switch(model,
sGARCH = .persistsgarch(pars,distribution),
eGARCH = .persistegarch(pars,distribution),
gjrGARCH = .persistgjrgarch(pars,distribution),
apARCH = .persistaparch(pars,distribution),
fGARCH = .persistfgarch(pars,distribution,submodel),
iGARCH = 1)
#anstGARCH = .persistanstgarch(pars, distribution))
names(ans) = "persistence"
return(ans)
}
setMethod("persistence",signature(object = "uGARCHfit", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .persistence1)
setMethod("persistence",signature(object = "missing", pars = "numeric",
distribution = "character", model = "character", submodel = "ANY"),
definition = .persistence2)
.persistsgarch = function(pars, distribution = "norm"){
Names = names(pars)
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha=pars[i]
} else{
alpha=0
}
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega = pars[i]
} else{
omega = 0
}
if(any(substr(Names, 1, 4)=="beta")){
i = which(substr(Names, 1, 4)=="beta")
beta = pars[i]
} else{
beta = 0
}
ps = sum(alpha) + sum(beta)
return(ps)
}
.persistgjrgarch = function(pars, distribution = "norm"){
Names = names(pars)
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha = pars[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gamma = pars[i]
} else{
gamma = 0
}
if(any(substr(Names, 1, 5)=="omega")){
i = which(substr(Names, 1, 5)=="omega")
omega = pars[i]
} else{
omega = 0
}
if(any(substr(Names, 1, 4)=="beta")){
i = which(substr(Names, 1, 4)=="beta")
beta = pars[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = pars[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = pars[i]
} else{
skew = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = pars[i]
} else{
shape = 0
}
ps = sum(beta)+ sum(alpha)+sum(apply(as.data.frame(gamma),1,FUN=function(x)
x*pneg(dlambda, shape, skew, distribution)))
return(ps)
}
.persistegarch = function(pars, distribution = "norm"){
Names=names(pars)
if(any(substr(Names, 1, 4)=="beta")){
i=which(substr(Names, 1, 4)=="beta")
beta=pars[i]
} else{
beta=0
}
ps=sum(beta)
return(ps)
}
.persistaparch = function(pars, distribution = "norm"){
Names = names(pars)
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha = pars[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gamma = pars[i]
} else{
gamma = rep(0, length(alpha))
}
if(any(substr(Names, 1, 5)=="delta")){
i = which(substr(Names, 1, 5)=="delta")
delta = pars[i]
} else{
delta= 2
}
if(any(substr(Names, 1, 4)=="beta")){
i = which(substr(Names, 1, 4)=="beta")
beta = pars[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = pars[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = pars[i]
} else{
skew = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = pars[i]
} else{
shape = 0
}
ps = sum(beta) + sum(apply(cbind(gamma,alpha), 1, FUN=function(x)
x[2]*aparchKappa(x[1], delta, dlambda, shape, skew,distribution)))
return(ps)
}
.persistfgarch = function(pars, distribution = "norm", submodel){
fm = .fgarchModel(submodel)
Names = names(pars)
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha = pars[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 6)=="lambda")){
i = which(substr(Names, 1, 6)=="lambda")
lambda = pars[i]
} else{
lambda = fm$parameters$lambda
}
if(any(substr(Names, 1, 5)=="delta")){
i = which(substr(Names, 1, 5)=="delta")
delta = pars[i]
} else{
delta = fm$parameters$delta
}
if(any(substr(Names, 1, 6)=="gamma1")){
i = which(substr(Names, 1, 6)=="gamma1")
gamma1 = pars[i]
} else{
gamma1 = rep(0, length(alpha))
}
if(any(substr(Names, 1, 6)=="gamma2")){
i = which(substr(Names, 1, 6)=="gamma2")
gamma2 = pars[i]
} else{
gamma2 = rep(0, length(alpha))
}
if(any(substr(Names, 1, 5)=="omega")){
i = which(substr(Names, 1, 5)=="omega")
omega = pars[i]
} else{
omega = 0
}
if(any(substr(Names, 1, 4)=="beta")){
i = which(substr(Names, 1, 4)=="beta")
beta = pars[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = pars[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = pars[i]
} else{
skew = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = pars[i]
} else{
shape = 0
}
fk = fm$parameters$fk
ps = sum(beta) + sum(apply(cbind(alpha, gamma1, gamma2), 1, FUN=function(x)
x[1]*fgarchKappa(lambda, delta, x[2], x[3], fk, dlambda, shape, skew, distribution)))
return(ps)
}
.persistanstgarch = function(pars, distribution = "norm", submodel){
Names = names(pars)
if(any(substr(Names, 1, 6)=="alpha1")){
i = which(substr(Names, 1, 6)=="alpha1")
alpha1 = pars[i]
} else{
alpha1 = 0
}
if(any(substr(Names, 1, 6)=="alpha2")){
i = which(substr(Names, 1, 6)=="alpha2")
alpha2 = pars[i]
} else{
alpha2 = 0
}
if(any(substr(Names, 1, 5)=="beta1")){
i = which(substr(Names, 1, 5)=="beta1")
beta1 = pars[i]
} else{
beta1 = 0
}
if(any(substr(Names, 1, 5)=="beta2")){
i = which(substr(Names, 1, 5)=="beta2")
beta2 = pars[i]
} else{
beta2 = 0
}
ps = 0.5 * (sum(alpha1) + sum(alpha2) + sum(beta1) + sum(beta2))
return(ps)
}
#----------------------------------------------------------------------------------
# Unconditional Variance
uncvariance = function(object, pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
UseMethod("uncvariance")
}
.unconditional1 = function(object)
{
pars = coef(object)
distribution = object@model$distribution
model = object@model$model
submodel = object@model$submodel
ans=switch(model,
sGARCH = .uncsgarch(pars, distribution),
eGARCH = .uncegarch(pars, distribution),
gjrGARCH = .uncgjrgarch(pars, distribution),
apARCH = .uncaparch(pars, distribution),
fGARCH = .uncfgarch(pars, distribution, submodel),
iGARCH = Inf)
#anstGARCH = .uncanstgarch(pars, distribution))
names(ans) = "unconditional"
return(ans)
}
.unconditional2 = function(object)
{
if(is.null(object@optimization.model$fixed.pars))
stop("\nuncvariance with spec required fixed.pars list\n", call. = FALSE)
# no other checks for now.
pars = unlist(object@optimization.model$fixed.pars)
distribution = object@distribution.model$distribution
model = object@variance.model$model
submodel = object@variance.model$submodel
ans = switch(model,
sGARCH = .uncsgarch(pars,distribution),
eGARCH = .uncegarch(pars,distribution),
gjrGARCH = .uncgjrgarch(pars,distribution),
apARCH = .uncaparch(pars,distribution),
fGARCH = .uncfgarch(pars,distribution,submodel),
iGARCH = Inf)
#anstGARCH = .uncanstgarch(pars, distribution))
names(ans) = "unconditional"
return(ans)
}
.unconditional3 = function(pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
ans = switch(model,
sGARCH = .uncsgarch(pars,distribution),
eGARCH = .uncegarch(pars,distribution),
gjrGARCH = .uncgjrgarch(pars,distribution),
apARCH = .uncaparch(pars,distribution),
fGARCH = .uncfgarch(pars,distribution,submodel),
iGARCH = Inf)
#anstGARCH = .uncanstgarch(pars, distribution))
names(ans) = "unconditional"
return(ans)
}
setMethod("uncvariance", signature(object = "uGARCHfit", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .unconditional1)
setMethod("uncvariance", signature(object = "missing", pars = "numeric",
distribution = "character", model = "character", submodel = "ANY"),
definition = .unconditional3)
setMethod("uncvariance", signature(object = "uGARCHspec", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .unconditional2)
setMethod("uncvariance", signature(object = "uGARCHfilter", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .unconditional1)
.uncsgarch = function(pars,distribution="norm"){
Names=names(pars)
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
ps=persistence(pars=pars,distribution=distribution,model="sGARCH")
uvol=omega/(1-ps)
return(uvol)
}
.uncgjrgarch<-function(pars,distribution="norm"){
Names=names(pars)
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
ps=persistence(pars=pars,distribution=distribution,model="gjrGARCH")
uvol=omega/(1-ps)
return(uvol)
}
.uncegarch<-function(pars,distribution="norm"){
Names=names(pars)
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
if(any(substr(Names, 1, 4)=="beta")){
i=which(substr(Names, 1, 4)=="beta")
beta=pars[i]
} else{
beta=0
}
uvol=exp(omega/(1-sum(beta)))
}
.uncaparch<-function(pars,distribution="norm"){
Names=names(pars)
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
if(any(substr(Names, 1, 5)=="delta")){
i=which(substr(Names, 1, 5)=="delta")
delta=pars[i]
} else{
delta=2
}
ps=persistence(pars=pars,distribution=distribution,model="apARCH")
uvol=(omega/(1-ps))^(2/delta)
return(uvol)
}
.uncfgarch<-function(pars, distribution="norm", submodel){
Names=names(pars)
fpars = .fgarchModel(submodel)$parameters
if(any(substr(Names, 1, 6)=="lambda")){
i=which(substr(Names, 1, 6)=="lambda")
lambda=pars[i]
} else{
lambda = fpars$lambda
}
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
ps=persistence(pars = pars, distribution=distribution,model="fGARCH",submodel=submodel)
uvol=(omega/(1-ps))^(2/lambda)
return(uvol)
}
.uncanstgarch = function(pars, distribution = "norm"){
Names = names(pars)
if(any(substr(Names, 1, 6)=="omega1")){
i = which(substr(Names, 1, 6)=="omega1")
omega1 = pars[i]
} else{
omega1 = 0
}
if(any(substr(Names, 1, 6)=="omega2")){
i = which(substr(Names, 1, 6)=="omega2")
omega2 = pars[i]
} else{
omega2 = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = pars[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = pars[i]
} else{
skew = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = pars[i]
} else{
shape = 0
}
kappa = 0.5
ps = persistence( pars = pars, distribution = distribution, model = "anstGARCH")
uvol = (0.5 * omega1 + 0.5 * omega2)/(1 - ps)
return(uvol)
}
# Unconditional Mean
uncmean = function(object)
{
UseMethod("uncmean")
}
.unconditionalmean = function(object)
{
include.mean = object@model$include.mean
garchInMean = object@model$garchInMean
im = object@model$inMeanType
if(is(object, "uGARCHfilter")){
h = object@filter$sigma
data = object@filter$data
} else{
h = object@fit$sigma
data = object@fit$data
}
N = length(h)
arfima = object@model$arfima
include.mex = object@model$include.mex
pars = coef(object)
if(include.mex){
mxn = object@model$mxn
mxreg = coef(object)[paste("mxreg", 1:mxn, sep="")]
if(is(object, "uGARCHfilter")){
mexdata = as.matrix(object@model$mexdata[1:N, 1:mxn])
} else{
mexdata = as.matrix(object@model$mexdata[1:N, 1:mxn])
}
meanmex = apply(mexdata, 2, "mean")
umeanmex = sum(mxreg*meanmex)
} else{
umeanmex = 0
}
if(garchInMean){
if(im == 2) mh = uncvariance(object) else mh = uncvariance(object)^(1/2)
umeangim = mh * pars["inmean"]
} else{
umeangim = 0
}
if(include.mean) mu = coef(object)["mu"] else mu=0
#if(arfima){
# umean = mu + umeangim + umeanmex
#} else{
# armaOrder = object@model$armaOrder
# if(armaOrder[1] == 0) {
# umean = mu + umeangim + umeanmex
# } else{
# ar = sum(coef(object)[paste("ar", 1:armaOrder[1], sep="")])
# umean = (mu + umeangim + umeanmex)/(1 - ar)
# }
#}
umean = (mu + umeangim + umeanmex)
return(umean)
}
.unconditionalmean2 = function(object)
{
if(is.null(object@optimization.model$fixed.pars))
stop("uncmean with uGARCHspec requires fixed.pars list", call. = FALSE)
# should write a routine to do parameter checking subject to model
include.mean = object@mean.model$include.mean
garchInMean = object@mean.model$garchInMean
im = object@mean.model$inMeanType
h = 0
data = 0
arfima = object@mean.model$arfima
include.mex = object@mean.model$include.mex
pars = unlist(object@optimization.model$fixed.pars)
if(include.mex){
mxn = object@mean.model$mxn
mxreg = pars[paste("mxreg", 1:mxn, sep="")]
mexdata = matrix(object@mean.model$mexdata, ncol = mxn)
meanmex = apply(mexdata, 2, "mean")
umeanmex = sum(mxreg*meanmex)
} else{
umeanmex = 0
}
umeangim = 0
if(include.mean) mu = pars["mu"] else mu=0
#if(arfima){
# umean = mu + umeangim + umeanmex
#} else{
# armaOrder = object@model$armaOrder
# if(armaOrder[1] == 0) {
# umean = mu + umeangim + umeanmex
# } else{
# ar = sum(coef(object)[paste("ar", 1:armaOrder[1], sep="")])
# umean = (mu + umeangim + umeanmex)/(1 - ar)
# }
#}
umean = (mu + umeangim + umeanmex)
return(umean)
}
setMethod("uncmean", signature(object = "uGARCHfit"), definition = .unconditionalmean)
setMethod("uncmean", signature(object = "uGARCHfilter"), definition = .unconditionalmean)
setMethod("uncmean", signature(object = "uGARCHspec"), definition = .unconditionalmean2)
#----------------------------------------------------------------------------------
# The mult- methods
#----------------------------------------------------------------------------------
multispec = function( speclist )
{
UseMethod("multispec")
}
setMethod("multispec", signature(speclist = "vector"), definition = .multispecall)
multifit = function(multispec, data, out.sample = 0, solver = "solnp", solver.control = list(), fit.control = list(stationarity = 1,
fixed.se = 0, scale = 0), parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
UseMethod("multifit")
}
setMethod("multifit", signature(multispec = "uGARCHmultispec"), definition = .multifitgarch)
multifilter = function(multifitORspec, data = NULL, out.sample = 0, n.old = NULL,
parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
UseMethod("multifilter")
}
setMethod("multifilter", signature(multifitORspec = "uGARCHmultifit"), definition = .multifiltergarch1)
setMethod("multifilter", signature(multifitORspec = "uGARCHmultispec"), definition = .multifiltergarch2)
multiforecast = function(multifitORspec, data = NULL, n.ahead = 1, n.roll = 0, out.sample = 0,
external.forecasts = list(mregfor = NULL, vregfor = NULL),
parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
UseMethod("multiforecast")
}
setMethod("multiforecast", signature(multifitORspec = "uGARCHmultifit"), definition = .multiforecastgarch1)
setMethod("multiforecast", signature(multifitORspec = "uGARCHmultispec"), definition = .multiforecastgarch2)
#----------------------------------------------------------------------------------
Try the rgarch package in your browser
Any scripts or data that you put into this service are public.
rgarch documentation built on May 2, 2019, 5:22 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#################################################################################
##
## R package rgarch by Alexios Ghalanos Copyright (C) 2008, 2009, 2010, 2011
## This file is part of the R package rgarch.
##
## The R package rgarch is free software: you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation, either version 3 of the License, or
## (at your option) any later version.
##
## The R package rgarch is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
#################################################################################
#----------------------------------------------------------------------------------
# univariate spec method
#----------------------------------------------------------------------------------
ugarchspec = function(variance.model = list(model = "sGARCH", garchOrder = c(1,1),
submodel = NULL, external.regressors = NULL, variance.targeting = FALSE),
mean.model = list(armaOrder = c(1,1), include.mean = TRUE, garchInMean = FALSE,
inMeanType = 1, arfima = FALSE, external.regressors = NULL),
distribution.model = "norm", start.pars = list(), fixed.pars = list(), ...)
{
UseMethod("ugarchspec")
}
.ugarchspec = function(variance.model = list(model = "sGARCH", garchOrder = c(1,1),
submodel = NULL, external.regressors = NULL, variance.targeting = FALSE),
mean.model = list(armaOrder = c(1,1), include.mean = TRUE, garchInMean = FALSE,
inMeanType = 1, arfima = FALSE, external.regressors = NULL),
distribution.model = "norm", start.pars = list(), fixed.pars = list())
{
# some checks and preparation to be passed on to specific models by switch
# distribution model
dmodel = list()
if(is.null(distribution.model)) dmodel$distribution = "norm"
valid.distribution = c("norm", "snorm", "std", "sstd","ged", "sged", "nig", "ghyp", "jsu")
distribution = distribution.model
if(!is.character(distribution[1]))
stop("\nugarchspec-->error: cond.distribution argument must be a character")
if(!any(distribution==valid.distribution))
stop("\nugarchspec-->error: the cond.distribution does not appear to be a valid choice.")
if(length(distribution)!=1) distribution = distribution[1]
dmodel$distribution = distribution
dmodel$distno = which(distribution == valid.distribution)
di = .DistributionBounds(distribution)
dmodel$include.dlambda = di$include.dlambda
dmodel$include.skew = di$include.skew
dmodel$include.shape = di$include.shape
# variance model:
vmodel = list()
valid.model = c("sGARCH", "eGARCH", "gjrGARCH", "tGARCH", "fGARCH", "iGARCH", "apARCH")
if(is.null(variance.model$model)){
vmodel$model = "sGARCH"
} else{
vmodel$model = variance.model$model[1]
if(!is.character(vmodel$model))
stop("\nugarchspec-->error: garch model argument must be a character.\n", call. = FALSE)
if(!any(vmodel$model == valid.model))
stop("\nugarchspec-->error: the garch model does not appear to be a valid choice.\n", call. = FALSE)
if(vmodel$model == "fiGARCH"){
vmodel$submodel = variance.model$submodel
valid.submodel = c("BBM", "Chung")
if(is.null(vmodel$submodel))
stop("\nugarchspec-->error: NULL not allowed for the submodel when model is of type fiGARCH.\n", call. = FALSE)
if(!any(vmodel$submodel==valid.submodel))
stop("\nugarchspec-->error: the fiGARCH submodel does not appear to be a valid choice. Valid choices are BBM and Chung.\n", call. = FALSE)
}
if(vmodel$model == "fGARCH"){
vmodel$submodel = variance.model$submodel
valid.submodel = c("GARCH","TGARCH","AVGARCH","NGARCH","NAGARCH","APARCH","ALLGARCH","GJRGARCH")
if(is.null(vmodel$submodel))
stop("\nugarchspec-->error: NULL not allowed for the submodel when model is of type fGARCH.\n", call. = FALSE)
if(!any(vmodel$submodel == valid.submodel))
stop("\nugarchspec-->error: the fGARCH submodel does not appear to be a valid choice. See documentation for valid choices.\n", call. = FALSE)
}
}
if(is.null(variance.model$garchOrder)){
if(vmodel$model == "anstGARCH"){
vmodel$garchOrder = c(1, 1, 1, 1)
} else{
vmodel$garchOrder = c(1, 1)
}
} else{
if(vmodel$model == "anstGARCH"){
if( length(variance.model$garchOrder) == 2 ) vmodel$garchOrder = c(vmodel$garchOrder[1], vmodel$garchOrder[2], 0, 0) else vmodel$garchOrder = variance.model$garchOrder
} else{
vmodel$garchOrder = variance.model$garchOrder
}
}
vmodel$external.regressors = variance.model$external.regressors
if(is.null(variance.model$variance.targeting)) vmodel$targeting = FALSE else vmodel$targeting = variance.model$variance.targeting
model = vmodel$model
# mean model:
mmodel=list()
if(is.null(mean.model$armaOrder))
mmodel$armaOrder = c(1,1) else mmodel$armaOrder = mean.model$armaOrder
if(is.null(mean.model$include.mean))
mmodel$include.mean = TRUE else mmodel$include.mean = mean.model$include.mean
if(is.null(mean.model$garchInMean) || !mean.model$garchInMean){
mmodel$garchInMean = FALSE
mmodel$inMeanType = 0
} else{
mmodel$garchInMean = mean.model$garchInMean
if(is.null(mean.model$inMeanType)) mmodel$inMeanType = 1 else mmodel$inMeanType = mean.model$inMeanType
}
if(is.null(mean.model$arfima))
mmodel$arfima = FALSE else mmodel$arfima = mean.model$arfima
mmodel$external.regressors = mean.model$external.regressors
spec = switch(model,
sGARCH = .sgarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
fGARCH = .fgarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
eGARCH = .egarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
gjrGARCH = .gjrgarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
apARCH = .aparchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
iGARCH = .igarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars),
#anstGARCH = .anstgarchspec(vmodel, mmodel, dmodel, start.pars, fixed.pars)
#fiGARCH = .fiGARCHspec(vmodel, mmodel, dmodel, start.pars,...),
#fiAPARCH = .fiAPARCHspec(vmodel, mmodel, dmodel, start.pars,...),
#fiEGARCH = .fiEGARCHspec(vmodel, mmodel, dmodel, start.pars,...),
#hyGARCH = .hyGARCHspec(vmodel, mmodel, dmodel, start.pars,...))
)
return(spec)
}
setMethod(f = "ugarchspec", definition = .ugarchspec)
# extract spec from fit object
getspec = function(object)
{
UseMethod("getspec")
}
.getspec = function(object)
{
spec = ugarchspec(variance.model = list(model = object@model$model, garchOrder = object@model$garchOrder,
submodel = object@model$submodel, external.regressors = object@model$vexdata),
mean.model = list(armaOrder = object@model$armaOrder, include.mean = object@model$include.mean,
garchInMean = object@model$garchInMean, inMeanType = object@model$inMeanType,
arfima = object@model$arfima, external.regressors = object@model$mexdata),
distribution.model = object@model$distribution, start.pars = object@model$start.pars,
fixed.pars = object@model$start.pars)
return(spec)
}
setMethod(f = "getspec", signature(object = "uGARCHfit"), definition = .getspec)
#----------------------------------------------------------------------------------
# univariate filter method
#----------------------------------------------------------------------------------
ugarchfilter = function(spec, data, out.sample = 0, n.old = NULL, ...)
{
UseMethod("ugarchfilter")
}
setMethod("ugarchfilter", signature(spec = "sGARCHspec"), .sgarchfilter)
setMethod("ugarchfilter", signature(spec = "fGARCHspec"), .fgarchfilter)
setMethod("ugarchfilter", signature(spec = "eGARCHspec"), .egarchfilter)
setMethod("ugarchfilter", signature(spec = "gjrGARCHspec"), .gjrgarchfilter)
setMethod("ugarchfilter", signature(spec = "apARCHspec"), .aparchfilter)
setMethod("ugarchfilter", signature(spec="iGARCHspec"), .igarchfilter)
#setMethod("ugarchfilter", signature(spec="anstGARCHspec"), .anstgarchfilter)
#----------------------------------------------------------------------------------
# univariate fit method
#----------------------------------------------------------------------------------
ugarchfit = function(spec, data, out.sample = 0, solver = "solnp", solver.control = list(),
fit.control = list(stationarity = 1, fixed.se = 0, scale = 0), ...)
{
UseMethod("ugarchfit")
}
setMethod("ugarchfit", signature(spec = "sGARCHspec"), .sgarchfit)
setMethod("ugarchfit", signature(spec = "fGARCHspec"), .fgarchfit)
setMethod("ugarchfit", signature(spec = "eGARCHspec"), .egarchfit)
setMethod("ugarchfit", signature(spec = "gjrGARCHspec"), .gjrgarchfit)
setMethod("ugarchfit", signature(spec = "apARCHspec"), .aparchfit)
setMethod("ugarchfit", signature(spec="iGARCHspec"), .igarchfit)
#setMethod("ugarchfit", signature(spec="anstGARCHspec"), .anstgarchfit)
#----------------------------------------------------------------------------------
# univariate forecast method
#----------------------------------------------------------------------------------
ugarchforecast = function(fitORspec, data = NULL, n.ahead = 10, n.roll = 0, out.sample = 0,
external.forecasts = list(mregfor = NULL, vregfor = NULL), ...)
{
UseMethod("ugarchforecast")
}
setMethod("ugarchforecast", signature(fitORspec = "sGARCHfit"), .sgarchforecast)
setMethod("ugarchforecast", signature(fitORspec = "fGARCHfit"), .fgarchforecast)
setMethod("ugarchforecast", signature(fitORspec = "eGARCHfit"), .egarchforecast)
setMethod("ugarchforecast", signature(fitORspec = "gjrGARCHfit"), .gjrgarchforecast)
setMethod("ugarchforecast", signature(fitORspec = "apARCHfit"), .aparchforecast)
setMethod("ugarchforecast", signature(fitORspec = "iGARCHfit"), .igarchforecast)
#setMethod("ugarchforecast", signature(fitORspec = "anstGARCHfit"), .anstgarchforecast)
#alternative dispath method:
# we use the fitORspec rather than a method with fit, spec and data with missing
# methods as this requires implicit declaration of arguments
setMethod("ugarchforecast", signature(fitORspec = "sGARCHspec"), .sgarchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "fGARCHspec"), .fgarchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "eGARCHspec"), .egarchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "gjrGARCHspec"), .gjrgarchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "apARCHspec"), .aparchforecast2)
setMethod("ugarchforecast", signature(fitORspec = "iGARCHspec"), .igarchforecast2)
#setMethod("ugarchforecast", signature(fitORspec = "anstGARCHspec"), .anstgarchforecast2)
#----------------------------------------------------------------------------------
# univariate forecast performance measure
#----------------------------------------------------------------------------------
fpm = function(object, ...)
{
UseMethod("fpm")
}
setMethod("fpm", signature(object = "uGARCHforecast"), .fpm)
#----------------------------------------------------------------------------------
# univariate simulation method
#----------------------------------------------------------------------------------
ugarchsim = function(fit, n.sim = 1000, n.start = 0, m.sim = 1,
startMethod = c("unconditional","sample"),
presigma = NA, prereturns = NA, preresiduals = NA, rseed = NA,
custom.dist = list(name = NA, distfit = NA), mexsimdata = NULL,
vexsimdata = NULL, ...)
{
UseMethod("ugarchsim")
}
setMethod("ugarchsim", signature(fit = "sGARCHfit"), .sgarchsim)
setMethod("ugarchsim", signature(fit = "fGARCHfit"), .fgarchsim)
setMethod("ugarchsim", signature(fit = "eGARCHfit"), .egarchsim)
setMethod("ugarchsim", signature(fit = "gjrGARCHfit"), .gjrgarchsim)
setMethod("ugarchsim", signature(fit = "apARCHfit"), .aparchsim)
setMethod("ugarchsim", signature(fit = "iGARCHfit"), .igarchsim)
#setMethod("ugarchsim", signature(fit = "anstGARCHfit"), .anstgarchsim)
#----------------------------------------------------------------------------------
# univariate path simulation method
#----------------------------------------------------------------------------------
ugarchpath = function(spec, n.sim = 1000, n.start = 0, m.sim = 1,
presigma = NA, prereturns = NA, preresiduals = NA, rseed = NA,
custom.dist = list(name = NA, distfit = NA), mexsimdata = NULL,
vexsimdata = NULL, ...)
{
UseMethod("ugarchpath")
}
setMethod("ugarchpath", signature(spec = "sGARCHspec"), .sgarchpath)
setMethod("ugarchpath", signature(spec = "fGARCHspec"), .fgarchpath)
setMethod("ugarchpath", signature(spec = "eGARCHspec"), .egarchpath)
setMethod("ugarchpath", signature(spec = "gjrGARCHspec"), .gjrgarchpath)
setMethod("ugarchpath", signature(spec = "apARCHspec"), .aparchpath)
setMethod("ugarchpath", signature(spec = "iGARCHspec"), .igarchpath)
#setMethod("ugarchpath", signature(spec = "anstGARCHspec"), .anstgarchpath)
#----------------------------------------------------------------------------------
# univariate garch roll
#----------------------------------------------------------------------------------
# methods to recursively predict/filter/compare with refitting at every N points.
ugarchroll = function(spec, data, n.ahead = 1, forecast.length = 500,
refit.every = 25, refit.window = c("recursive", "moving"), parallel = FALSE,
parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2),
solver = "solnp", fit.control = list(), solver.control = list() ,
calculate.VaR = TRUE, VaR.alpha = c(0.01, 0.05), ...)
{
setMethod("ugarchroll")
}
setMethod("ugarchroll", signature(spec = "sGARCHspec"), definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "iGARCHspec"), definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "gjrGARCHspec"),definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "eGARCHspec"), definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "fGARCHspec"), definition = .rollfdensity)
setMethod("ugarchroll", signature(spec = "apARCHspec"), definition = .rollfdensity)
#setMethod("ugarchroll", signature(spec = "anstGARCHspec"), definition = .rollfdensity)
#----------------------------------------------------------------------------------
# univariate garch parameter distribution
#----------------------------------------------------------------------------------
ugarchdistribution = function(fitORspec, data = NULL, n.sim = 2000, n.start = 1,
m.sim = 100, recursive = FALSE, recursive.length = 6000, recursive.window = 1000,
presigma = NA, prereturns = NA, preresiduals = NA, rseed = NA,
custom.dist = list(name = NA, distfit = NA), mexsimdata = NULL,
vexsimdata = NULL, fit.control = list(), solver = "solnp",
solver.control = list(), parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
setMethod("ugarchdistribution")
}
setMethod("ugarchdistribution", signature(fitORspec = "uGARCHfit"), .ugarchdistribution)
setMethod("ugarchdistribution", signature(fitORspec = "uGARCHspec"), .ugarchdistribution)
#----------------------------------------------------------------------------------
# univariate garch bootstrap based forecast distribution
#----------------------------------------------------------------------------------
ugarchboot = function(fitORspec, data = NULL, method = c("Partial", "Full"), n.ahead = 10,
n.bootfit = 100, n.bootpred = 500, out.sample = 0, rseed = NA, solver = "solnp",
solver.control = list(), fit.control = list(), external.forecasts = list(mregfor = NULL,
vregfor = NULL), parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2))
{
setMethod("ugarchboot")
}
setMethod("ugarchboot", signature(fitORspec = "uGARCHfit"), .ugarchbootfit)
setMethod("ugarchboot", signature(fitORspec = "uGARCHspec"), .ugarchbootspec)
#----------------------------------------------------------------------------------
# univariate plot method / seperate for fit,sim and forecast
#----------------------------------------------------------------------------------
setMethod(f = "plot", signature(x = "uGARCHfit", y = "missing"), .plotgarchfit)
setMethod(f = "plot", signature(x = "uGARCHfilter", y = "missing"), .plotgarchfilter)
setMethod(f = "plot", signature(x = "uGARCHsim", y = "missing"), .plotgarchsim)
setMethod(f = "plot", signature(x = "uGARCHforecast", y = "missing"), .plotgarchforecast)
setMethod(f = "plot", signature(x = "uGARCHpath", y = "missing"), .plotgarchpath)
setMethod(f = "plot", signature(x = "uGARCHroll", y = "missing"), .plotgarchroll)
setMethod(f = "plot", signature(x = "uGARCHdistribution", y = "missing"), .plotgarchdist)
setMethod(f = "plot", signature(x = "uGARCHboot", y = "missing"), .plotgarchboot)
#----------------------------------------------------------------------------------
# univariate show method / seperate for fit,sim and forecast
#----------------------------------------------------------------------------------
# spec show
setMethod("show",
signature(object = "uGARCHspec"),
function(object){
model = strsplit(class(object),"spec")
cat(paste("\n*----------------------------*", sep = ""))
cat(paste("\n* GARCH Model Spec *", sep = ""))
cat(paste("\n*----------------------------*", sep = ""))
cat("\n\nVariance Model\t")
cat(paste("\n-------------------------------\n",sep=""))
cat(paste("GARCH Model\t\t: ", model, "\n", sep = ""))
if(object@variance.model$model == "fGARCH"){
cat(paste("fGARCH Sub-Model: ", object@variance.model$submodel, "\n", sep = ""))
}
cat("GARCH Order\t\t:", object@variance.model$garchOrder[1:2], "\n")
if(object@variance.model$include.vex)
cat(paste("Exogenous Regressor Dimension: ",
dim(object@variance.model$vexdata)[2], "\n",sep = ""))
cat("\nMean Model")
cat(paste("\n-------------------------------\n",sep=""))
cat("AR-MA Order\t\t: ",object@mean.model$armaOrder[1:2],"\n")
cat("Include Mean\t: ", as.logical(object@mean.model$include.mean),"\n")
cat("Garch-in-Mean\t: ",as.logical(object@mean.model$garchInMean),"\n")
cat("ARFIMA\t\t\t: ", as.logical(object@mean.model$arfima),"\n")
if(object@mean.model$include.mex)
cat(paste("Exogenous Regressor Dimension: ",
dim(object@mean.model$mexdata)[2],"\n",sep=""))
cat("\nConditional Distribution Model")
cat(paste("\n-------------------------------\n",sep=""))
cat("Distribution\t: ",object@distribution.model$distribution,"\n")
cat("Includes Lambda\t: ", as.logical(object@distribution.model$include.dlambda),"\n")
cat("Includes Skew\t: ", as.logical(object@distribution.model$include.skew),"\n")
cat("Includes Shape\t: ", as.logical(object@distribution.model$include.shape),"\n\n")
invisible(object)
})
# fit show
setMethod("show",
signature(object = "uGARCHfit"),
function(object){
model = strsplit(class(object),"fit")
garchOrder = object@model$garchOrder
cat(paste("\n*---------------------------*", sep = ""))
cat(paste("\n* GARCH Model Fit *", sep = ""))
cat(paste("\n*---------------------------*", sep = ""))
cat("\n\nSpec")
cat(paste("\n--------------------------", sep = ""))
cat(paste("\nModel\t: ", model," (", garchOrder[1], ",", garchOrder[2], ")", sep=""))
if(object@model$model=="fGARCH" | object@model$model == "fiGARCH"){
cat(paste(" Sub-Model\t: ", object@model$submodel, "\n", sep = ""))
}
if(object@model$include.vex){
cat("\nExogenous Regressors in variance equation: ", object@model$vxn, "\n")
} else{
cat("\nExogenous Regressors in variance equation: none\n")
}
cat("\nInclude Mean\t: ", object@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@model$armaOrder[1],",",
as.integer(object@model$arfima),
",",object@model$armaOrder[2],")",sep=""))
cat("\nGarch-in-Mean\t: ", as.logical(object@model$garchInMean))
if(object@model$include.mex){
cat("\nExogenous Regressors in mean equation: ",object@model$mxn)
} else{
cat("\nExogenous Regressors in mean equation: none")
}
cat("\n\nConditional Distribution: ",object@model$distribution,"\n")
if(object@fit$convergence == 0){
cat("\nOptimal Parameters")
cat(paste("\n--------------------------\n", sep = ""))
print(round(object@fit$matcoef,6), digits = 5)
cat("\nRobust Standard Errors:\n")
print(round(object@fit$robust.matcoef,6), digits = 5)
if(!is.null(object@fit$hessian.message)){
cat(paste("\n", object@fit$hessian.message))
}
cat("\nLogLikelihood :", object@fit$LLH, "\n")
stdresid = object@fit$residuals/object@fit$sigma
itest = .information.test(object@fit$LLH, nObs = length(object@fit$data),
nPars=length(object@fit$coef))
itestm = matrix(0, ncol = 1, nrow = 4)
itestm[1,1] = itest$AIC
itestm[2,1] = itest$BIC
itestm[3,1] = itest$SIC
itestm[4,1] = itest$HQIC
colnames(itestm) = ""
rownames(itestm) = c("Akaike", "Bayes", "Shibata", "Hannan-Quinn")
cat("\nInformation Criteria")
cat("\n--------------------------\n")
print(itestm,digits=5)
cat("\nQ-Statistics on Standardized Residuals")
cat("\n--------------------------\n")
tmp1 = .box.test(stdresid, p = 1, df = sum(object@model$armaOrder))
print(tmp1, digits = 4)
cat("\nH0 : No serial correlation\n")
cat("\nQ-Statistics on Standardized Squared Residuals")
cat("\n--------------------------\n")
tmp2 = .box.test(stdresid, p = 2, df = sum(object@model$armaOrder))
print(tmp2, digits = 4)
cat("\nARCH LM Tests")
cat("\n--------------------------\n")
L2 = .archlmtest(stdresid, lags = 2)
L5 = .archlmtest(stdresid, lags = 5)
L10 = .archlmtest(stdresid, lags = 10)
alm = matrix(0,ncol = 3,nrow = 3)
alm[1,1:3] = c(L2$statistic, L2$parameter, L2$p.value)
alm[2,1:3] = c(L5$statistic, L5$parameter, L5$p.value)
alm[3,1:3] = c(L10$statistic, L10$parameter, L10$p.value)
colnames(alm) = c("Statistic", "DoF", "P-Value")
rownames(alm) = c("ARCH Lag[2]", "ARCH Lag[5]", "ARCH Lag[10]")
print(alm,digits = 4)
nyb = .nyblomTest(object)
colnames(nyb$IndividualStat)<-""
cat("\nNyblom stability test")
cat("\n--------------------------\n")
cat("Joint Statistic: ",round(nyb$JointStat,4))
cat("\nIndividual Statistics:")
print(nyb$IndividualStat, digits = 4)
cat("\nAsymptotic Critical Values (10% 5% 1%)")
cat("\nJoint Statistic: ", round(nyb$JointCritical, 4))
cat("\nIndividual Statistic:", round(nyb$IndividualCritical, 4))
cat("\n\n")
cat("Sign Bias Test")
cat("\n--------------------------\n")
sgtest = signbias(object)
print(sgtest, digits = 4)
cat("\n")
cat("\nAdjusted Pearson Goodness-of-Fit Test:")
cat("\n--------------------------\n")
gofm = gof(object,c(20, 30, 40, 50))
print(gofm, digits = 4)
cat("\n")
cat("\nElapsed time :", object@fit$timer,"\n\n")
} else{
cat("\nConvergence Problem:")
cat("\nSolver Message:", object@fit$message,"\n\n")
}
invisible(object)
})
# filter show
setMethod("show",
signature(object = "uGARCHfilter"),
function(object){
model = strsplit(class(object), "filter")
garchOrder = object@model$garchOrder
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n* GARCH Model Filter *", sep = ""))
cat(paste("\n*--------------------------------*", sep = ""))
cat("\n\nSpec")
cat(paste("\n--------------------------", sep = ""))
cat(paste("\nModel\t: ", model," (", garchOrder[1], ",", garchOrder[2], ")", sep=""))
if(object@model$model=="fGARCH" | object@model$model == "fiGARCH"){
cat(paste(" Sub-Model\t: ", object@model$submodel, "\n", sep = ""))
}
if(object@model$include.vex){
cat("\nExogenous Regressors in variance equation: ", object@model$vxn, "\n")
} else{
cat("\nExogenous Regressors in variance equation: none\n")
}
cat("\nInclude Mean\t: ", object@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@model$armaOrder[1],",",
as.integer(object@model$arfima),
",",object@model$armaOrder[2],")",sep=""))
cat("\nGarch-in-Mean\t: ", as.logical(object@model$garchInMean))
if(object@model$include.mex){
cat("\nExogenous Regressors in mean equation: ",object@model$mxn)
} else{
cat("\nExogenous Regressors in mean equation: none")
}
cat("\n\nConditional Distribution: ",object@model$distribution,"\n")
cat("\nFilter Parameters")
cat(paste("\n--------------------------\n", sep = ""))
print(matrix(object@filter$pars, ncol=1,
dimnames = list(names(coef(object)), "")), digits = 5)
cat("\nLogLikelihood :", object@filter$LLH, "\n")
stdresid = object@filter$residuals/object@filter$sigma
itest = infocriteria(object)
print(itest,digits=5)
cat("\nQ-Statistics on Standardized Residuals")
cat("\n--------------------------\n")
tmp1 = .box.test(stdresid, p = 1, df = sum(object@model$armaOrder))
print(tmp1, digits = 4)
cat("\nH0 : No serial correlation\n")
cat("\nQ-Statistics on Standardized Squared Residuals")
cat("\n--------------------------\n")
tmp2 = .box.test(stdresid, p = 2, df = sum(object@model$armaOrder))
print(tmp2, digits = 4)
cat("\nARCH LM Tests")
cat("\n--------------------------\n")
L2 = .archlmtest(stdresid, lags = 2)
L5 = .archlmtest(stdresid, lags = 5)
L10 = .archlmtest(stdresid, lags = 10)
alm = matrix(0,ncol = 3,nrow = 3)
alm[1,1:3] = c(L2$statistic, L2$parameter, L2$p.value)
alm[2,1:3] = c(L5$statistic, L5$parameter, L5$p.value)
alm[3,1:3] = c(L10$statistic, L10$parameter, L10$p.value)
colnames(alm) = c("Statistic", "DoF", "P-Value")
rownames(alm) = c("ARCH Lag[2]", "ARCH Lag[5]", "ARCH Lag[10]")
print(alm,digits = 4)
cat("\n\n")
cat("Sign Bias Test")
cat("\n--------------------------\n")
sgtest = signbias(object)
print(sgtest, digits = 4)
cat("\n")
cat("\nAdjusted Pearson Goodness-of-Fit Test:")
cat("\n--------------------------\n")
gofm = gof(object,c(20, 30, 40, 50))
print(gofm, digits = 4)
cat("\n")
invisible(object)
})
# sim show
setMethod("show",
signature(object = "uGARCHsim"),
function(object){
model = strsplit(class(object), "sim")
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* GARCH Model Simulation *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\nModel : ",model,sep=""))
if(object@model$model == "fGARCH" | object@model$model == "fiGARCH"){
cat(paste(" Sub-Model : ", object@model$submodel, "\n", sep = ""))
}
sim = object@simulation
dates = object@model$dates
sigma = sim$sigmaSim
series = sim$seriesSim
resids = sim$residSim
m = dim(sigma)[2]
N = dim(sigma)[1]
cat(paste("\nHorizon: ",N))
cat(paste("\nSimulations: ",m,"\n",sep=""))
sd1 = apply(sigma^2, 2, FUN=function(x) mean(x))
sd2 = apply(sigma^2, 2, FUN=function(x) range(x))
rx1 = apply(series, 2, FUN=function(x) mean(x))
rx2 = apply(series, 2, FUN=function(x) range(x))
actual = c(0,mean(object@simulation$sigma^2), min(object@simulation$sigma^2),
max(object@simulation$sigma^2), mean(object@simulation$series),
min(object@simulation$series), max(object@simulation$series))
dd = data.frame(Seed = object@seed, Sigma2.Mean = sd1, Sigma2.Min = sd2[1,],
Sigma2.Max = sd2[2,], Series.Mean = rx1, Series.Min = rx2[1,],
Series.Max = rx2[2,])
meansim = apply(dd, 2, FUN = function(x) mean(x))
meansim[1] = 0
dd = rbind(dd, meansim, actual)
rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)", "Actual")
print(dd,digits = 3)
cat("\n\n")
})
# forecast show
setMethod("show",
signature(object = "uGARCHforecast"),
function(object){
model = strsplit(class(object),"forecast")
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* GARCH Model Forecast *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\nModel: ", model, sep = ""))
if(object@model$model == "fGARCH" | object@model$model == "fiGARCH"){
cat(paste(" Sub-Model: ", object@model$submodel, "\n", sep = ""))
}
n.ahead = object@forecast$n.ahead
cat(paste("\nHorizon: ", n.ahead, sep = ""))
cat(paste("\nRoll Steps: ",object@forecast$n.roll, sep = ""))
n.start = object@forecast$n.start
if(n.start>0) infor = ifelse(n.ahead>n.start, n.start, n.ahead) else infor = 0
cat(paste("\nOut of Sample: ", infor, "\n", sep = ""))
cat("\n0-roll forecast: \n")
zz = object@forecast$forecast[[1]]
print(zz, digits = 4)
cat("\n\n")
})
# path show
setMethod("show",
signature(object = "uGARCHpath"),
function(object){
model = strsplit(class(object), "path")
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* GARCH Model Path Simulation *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\nModel : ", model, sep = ""))
sim = object@path
sigma = sim$sigmaSim
series = sim$seriesSim
resids = sim$residSim
m = dim(sigma)[2]
N = dim(sigma)[1]
cat(paste("\nHorizon: ", N))
cat(paste("\nSimulations: ", m, "\n", sep = ""))
sd1 = apply(sigma, 2, FUN = function(x) mean(x))
sd2 = apply(sigma, 2, FUN = function(x) range(x))
rx1 = apply(series, 2, FUN = function(x) mean(x))
rx2 = apply(series, 2, FUN = function(x) range(x))
dd = data.frame(Seed = object@seed, Sigma.Mean = sd1, Sigma.Min = sd2[1,],
Sigma.Max = sd2[2,], Series.Mean = rx1, Series.Min = rx2[1,],
Series.Max = rx2[2,])
meansim = apply(dd, 2, FUN = function(x) mean(x))
meansim[1] = 0
dd = rbind(dd, meansim)
rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)")
print(dd, digits = 3)
cat("\n\n")
})
# distribution show
setMethod("show",
signature(object = "uGARCHdistribution"),
function(object){
model = object@spec@variance.model$model
submodel = object@spec@variance.model$submodel
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* GARCH Parameter Distribution *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\nModel : ", model, sep = ""))
if(model == "fGARCH"){
cat(paste("\nSubModel : ", submodel, sep = ""))
}
cat(paste("\nNo. Paths (m.sim) : ", object@dist$details$m.sim, sep = ""))
cat(paste("\nLength of Paths (n.sim) : ", object@dist$details$n.sim, sep = ""))
cat(paste("\nRecursive : ", object@dist$details$recursive, sep = ""))
if(object@dist$details$recursive){
cat(paste("\nRecursive Length : ", object@dist$details$recursive.length, sep = ""))
cat(paste("\nRecursive Window : ", object@dist$details$recursive.window, sep = ""))
}
cat("\n\n")
cat("Coefficients: True vs Simulation Mean (Window-n)\n")
nwindows = object@dist$details$nwindows
nm = object@dist$details$n.sim + (0:(nwindows-1))*object@dist$details$recursive.window
ns = matrix(0, ncol = dim(object@truecoef)[1], nrow = nwindows)
for(i in 1:nwindows){
ns[i,] = apply(as.data.frame(object, window = i), 2, FUN = function(x) mean(x, na.rm = T))
}
ns = rbind(object@truecoef[,1], ns)
colnames(ns) = rownames(object@truecoef)
rownames(ns) = c("true-coef",paste("window-", nm, sep=""))
print(as.data.frame(ns), digits=5)
for(i in 1:nwindows){
if(any(object@dist[[i]]$convergence==1)) n = length(which(object@dist[[i]]$convergence==1)) else n = 0
if(n>0) cat(paste("\nwindow-",nm[i]," no. of non-converged fits: ", n, "\n",sep=""))
}
cat("\n\n")
})
# fpm show
setMethod("show",
signature(object = "uGARCHfpm"),
function(object){
model = object@details$model
submodel = object@details$submodel
cat(paste("\n*---------------------------------------------*", sep = ""))
cat(paste("\n* GARCH Forecast Performance Measures *", sep = ""))
cat(paste("\n*---------------------------------------------*", sep = ""))
cat(paste("\nModel : ", model, sep = ""))
if(model == "fGARCH"){
cat(paste("\nSubModel : ", submodel, sep = ""))
}
cat(paste("\nn.ahead : ", object@details$n.ahead, sep = ""))
cat(paste("\nn.roll : ", object@details$n.roll, sep = ""))
cat(paste("\nfpm type : ", object@details$type, sep = ""))
if(object@details$type==2){
cat("\nForecasts w/th Mean Loss Functions\n(1-ahead rolling)\n")
fc = cbind(t(object@forecasts$series), t(object@forecasts$sigma))
fc = rbind(fc, cbind(object@seriesfpm$meanloss["mse"], object@sigmafpm$meanloss["mse"]))
fc = rbind(fc, cbind(object@seriesfpm$meanloss["mad"], object@sigmafpm$meanloss["mad"]))
fc = rbind(fc, cbind(object@seriesfpm$meanloss["dac"], NA))
fc = rbind(fc, cbind(NA, object@sigmafpm$meanloss["r2log"]))
fc = rbind(fc, cbind(NA, object@sigmafpm$meanloss["qlike"]))
colnames(fc) = c("series", "sigma")
cat("\n")
print(round(fc,6), digits = 5)
cat("\n* performance measures for sigma are based on variance")
} else{
cat("\nMean Loss Functions\n(n.ahead/n.roll)\n")
cat("\nseries\n")
fc1 = object@seriesfpm$meanloss
colnames(fc1) = colnames(object@forecasts$series)
print(t(fc1), digits=5)
cat("\nsigma\n")
fc2 = object@sigmafpm$meanloss
colnames(fc2) = colnames(object@forecasts$sigma)
print(t(fc2), digits=5)
cat("\n* performance measures for sigma are based on variance")
}
cat("\n\n")
})
# boot show
setMethod("show",
signature(object = "uGARCHboot"),
function(object){
model = object@spec@variance.model$model
submodel = object@spec@variance.model$submodel
cat(paste("\n*-----------------------------------*", sep = ""))
cat(paste("\n* GARCH Bootstrap Forecast *", sep = ""))
cat(paste("\n*-----------------------------------*", sep = ""))
cat(paste("\nModel : ", model, sep = ""))
if(model == "fGARCH"){
cat(paste("\nSubModel : ", submodel, sep = ""))
}
cat(paste("\nn.ahead : ", object@model$n.ahead, sep = ""))
cat(paste("\nBootstrap method: ",object@model$type))
forc = object@forc@forecast$forecasts[[1]]
zs = rbind(as.data.frame(object, which = "sigma", type = "summary"), forc[,"sigma"])
zr = rbind(as.data.frame(object, which = "series", type = "summary"), forc[,"series"])
rownames(zr)[6] = rownames(zs)[6] = "forecast"
hh = min(object@model$n.ahead, 10)
cat("\n\nSeries (summary):\n")
print(head(round(t(zr), 6), hh), digits = 5)
cat(".....................\n")
cat("\nSigma (summary):\n")
print(head(round(t(zs), 6),hh), digits = 5)
cat(".....................")
cat("\n\n")
})
#-------------------------------------------------------------------------
# multi-methods
setMethod("show",
signature(object = "uGARCHmultispec"),
function(object){
cat(paste("\n*-----------------------------*", sep = ""))
cat(paste("\n* GARCH Multi-Spec *", sep = ""))
cat(paste("\n*-----------------------------*", sep = ""))
N = length(object@spec)
cat(paste("\nMultiple Specifications\t: ", N, sep=""))
cat(paste("\nMulti-Spec Type\t\t\t: ", object@type, sep=""))
cat("\n")
invisible(object)
})
setMethod("show",
signature(object = "uGARCHmultifit"),
function(object){
cat(paste("\n*----------------------------*", sep = ""))
cat(paste("\n* GARCH Multi-Fit *", sep = ""))
cat(paste("\n*----------------------------*", sep = ""))
cat(paste("\nNo. Assets :", length(object@fit), sep=""))
asset.names = object@model$asset.names
if(object@model$type == "equal"){
model = strsplit(class(object@fit[[1]]),"fit")
cat(paste("\nGARCH Multi-Spec Type : Equal",sep=""))
cat(paste("\nGARCH Model Spec",sep=""))
cat(paste("\n--------------------------",sep=""))
cat(paste("\nModel : ", model,sep=""))
if(object@fit[[1]]@model$model=="fGARCH" | object@fit[[1]]@model$model == "fiGARCH"){
cat(paste(" Sub-Model : ", object@fit[[1]]@model$submodel, "\n", sep = ""))
}
if(object@fit[[1]]@model$include.vex){
cat("\nExogenous Regressors in variance equation: ", object@model$vxn, "\n")
} else{
cat("\nExogenous Regressors in variance equation: none\n")
}
cat("\nMean Equation :")
cat("\nInclude Mean : ", object@fit[[1]]@model$include.mean)
cat(paste("\nAR(FI)MA Model : (",object@fit[[1]]@model$armaOrder[1],",",
as.integer(object@fit[[1]]@model$arfima),
",",object@fit[[1]]@model$armaOrder[2],")",sep=""))
cat("\nGarch-in-Mean : ", as.logical(object@fit[[1]]@model$garchInMean))
if(object@fit[[1]]@model$include.mex){
cat("\nExogenous Regressors in mean equation: ",object@fit[[1]]@model$mxn)
} else{
cat("\nExogenous Regressors in mean equation: none")
}
cat("\nConditional Distribution: ",object@fit[[1]]@model$distribution,"\n")
cv = sapply(object@fit, FUN = function(x) x@fit$convergence)
if(any(cv != 0)){
ncv = which(cv != 0)
nncv = length(ncv)
cat("\nNo. of non converged fits: ", ncv,"\n")
if(ncv>0) cat("\nNon converged fits: ", nncv,"\n")
} else{
cat(paste("\nGARCH Model Fit", sep = ""))
cat(paste("\n--------------------------", sep = ""))
cat("\nOptimal Parameters:\n")
ll = t(likelihood(object))
rownames(ll) = "Log-Lik"
cf = coef(object)
colnames(cf) = asset.names
print(round(rbind(cf, ll), digits = 5))
cat("\n")
}
} else{
cat(paste("\nGARCH Model Fit", sep = ""))
cat(paste("\n--------------------------", sep = ""))
cat("\nOptimal Parameters:\n")
print(coef(object), digits = 5)
}
invisible(object)
})
setMethod("show",
signature(object = "uGARCHmultifilter"),
function(object){
asset.names = object@model$asset.names
cat(paste("\n*-------------------------------*", sep = ""))
cat(paste("\n* GARCH Multi-Filter *", sep = ""))
cat(paste("\n*-------------------------------*", sep = ""))
cat(paste("\nNo. Assets :", length(object@filter), sep=""))
if(object@model$type == "equal"){
cat(paste("\nGARCH Model Filter", sep = ""))
cat(paste("\n--------------------------", sep = ""))
cat("\nParameters:\n")
cf = coef(object)
colnames(cf) = asset.names
print(round(cf, digits = 5))
} else{
cat(paste("\nGARCH Model Filter", sep = ""))
cat(paste("\n--------------------------", sep = ""))
cat("\nOptimal Parameters:\n")
print(coef(object), digits = 5)
}
invisible(object)
})
setMethod("show",
signature(object = "uGARCHmultiforecast"),
function(object){
asset.names = object@model$asset.names
cat(paste("\n*---------------------------------*", sep = ""))
cat(paste("\n* GARCH Multi-Forecast *", sep = ""))
cat(paste("\n*---------------------------------*", sep = ""))
cat(paste("\nNo. Assets :", length(object@forecast), sep=""))
cat(paste("\n--------------------------\n",sep=""))
fc = as.array(object)
print(fc, digits = 5)
invisible(object)
})
#----------------------------------------------------------------------------------
# report method
#----------------------------------------------------------------------------------
report = function(object, ...)
{
UseMethod("report")
}
setMethod("report", signature(object = "uGARCHroll"), .ugarchrollreport)
#----------------------------------------------------------------------------------
# univariate fit extractors
#----------------------------------------------------------------------------------
# coef methods
.ugarchfitcoef = function(object)
{
object@fit$coef
}
setMethod("coef", signature(object = "uGARCHfit"), .ugarchfitcoef)
.ugarchfiltercoef = function(object)
{
object@filter$pars
}
setMethod("coef", signature(object = "uGARCHfilter"), .ugarchfiltercoef)
# multi-fit and multi-filter coefficients:
.ugarchmultifitcoef = function(object)
{
if(object@model$type == "equal"){
ans = sapply(object@fit, FUN = function(x) coef(x), simplify = TRUE)
} else{
ans = lapply(object@fit, FUN = function(x) coef(x))
}
return(ans)
}
setMethod("coef", signature(object = "uGARCHmultifit"), .ugarchmultifitcoef)
.ugarchmultifiltercoef = function(object)
{
ans = sapply(object@filter, FUN = function(x) coef(x), simplify = TRUE)
return(ans)
}
setMethod("coef", signature(object = "uGARCHmultifilter"), .ugarchmultifiltercoef)
#----------------------------------------------------------------------------------
# as.data.frame method for fitted object
.ugarchfitdf = function(x, row.names = NULL, optional = FALSE, ...)
{
fit = x@fit
ans = data.frame(data = fit$data, fitted = fit$fitted.values,
residuals = fit$residuals, sigma = fit$sigma)
rownames(ans) = as.character(fit$dates)
ans
}
setMethod("as.data.frame", signature(x = "uGARCHfit"), .ugarchfitdf)
#----------------------------------------------------------------------------------
# as.data.frame method for filter object
.ugarchfilterdf = function(x, row.names = NULL, optional = FALSE, ...)
{
flt = x@filter
ans = data.frame(data = flt$data, fitted = flt$data - flt$residuals,
residuals = flt$residuals, sigma = flt$sigma)
rownames(ans) = as.character(flt$dates)
ans
}
setMethod("as.data.frame", signature(x = "uGARCHfilter"), .ugarchfilterdf)
#----------------------------------------------------------------------------------
# as.data.frame method for forecast object
.ugarchfordfall = function(x, which = "sigma", aligned = TRUE, prepad = TRUE, type = 0)
{
if(aligned){
ans = .ugarchfordf1(x = x, which = which, prepad = prepad)
} else{
ans = .ugarchfordf2(x = x, which = which, type = type)
}
return(ans)
}
.ugarchfordf1 = function(x, which = "sigma", prepad = TRUE)
{
# return full frame with columns the rolls and rows the unique dates
# padded with NA for forecasts beyond n.ahead and actual filtered values
# for values before n.roll
forc = x@forecast
n.start = forc$n.start
N = x@forecast$N - n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
tp = ifelse(which == "sigma", 1, 2)
fdates = sort(unique(as.vector(sapply(forc$forecast, FUN=function(x) rownames(x)))))
tmp = matrix(NA, ncol = n.roll+1, nrow = length(fdates))
tmp[1:n.ahead, 1] = forc$forecast[[1]][,tp]
if( n.roll > 0 ){
for(i in 1:(n.roll)){
if(which == "sigma"){
if(prepad) {
tmp[1:i, i+1] = x@filter$sigma[(N):(N+i-1)]
}
} else {
if(prepad) {
tmp[1:i, i+1] = x@filter$data[(N):(N+i-1)]
}
}
tmp[(i+1):(i+n.ahead), i+1] = forc$forecast[[i+1]][,tp]
}
}
tmp = as.data.frame(tmp)
rownames(tmp) = fdates
colnames(tmp) = paste("roll-", seq(0, n.roll,by = 1), sep="")
tmp
}
# retval: 0 is the standard, returns all values
# retval: 1 returns only those values which have in sample equivalent data (for testing purposes)
# retval: 2 returns only those values which are truly forecasts without in sample data
.ugarchfordf2 = function(x, which = "sigma", type = 0, ...)
{
n.ahead = x@forecast$n.ahead
# n.start == out.sample
n.start = x@forecast$n.start
n.roll = x@forecast$n.roll
tlength = n.ahead + n.roll
mat = matrix(NA, ncol = n.roll + 1, nrow = n.ahead)
mat = sapply(x@forecast$forecast, FUN = function(x) x[, which])
if(is.vector(mat)) mat = matrix(mat, ncol = n.roll+1)
colnames(mat) = paste("roll-", seq(0, n.roll, by = 1), sep = "")
rownames(mat) = paste("t+", 1:n.ahead, sep = "")
if(n.roll==0 | type==0) return(as.data.frame(mat))
indices = apply(.embed(1:tlength, n.ahead, by = 1), 1, FUN = function(x) rev(x))
exc = which(indices>n.start)
if(type == 1){
if(length(exc)>0) mat[exc] = NA
} else{
if(length(exc)>0) mat[-exc] = NA
}
return(as.data.frame(mat))
}
# pad applies to when rollframe = "all", whether to pre-pad forecast with actual values else NA's
# post forecast values are always NA's (this relates to the out.sample option and n.roll)
.ugarchfordf = function(x, row.names = NULL, optional = FALSE, rollframe = 0,
aligned = TRUE, which = "sigma", prepad = TRUE, type = 0)
{
forc = x@forecast
n.start = forc$n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
if(!any(type==(0:2)))
stop("invalid argument for type in as.data.frame", call. = FALSE)
#if(rollframe == "all" && n.roll<=0) rollframe = 0
if(rollframe == "all") return(.ugarchfordfall(x, which, aligned, prepad, type))
# allow type to be used here as well
rollframe = as.integer(rollframe)
if(rollframe>n.roll | rollframe<0) stop("rollframe out of bounds", call. = FALSE)
indx = (rollframe+1):(rollframe+n.ahead)
exc = which(indx>n.start)
ans = forc$forecast[[rollframe+1]]
if(type == 1){
if(length(exc)>0) ans[exc,] = NA
}
if(type == 2){
if(length(exc)>0) ans[-exc,] = NA
}
return(ans)
}
setMethod("as.data.frame", signature(x = "uGARCHforecast"), .ugarchfordf)
# as.array method for forecast object
.ugarchforar = function(x, ...)
{
forc = x@forecast
n.start = forc$n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
forar = array(NA, dim = c(n.ahead, 2, n.roll+1))
for(i in 1:(n.roll+1)){
forar[,,i] = as.matrix(forc$forecast[[i]])
}
return(forar)
}
setMethod("as.array", signature(x = "uGARCHforecast"), .ugarchforar)
# as.list method for forecast object
.ugarchforlist = function(x, ...)
{
x@forecast$forecast
}
setMethod("as.list", signature(x = "uGARCHforecast"), .ugarchforlist)
# as.list method for forecast object
.ugarchmultiforlist = function(x, ...)
{
ans = lapply(x@forecast, FUN = function(x) x@forecast$forecast)
names(ans) = x@model$asset.names
ans
}
setMethod("as.list", signature(x = "uGARCHmultiforecast"), .ugarchmultiforlist)
.ugarchmultiforarray = function(x, which = "sigma", ...)
{
n = length(x@forecast)
ns = x@forecast[[1]]@forecast$n.roll
nah = x@forecast[[1]]@forecast$n.ahead
forar = array(NA, dim = c(nah, n, ns+1))
asset.names = x@model$asset.names
rnames = paste("n.ahead-", 1:nah, sep = "")
dnames = paste("n.roll-", 0:ns, sep = "")
dimnames(forar) = list(rnames, asset.names, dnames)
for(i in 1:(ns+1)) forar[,,i] = sapply(x@forecast, FUN = function(x) x@forecast$forecasts[[i]][,which])
return(forar)
}
setMethod("as.array", signature(x = "uGARCHmultiforecast"), .ugarchmultiforarray)
#----------------------------------------------------------------------------------
# as data.frame for fpm object
.ugarchfpmdf = function(x, row.names = NULL, optional = FALSE, which = "series", type = "meanloss", rollframe = 0, ...)
{
if(type == "meanloss"){
if(which == "series"){
ans = as.data.frame(x@seriesfpm$meanloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$series) else colnames(ans) ="roll_t+1"
} else{
ans = as.data.frame(x@sigmafpm$meanloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$sigma) else colnames(ans) = "roll_t+1"
}
}
if(type == "medianloss"){
if(which == "series"){
ans = as.data.frame(x@seriesfpm$medianloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$series) else colnames(ans) ="roll_t+1"
} else{
ans = as.data.frame(x@sigmafpm$medianloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$sigma) else colnames(ans) ="roll_t+1"
}
}
if(type == "loss")
{
if(which == "series"){
ans = as.data.frame(x@seriesfpm$lossfn[[rollframe+1]])
} else{
ans = as.data.frame(x@sigmafpm$lossfn[[rollframe+1]])
}
}
return(ans)
}
setMethod("as.data.frame", signature(x = "uGARCHfpm"), .ugarchfpmdf)
#----------------------------------------------------------------------------------
# as.data.frame method for distribution object
.ugarchdistdf = function(x, row.names = NULL, optional = FALSE, which = "coef", window = 1, ...)
{
n = x@dist$details$nwindows
if(window > n) stop("window size greater than actual available", call. = FALSE)
if(which == "rmse"){
ans = as.data.frame(t(x@dist[[window]]$rmse))
colnames(ans) = rownames(x@truecoef)
}
if(which == "stats"){
llh = x@dist[[window]]$likelist
persist = x@dist[[window]]$persist
uncvar = x@dist[[window]]$vlongrun
uncmean = x@dist[[window]]$mlongrun
maxret = x@dist[[window]]$simmaxdata[,1]
minret = x@dist[[window]]$simmindata[,1]
meanret = x@dist[[window]]$simmeandata[,1]
kurtosis = x@dist[[window]]$simmomdata[,1]
skewness = x@dist[[window]]$simmomdata[,2]
maxsigma = x@dist[[window]]$simmaxdata[,3]
minsigma = x@dist[[window]]$simmindata[,3]
meansigma = x@dist[[window]]$simmeandata[,3]
ans = data.frame(llh = llh, persist = persist, uncvar = uncvar, uncmean = uncmean,
maxret = maxret, minret = minret, meanret = meanret, kurtosis = kurtosis,
skewness = skewness, maxsigma = maxsigma, minsigma = minsigma, meansigma = meansigma)
}
if(which == "coef"){
cf = x@dist[[window]]$simcoef
ans = data.frame(coef = cf)
colnames(ans) = rownames(x@truecoef)
}
if(which == "coefse"){
cfe = x@dist[[window]]$simcoefse
ans = data.frame(coefse = cfe)
colnames(ans) = rownames(x@truecoef)
}
ans
}
setMethod("as.data.frame", signature(x = "uGARCHdistribution"), .ugarchdistdf)
#----------------------------------------------------------------------------------
# as.data.frame method for simulation object
.ugarchsimdf = function(x, row.names = NULL, optional = FALSE, which = "sigma")
{
# simframe: sigma, series, residuals
#sigmaSim=sigmaSim, seriesSim=seriesSim, residSim=residSim
sim = x@simulation
dates = x@model$dates
sigma = sim$sigmaSim
m = dim(sigma)[2]
N = dim(sigma)[1]
fwdd = .generatefwd(dates, N = N, dformat = "%Y-%m-%d", periodicity = "days")
if(which == "sigma"){
ans = data.frame(sigmasim = sigma)
}
if(which == "series"){
series = sim$seriesSim
ans = data.frame(seriessim = series)
}
if(which == "residuals"){
resids = sim$residSim
ans = data.frame(residsim = resids)
}
rownames(ans) = as.character(fwdd)
ans
}
setMethod("as.data.frame", signature(x = "uGARCHsim"), .ugarchsimdf)
#----------------------------------------------------------------------------------
# as.data.frame method for path simulation object
.ugarchpathdf = function(x, row.names = NULL, optional = FALSE, which = "sigma")
{
# simframe: sigma, series, residuals
#sigmaSim=sigmaSim, seriesSim=seriesSim, residSim=residSim
sim = x@path
sigma = sim$sigmaSim
m = dim(sigma)[2]
N = dim(sigma)[1]
if(which == "sigma"){
ans = data.frame(sigmasim = sigma)
}
if(which == "series"){
series = sim$seriesSim
ans = data.frame(seriessim = series)
}
if(which == "residuals"){
resids = sim$residSim
ans = data.frame(residsim = resids)
}
ans
}
setMethod("as.data.frame", signature(x = "uGARCHpath"), .ugarchpathdf)
#----------------------------------------------------------------------------------
# as.data.frame method for bootstrap object
.ugarchbootdf = function(x, row.names = NULL, optional = FALSE, which = "sigma", type = "raw", qtile = c(0.01, 0.099))
{
n.ahead = x@model$n.ahead
if(which == "sigma")
{
if(type == "raw"){
sigma = x@fsigma
ans = data.frame(bootsigma = sigma)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
}
if(type == "q"){
if(all(is.numeric(qtile)) && (all(qtile<1.0) && all(qtile >0.0))){
sigma = x@fsigma
ans = apply(sigma, 2, FUN = function(x) quantile(x, qtile))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = paste("q", qtile, sep = "")
} else{
stop("\nfor type q, the qtile value must be numeric and between (>)0 and 1(<)\n", call. = FALSE)
}
}
if(type == "summary"){
sigma = x@fsigma
ans = apply(sigma, 2, FUN = function(x) c(min(x), quantile(x, 0.25), mean(x), quantile(x, 0.75), max(x) ))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = c("min", "q0.25", "mean", "q0.75", "max")
}
}
if(which == "series")
{
if(type == "raw"){
series = x@fseries
ans = data.frame(bootseries = series)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
}
if(type == "q"){
if(all(is.numeric(qtile)) && (all(qtile<1.0) && all(qtile >0.0))){
series = x@fseries
ans = apply(series, 2, FUN = function(x) quantile(x, qtile))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = paste("q", qtile, sep = "")
} else{
stop("\nfor type q, the qtile value must be numeric and between (>)0 and 1(<)\n", call. = FALSE)
}
}
if(type == "summary"){
series = x@fseries
ans = apply(series, 2, FUN = function(x) c(min(x), quantile(x, 0.25), mean(x), quantile(x, 0.75), max(x) ))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = c("min", "q.25", "mean", "q.75", "max")
}
}
ans
}
setMethod("as.data.frame", signature(x = "uGARCHboot"), .ugarchbootdf)
#----------------------------------------------------------------------------------
# as.data.frame method for roll object
# valid which = density, fpm, coefs
.ugarchrolldf = function(x, row.names = NULL, optional = FALSE, which = "density", n.ahead = 1, refit = 1)
{
n = x@roll$n.ahead
if(n.ahead>n)
stop("n.ahead chosen exceeds roll object specification", call. = FALSE)
if(which == "coefs"){
ans = as.data.frame(x@roll$coefs)
rownames(ans) = paste("refit-", 1:dim(ans)[1], sep = "")
}
if(which == "density"){
ans = as.data.frame(x@roll$fdensity[[n.ahead]])
rownames(ans) = paste("roll-", 1:dim(ans)[1], sep = "")
}
if(which == "coefmat"){
ans = as.data.frame(x@roll$coefmat[[refit]])
}
if(which == "LLH"){
ans = as.data.frame(x@roll$LLH)
rownames(ans) = paste("refit-", 1:dim(ans)[1], sep = "")
colnames(ans) = "LLH"
}
if(which == "VaR"){
ans = as.data.frame(x@roll$VaR.out[[n.ahead]])
}
return(ans)
}
setMethod("as.data.frame", signature(x = "uGARCHroll"), .ugarchrolldf)
as.uGARCHforecast = function(object, ...)
{
setMethod("as.uGARCHforecast")
}
.roll2forc = function(object, refit = 1)
{
n = object@roll$n.refit
if(refit>n)
stop("refit chosen exceeds roll object specification", call. = FALSE)
object@forecast[[refit]]
}
setMethod("as.uGARCHforecast", signature(object = "uGARCHroll"), .roll2forc)
#----------------------------------------------------------------------------------
# residuals method
.ugarchfitresids = function(object)
{
object@fit$residuals
}
setMethod("residuals", signature(object = "uGARCHfit"), .ugarchfitresids)
.ugarchfilterresids = function(object)
{
object@filter$residuals
}
setMethod("residuals", signature(object = "uGARCHfilter"), .ugarchfilterresids)
.ugarchmultifitresids = function(object)
{
sapply(object@fit, FUN = function(x) residuals(x), simplify = TRUE)
}
setMethod("residuals", signature(object = "uGARCHmultifit"), .ugarchmultifitresids)
.ugarchmultifilterresids = function(object)
{
sapply(object@filter, FUN = function(x) residuals(x), simplify = TRUE)
}
setMethod("residuals", signature(object = "uGARCHmultifilter"), .ugarchmultifilterresids)
#----------------------------------------------------------------------------------
# sigma method
sigma = function(object, ...)
{
UseMethod("sigma")
}
.ugarchfitsigma = function(object)
{
object@fit$sigma
}
setMethod("sigma", signature(object = "uGARCHfit"), .ugarchfitsigma)
.ugarchfiltersigma = function(object)
{
object@filter$sigma
}
setMethod("sigma", signature(object = "uGARCHfilter"), .ugarchfiltersigma)
.ugarchmultifitsigma = function(object)
{
sapply(object@fit, FUN = function(x) sigma(x), simplify = TRUE)
}
setMethod("sigma", signature(object = "uGARCHmultifit"), .ugarchmultifitsigma)
.ugarchmultifiltersigma = function(object)
{
sapply(object@filter, FUN = function(x) sigma(x), simplify = TRUE)
}
setMethod("sigma", signature(object = "uGARCHmultifilter"), .ugarchmultifiltersigma)
#----------------------------------------------------------------------------------
# nyblom method
nyblom = function(object)
{
UseMethod("nyblom")
}
setMethod("nyblom", signature(object = "uGARCHfit"), .nyblomTest)
#----------------------------------------------------------------------------------
# signbias method
signbias = function(object)
{
UseMethod("signbias")
}
setMethod("signbias", signature(object = "uGARCHfit"), .signbiasTest)
setMethod("signbias", signature(object = "uGARCHfilter"), .signbiasTest)
#----------------------------------------------------------------------------------
# goodness of fit method
gof = function(object,groups)
{
UseMethod("gof")
}
setMethod("gof", signature(object = "uGARCHfit", groups = "numeric"), .gofTest)
setMethod("gof", signature(object = "uGARCHfilter", groups = "numeric"), .gofTest)
#----------------------------------------------------------------------------------
# Info Criteria method
infocriteria = function(object)
{
UseMethod("infocriteria")
}
.ugarchinfocriteria = function(object)
{
itest = .information.test(likelihood(object), nObs = length(fitted(object)),
nPars = length(coef(object)))
itestm = matrix(0, ncol = 1, nrow = 4)
itestm[1,1] = itest$AIC
itestm[2,1] = itest$BIC
itestm[3,1] = itest$SIC
itestm[4,1] = itest$HQIC
colnames(itestm) = ""
rownames(itestm) = c("Akaike", "Bayes", "Shibata", "Hannan-Quinn")
return(itestm)
}
setMethod("infocriteria", signature(object = "uGARCHfit"), .ugarchinfocriteria)
setMethod("infocriteria", signature(object = "uGARCHfilter"), .ugarchinfocriteria)
#----------------------------------------------------------------------------------
# Likelihood method
likelihood = function(object)
{
UseMethod("likelihood")
}
.ugarchfitLikelihood = function(object)
{
return(object@fit$LLH)
}
setMethod("likelihood", signature(object = "uGARCHfit"), .ugarchfitLikelihood)
.ugarchfilterLikelihood = function(object)
{
return(object@filter$LLH)
}
setMethod("likelihood", signature(object = "uGARCHfilter"), .ugarchfilterLikelihood)
.ugarchmultifilterLikelihood = function(object)
{
sapply(object@filter, FUN = function(x) likelihood(x), simplify = TRUE)
}
setMethod("likelihood", signature(object = "uGARCHmultifilter"), .ugarchmultifilterLikelihood)
.ugarchmultifitLikelihood = function(object)
{
sapply(object@fit, FUN = function(x) likelihood(x), simplify = TRUE)
}
setMethod("likelihood", signature(object = "uGARCHmultifit"), .ugarchmultifitLikelihood)
#----------------------------------------------------------------------------------
# Fitted method
.ugarchfitted = function(object)
{
return(object@fit$fitted.values)
}
setMethod("fitted", signature(object = "uGARCHfit"), .ugarchfitted)
.ugarchfiltered = function(object)
{
return(object@filter$data - object@filter$residuals)
}
setMethod("fitted", signature(object = "uGARCHfilter"), .ugarchfiltered)
.ugarchmultifiltered = function(object)
{
sapply(object@filter, FUN = function(x) x@filter$data - residuals(x), simplify = TRUE)
}
setMethod("fitted", signature(object = "uGARCHmultifilter"), .ugarchmultifiltered)
.ugarchmultifitted = function(object)
{
sapply(object@fit, FUN = function(x) x@fit$data - residuals(x), simplify = TRUE)
}
setMethod("fitted", signature(object = "uGARCHmultifit"), .ugarchmultifitted)
#----------------------------------------------------------------------------------
# newsimpact curve method (not multiplied by unconditional sigma)
newsimpact = function(object, z = seq(-0.3, 0.3, length.out = 100))
{
UseMethod("newsimpact")
}
.newsimpact = function(object, z = seq(-0.3, 0.3, length.out = 100))
{
model = object@model$model
ans = switch(model,
sGARCH = .sgarchni(z, object),
fGARCH = .fgarchni(z, object),
gjrGARCH = .gjrgarchni(z, object),
eGARCH = .egarchni(z, object),
apARCH = .aparchni(z, object),
iGARCH = .sgarchni(z, object))
#anstGARCH = .anstgarchni(z, object))
return(ans)
}
setMethod("newsimpact", signature(object = "uGARCHfit"), .newsimpact)
setMethod("newsimpact", signature(object = "uGARCHfilter"), .newsimpact)
# the underlying news impact methods
.sgarchni = function(z, fit)
{
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
cf = coef(fit)
garchOrder = fit@model$garchOrder
omega = cf["omega"]
if(garchOrder[1]) alpha = cf["alpha1"] else alpha = 0
if(garchOrder[2]) beta = cf["beta1"] else beta = 0
lrvar = rep(uncvariance(fit), length(zz))
ans = omega + beta*lrvar + alpha*zz^2
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = as.numeric(ans), zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.fgarchni = function(z, fit)
{
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
Names = names(coef(fit))
model.pars = .fgarchModel(fit@model$submodel)$parameters
garchOrder = fit@model$garchOrder
cf = coef(fit)
omega = cf["omega"]
if(any(substr(Names, 1, 5) == "alpha")){
i = which(substr(Names, 1, 5) == "alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 4) == "beta")){
i = which(substr(Names, 1, 4) == "beta")
beta = cf[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 6) == "lambda")){
i = which(substr(Names, 1, 6) == "lambda")
lambda = cf[i]
} else{
lambda = model.pars$lambda
}
# delta
if(any(substr(Names, 1, 5) == "delta")){
i = which(substr(Names, 1, 5) == "delta")
delta = cf[i]
} else{
delta = model.pars$delta
}
# gamma1
if(any(substr(Names, 1, 6) == "gamma1")){
i = which(substr(Names, 1, 6) == "gamma1")
gamma1 = cf[i]
} else{
if(garchOrder[1]>0) gamma1 = rep(model.pars$gamma1,garchOrder[1]) else gamma1 = 0
}
# fc
if(any(substr(Names, 1, 6) == "gamma2")){
i = which(substr(Names, 1, 6) == "gamma2")
gamma2 = cf[i]
} else{
if(garchOrder[1]>0) gamma2 = rep(model.pars$gamma2, garchOrder[1]) else gamma2 = 0
}
fk = model.pars$fk
kdelta = delta + fk*lambda
lrvar = rep(uncvariance(fit)^(1/2), length(zz))
ans = omega + alpha[1]*(lrvar^lambda)*(abs(zz/lrvar - gamma2[1]) - gamma1[1]*(zz/lrvar - gamma2[1]))^kdelta + beta[1]*(lrvar^lambda)
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans^(2/lambda), zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.egarchni = function(z, fit)
{
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
Names = names(coef(fit))
# gamma
cf = coef(fit)
omega = cf["omega"]
if(any(substr(Names, 1, 5) == "alpha")){
i = which(substr(Names, 1, 5) == "alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 4) == "beta")){
i = which(substr(Names, 1, 4) == "beta")
beta = cf[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gm = cf[i]
} else{
gm = 0
}
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = cf[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = cf[i]
} else{
shape = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = cf[i]
} else{
skew = 0
}
k = egarchKappa(dlambda, shape, skew, fit@model$distribution)
lrvar = rep(uncvariance(fit), length(zz))
sqlr = sqrt(lrvar)
ans=exp(omega + alpha[1]*zz/sqlr + gm[1]*(abs(zz/sqlr)-k) + beta[1]*log(lrvar))
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans, zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.gjrgarchni = function(z, fit)
{
Names = names(coef(fit))
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
cf = coef(fit)
omega = cf["omega"]
if(any(substr(Names, 1, 5) == "alpha")){
i = which(substr(Names, 1, 5) == "alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 4) == "beta")){
i = which(substr(Names, 1, 4) == "beta")
beta = cf[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gm = cf[i]
} else{
gm = 0
}
lrvar = rep(uncvariance(fit), length(zz))
ans = omega + alpha[1]*zz^2 + gm[1]*(zz^2)*(zz<0) + beta[1]*lrvar
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans, zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.aparchni = function(z, fit)
{
Names = names(coef(fit))
if(is.null(z)){
mz = min(fit@fit$residuals)
if(abs(mz) <1)
zz = seq(round(mz, 2) , round(abs(mz), 2), length.out = 101)
else
zz = seq(round(mz, 0) , round(abs(mz), 0), length.out = 101)
} else{
zz = z
}
cf = coef(fit)
omega = cf["omega"]
if(any(substr(Names, 1, 5) == "alpha")){
i = which(substr(Names, 1, 5) == "alpha")
alpha = cf[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 4) == "beta")){
i = which(substr(Names, 1, 4) == "beta")
beta = cf[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gm = coef(fit)[i]
} else{
gm=0
}
if(any(substr(Names, 1, 5)=="delta")){
i = which(substr(Names, 1, 5)=="delta")
delta = coef(fit)[i]
} else{
delta = 0
}
lrvar = rep(uncvariance(fit)^(1/2), length(zz))
ans = omega + alpha[1]*(abs(zz) - gm[1]*(zz))^delta + beta[1]*(lrvar^delta)
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans^(2/delta), zx = zz, yexpr = yexpr, xexpr = xexpr))
}
.anstgarchni = function(z, fit)
{
Names = names(coef(fit))
if(is.null(z)){
minz = min(fit@fit$residuals)
zz = seq(minz, abs(minz), length.out = 100)
} else{
zz = z
}
distribution = fit@model$distribution
cf = coef(fit)
omega1 = cf["omega1"]
omega2 = cf["omega2"]
if(any(substr(Names, 1, 6) == "alpha1")){
i = which(substr(Names, 1, 6) == "alpha1")
alpha1 = cf[i]
} else{
alpha1 = 0
}
if(any(substr(Names, 1, 6) == "alpha2")){
i = which(substr(Names, 1, 6) == "alpha2")
alpha2 = cf[i]
} else{
alpha2 = 0
}
if(any(substr(Names, 1, 5) == "beta1")){
i = which(substr(Names, 1, 5) == "beta1")
beta1 = cf[i]
} else{
beta1 = 0
}
if(any(substr(Names, 1, 5) == "beta2")){
i = which(substr(Names, 1, 5) == "beta2")
beta2 = cf[i]
} else{
beta2 = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gm = cf[i]
} else{
gm = 0
}
lrvar = rep(uncvariance(fit), length(zz))
kappa = 1/( 1 + exp( -gm * zz ) )
ans = (1-kappa) * (omega1 + alpha1*zz^2 + beta1*lrvar) + kappa * (omega2 + alpha2*zz^2 + beta2*lrvar)
yexpr = expression(sigma[t]^2)
xexpr = expression(epsilon[t-1])
return(list(zy = ans, zx = zz, yexpr = yexpr, xexpr = xexpr))
}
#----------------------------------------------------------------------------------
# Half-Life Method for the various garch models
# ln(0.5)/log(persistence)
halflife = function(object, pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
UseMethod("halflife")
}
.halflife1<-function(object)
{
ps = persistence(object)
hlf = log(0.5)/log(ps)
names(hlf) = "Half-Life"
return(hlf)
}
.halflife2 = function(pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
ps = persistence(pars = pars, distribution = distribution, model = model, submodel = submodel)
hlf = log(0.5)/log(ps)
names(hlf) = "Half-Life"
return(hlf)
}
setMethod("halflife",signature(object = "uGARCHfilter", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .halflife1)
setMethod("halflife",signature(object = "uGARCHfit", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .halflife1)
setMethod("halflife",signature(object = "missing", pars = "numeric",
distribution = "character", model = "character", submodel = "ANY"),
definition = .halflife2)
#----------------------------------------------------------------------------------
# Persistence
persistence = function(object, pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
UseMethod("persistence")
}
# filter method
.filterpersistence = function(object)
{
object@filter$persistence
}
setMethod("persistence", signature(object = "uGARCHfilter", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .filterpersistence)
# fit method
.persistence1 = function(object)
{
pars = coef(object)
distribution = object@model$distribution
model = object@model$model
submodel = object@model$submodel
ans = switch(model,
sGARCH = .persistsgarch(pars,distribution),
eGARCH = .persistegarch(pars,distribution),
gjrGARCH = .persistgjrgarch(pars,distribution),
apARCH = .persistaparch(pars,distribution),
fGARCH = .persistfgarch(pars,distribution,submodel),
iGARCH = 1)
#anstGARCH = .persistanstgarch(pars, distribution))
names(ans) = "persistence"
return(ans)
}
.persistence2 = function(pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
ans = switch(model,
sGARCH = .persistsgarch(pars,distribution),
eGARCH = .persistegarch(pars,distribution),
gjrGARCH = .persistgjrgarch(pars,distribution),
apARCH = .persistaparch(pars,distribution),
fGARCH = .persistfgarch(pars,distribution,submodel),
iGARCH = 1)
#anstGARCH = .persistanstgarch(pars, distribution))
names(ans) = "persistence"
return(ans)
}
setMethod("persistence",signature(object = "uGARCHfit", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .persistence1)
setMethod("persistence",signature(object = "missing", pars = "numeric",
distribution = "character", model = "character", submodel = "ANY"),
definition = .persistence2)
.persistsgarch = function(pars, distribution = "norm"){
Names = names(pars)
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha=pars[i]
} else{
alpha=0
}
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega = pars[i]
} else{
omega = 0
}
if(any(substr(Names, 1, 4)=="beta")){
i = which(substr(Names, 1, 4)=="beta")
beta = pars[i]
} else{
beta = 0
}
ps = sum(alpha) + sum(beta)
return(ps)
}
.persistgjrgarch = function(pars, distribution = "norm"){
Names = names(pars)
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha = pars[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gamma = pars[i]
} else{
gamma = 0
}
if(any(substr(Names, 1, 5)=="omega")){
i = which(substr(Names, 1, 5)=="omega")
omega = pars[i]
} else{
omega = 0
}
if(any(substr(Names, 1, 4)=="beta")){
i = which(substr(Names, 1, 4)=="beta")
beta = pars[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = pars[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = pars[i]
} else{
skew = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = pars[i]
} else{
shape = 0
}
ps = sum(beta)+ sum(alpha)+sum(apply(as.data.frame(gamma),1,FUN=function(x)
x*pneg(dlambda, shape, skew, distribution)))
return(ps)
}
.persistegarch = function(pars, distribution = "norm"){
Names=names(pars)
if(any(substr(Names, 1, 4)=="beta")){
i=which(substr(Names, 1, 4)=="beta")
beta=pars[i]
} else{
beta=0
}
ps=sum(beta)
return(ps)
}
.persistaparch = function(pars, distribution = "norm"){
Names = names(pars)
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha = pars[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 5)=="gamma")){
i = which(substr(Names, 1, 5)=="gamma")
gamma = pars[i]
} else{
gamma = rep(0, length(alpha))
}
if(any(substr(Names, 1, 5)=="delta")){
i = which(substr(Names, 1, 5)=="delta")
delta = pars[i]
} else{
delta= 2
}
if(any(substr(Names, 1, 4)=="beta")){
i = which(substr(Names, 1, 4)=="beta")
beta = pars[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = pars[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = pars[i]
} else{
skew = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = pars[i]
} else{
shape = 0
}
ps = sum(beta) + sum(apply(cbind(gamma,alpha), 1, FUN=function(x)
x[2]*aparchKappa(x[1], delta, dlambda, shape, skew,distribution)))
return(ps)
}
.persistfgarch = function(pars, distribution = "norm", submodel){
fm = .fgarchModel(submodel)
Names = names(pars)
if(any(substr(Names, 1, 5)=="alpha")){
i = which(substr(Names, 1, 5)=="alpha")
alpha = pars[i]
} else{
alpha = 0
}
if(any(substr(Names, 1, 6)=="lambda")){
i = which(substr(Names, 1, 6)=="lambda")
lambda = pars[i]
} else{
lambda = fm$parameters$lambda
}
if(any(substr(Names, 1, 5)=="delta")){
i = which(substr(Names, 1, 5)=="delta")
delta = pars[i]
} else{
delta = fm$parameters$delta
}
if(any(substr(Names, 1, 6)=="gamma1")){
i = which(substr(Names, 1, 6)=="gamma1")
gamma1 = pars[i]
} else{
gamma1 = rep(0, length(alpha))
}
if(any(substr(Names, 1, 6)=="gamma2")){
i = which(substr(Names, 1, 6)=="gamma2")
gamma2 = pars[i]
} else{
gamma2 = rep(0, length(alpha))
}
if(any(substr(Names, 1, 5)=="omega")){
i = which(substr(Names, 1, 5)=="omega")
omega = pars[i]
} else{
omega = 0
}
if(any(substr(Names, 1, 4)=="beta")){
i = which(substr(Names, 1, 4)=="beta")
beta = pars[i]
} else{
beta = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = pars[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = pars[i]
} else{
skew = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = pars[i]
} else{
shape = 0
}
fk = fm$parameters$fk
ps = sum(beta) + sum(apply(cbind(alpha, gamma1, gamma2), 1, FUN=function(x)
x[1]*fgarchKappa(lambda, delta, x[2], x[3], fk, dlambda, shape, skew, distribution)))
return(ps)
}
.persistanstgarch = function(pars, distribution = "norm", submodel){
Names = names(pars)
if(any(substr(Names, 1, 6)=="alpha1")){
i = which(substr(Names, 1, 6)=="alpha1")
alpha1 = pars[i]
} else{
alpha1 = 0
}
if(any(substr(Names, 1, 6)=="alpha2")){
i = which(substr(Names, 1, 6)=="alpha2")
alpha2 = pars[i]
} else{
alpha2 = 0
}
if(any(substr(Names, 1, 5)=="beta1")){
i = which(substr(Names, 1, 5)=="beta1")
beta1 = pars[i]
} else{
beta1 = 0
}
if(any(substr(Names, 1, 5)=="beta2")){
i = which(substr(Names, 1, 5)=="beta2")
beta2 = pars[i]
} else{
beta2 = 0
}
ps = 0.5 * (sum(alpha1) + sum(alpha2) + sum(beta1) + sum(beta2))
return(ps)
}
#----------------------------------------------------------------------------------
# Unconditional Variance
uncvariance = function(object, pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
UseMethod("uncvariance")
}
.unconditional1 = function(object)
{
pars = coef(object)
distribution = object@model$distribution
model = object@model$model
submodel = object@model$submodel
ans=switch(model,
sGARCH = .uncsgarch(pars, distribution),
eGARCH = .uncegarch(pars, distribution),
gjrGARCH = .uncgjrgarch(pars, distribution),
apARCH = .uncaparch(pars, distribution),
fGARCH = .uncfgarch(pars, distribution, submodel),
iGARCH = Inf)
#anstGARCH = .uncanstgarch(pars, distribution))
names(ans) = "unconditional"
return(ans)
}
.unconditional2 = function(object)
{
if(is.null(object@optimization.model$fixed.pars))
stop("\nuncvariance with spec required fixed.pars list\n", call. = FALSE)
# no other checks for now.
pars = unlist(object@optimization.model$fixed.pars)
distribution = object@distribution.model$distribution
model = object@variance.model$model
submodel = object@variance.model$submodel
ans = switch(model,
sGARCH = .uncsgarch(pars,distribution),
eGARCH = .uncegarch(pars,distribution),
gjrGARCH = .uncgjrgarch(pars,distribution),
apARCH = .uncaparch(pars,distribution),
fGARCH = .uncfgarch(pars,distribution,submodel),
iGARCH = Inf)
#anstGARCH = .uncanstgarch(pars, distribution))
names(ans) = "unconditional"
return(ans)
}
.unconditional3 = function(pars, distribution = "norm", model = "sGARCH",
submodel = "GARCH")
{
ans = switch(model,
sGARCH = .uncsgarch(pars,distribution),
eGARCH = .uncegarch(pars,distribution),
gjrGARCH = .uncgjrgarch(pars,distribution),
apARCH = .uncaparch(pars,distribution),
fGARCH = .uncfgarch(pars,distribution,submodel),
iGARCH = Inf)
#anstGARCH = .uncanstgarch(pars, distribution))
names(ans) = "unconditional"
return(ans)
}
setMethod("uncvariance", signature(object = "uGARCHfit", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .unconditional1)
setMethod("uncvariance", signature(object = "missing", pars = "numeric",
distribution = "character", model = "character", submodel = "ANY"),
definition = .unconditional3)
setMethod("uncvariance", signature(object = "uGARCHspec", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .unconditional2)
setMethod("uncvariance", signature(object = "uGARCHfilter", pars = "missing",
distribution = "missing", model = "missing", submodel = "missing"),
definition = .unconditional1)
.uncsgarch = function(pars,distribution="norm"){
Names=names(pars)
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
ps=persistence(pars=pars,distribution=distribution,model="sGARCH")
uvol=omega/(1-ps)
return(uvol)
}
.uncgjrgarch<-function(pars,distribution="norm"){
Names=names(pars)
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
ps=persistence(pars=pars,distribution=distribution,model="gjrGARCH")
uvol=omega/(1-ps)
return(uvol)
}
.uncegarch<-function(pars,distribution="norm"){
Names=names(pars)
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
if(any(substr(Names, 1, 4)=="beta")){
i=which(substr(Names, 1, 4)=="beta")
beta=pars[i]
} else{
beta=0
}
uvol=exp(omega/(1-sum(beta)))
}
.uncaparch<-function(pars,distribution="norm"){
Names=names(pars)
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
if(any(substr(Names, 1, 5)=="delta")){
i=which(substr(Names, 1, 5)=="delta")
delta=pars[i]
} else{
delta=2
}
ps=persistence(pars=pars,distribution=distribution,model="apARCH")
uvol=(omega/(1-ps))^(2/delta)
return(uvol)
}
.uncfgarch<-function(pars, distribution="norm", submodel){
Names=names(pars)
fpars = .fgarchModel(submodel)$parameters
if(any(substr(Names, 1, 6)=="lambda")){
i=which(substr(Names, 1, 6)=="lambda")
lambda=pars[i]
} else{
lambda = fpars$lambda
}
if(any(substr(Names, 1, 5)=="omega")){
i=which(substr(Names, 1, 5)=="omega")
omega=pars[i]
} else{
omega=0
}
ps=persistence(pars = pars, distribution=distribution,model="fGARCH",submodel=submodel)
uvol=(omega/(1-ps))^(2/lambda)
return(uvol)
}
.uncanstgarch = function(pars, distribution = "norm"){
Names = names(pars)
if(any(substr(Names, 1, 6)=="omega1")){
i = which(substr(Names, 1, 6)=="omega1")
omega1 = pars[i]
} else{
omega1 = 0
}
if(any(substr(Names, 1, 6)=="omega2")){
i = which(substr(Names, 1, 6)=="omega2")
omega2 = pars[i]
} else{
omega2 = 0
}
if(any(substr(Names, 1, 7)=="dlambda")){
i = which(substr(Names, 1, 7)=="dlambda")
dlambda = pars[i]
} else{
dlambda = 0
}
if(any(substr(Names, 1, 4)=="skew")){
i = which(substr(Names, 1, 4)=="skew")
skew = pars[i]
} else{
skew = 0
}
if(any(substr(Names, 1, 5)=="shape")){
i = which(substr(Names, 1, 5)=="shape")
shape = pars[i]
} else{
shape = 0
}
kappa = 0.5
ps = persistence( pars = pars, distribution = distribution, model = "anstGARCH")
uvol = (0.5 * omega1 + 0.5 * omega2)/(1 - ps)
return(uvol)
}
# Unconditional Mean
uncmean = function(object)
{
UseMethod("uncmean")
}
.unconditionalmean = function(object)
{
include.mean = object@model$include.mean
garchInMean = object@model$garchInMean
im = object@model$inMeanType
if(is(object, "uGARCHfilter")){
h = object@filter$sigma
data = object@filter$data
} else{
h = object@fit$sigma
data = object@fit$data
}
N = length(h)
arfima = object@model$arfima
include.mex = object@model$include.mex
pars = coef(object)
if(include.mex){
mxn = object@model$mxn
mxreg = coef(object)[paste("mxreg", 1:mxn, sep="")]
if(is(object, "uGARCHfilter")){
mexdata = as.matrix(object@model$mexdata[1:N, 1:mxn])
} else{
mexdata = as.matrix(object@model$mexdata[1:N, 1:mxn])
}
meanmex = apply(mexdata, 2, "mean")
umeanmex = sum(mxreg*meanmex)
} else{
umeanmex = 0
}
if(garchInMean){
if(im == 2) mh = uncvariance(object) else mh = uncvariance(object)^(1/2)
umeangim = mh * pars["inmean"]
} else{
umeangim = 0
}
if(include.mean) mu = coef(object)["mu"] else mu=0
#if(arfima){
# umean = mu + umeangim + umeanmex
#} else{
# armaOrder = object@model$armaOrder
# if(armaOrder[1] == 0) {
# umean = mu + umeangim + umeanmex
# } else{
# ar = sum(coef(object)[paste("ar", 1:armaOrder[1], sep="")])
# umean = (mu + umeangim + umeanmex)/(1 - ar)
# }
#}
umean = (mu + umeangim + umeanmex)
return(umean)
}
.unconditionalmean2 = function(object)
{
if(is.null(object@optimization.model$fixed.pars))
stop("uncmean with uGARCHspec requires fixed.pars list", call. = FALSE)
# should write a routine to do parameter checking subject to model
include.mean = object@mean.model$include.mean
garchInMean = object@mean.model$garchInMean
im = object@mean.model$inMeanType
h = 0
data = 0
arfima = object@mean.model$arfima
include.mex = object@mean.model$include.mex
pars = unlist(object@optimization.model$fixed.pars)
if(include.mex){
mxn = object@mean.model$mxn
mxreg = pars[paste("mxreg", 1:mxn, sep="")]
mexdata = matrix(object@mean.model$mexdata, ncol = mxn)
meanmex = apply(mexdata, 2, "mean")
umeanmex = sum(mxreg*meanmex)
} else{
umeanmex = 0
}
umeangim = 0
if(include.mean) mu = pars["mu"] else mu=0
#if(arfima){
# umean = mu + umeangim + umeanmex
#} else{
# armaOrder = object@model$armaOrder
# if(armaOrder[1] == 0) {
# umean = mu + umeangim + umeanmex
# } else{
# ar = sum(coef(object)[paste("ar", 1:armaOrder[1], sep="")])
# umean = (mu + umeangim + umeanmex)/(1 - ar)
# }
#}
umean = (mu + umeangim + umeanmex)
return(umean)
}
setMethod("uncmean", signature(object = "uGARCHfit"), definition = .unconditionalmean)
setMethod("uncmean", signature(object = "uGARCHfilter"), definition = .unconditionalmean)
setMethod("uncmean", signature(object = "uGARCHspec"), definition = .unconditionalmean2)
#----------------------------------------------------------------------------------
# The mult- methods
#----------------------------------------------------------------------------------
multispec = function( speclist )
{
UseMethod("multispec")
}
setMethod("multispec", signature(speclist = "vector"), definition = .multispecall)
multifit = function(multispec, data, out.sample = 0, solver = "solnp", solver.control = list(), fit.control = list(stationarity = 1,
fixed.se = 0, scale = 0), parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
UseMethod("multifit")
}
setMethod("multifit", signature(multispec = "uGARCHmultispec"), definition = .multifitgarch)
multifilter = function(multifitORspec, data = NULL, out.sample = 0, n.old = NULL,
parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
UseMethod("multifilter")
}
setMethod("multifilter", signature(multifitORspec = "uGARCHmultifit"), definition = .multifiltergarch1)
setMethod("multifilter", signature(multifitORspec = "uGARCHmultispec"), definition = .multifiltergarch2)
multiforecast = function(multifitORspec, data = NULL, n.ahead = 1, n.roll = 0, out.sample = 0,
external.forecasts = list(mregfor = NULL, vregfor = NULL),
parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
UseMethod("multiforecast")
}
setMethod("multiforecast", signature(multifitORspec = "uGARCHmultifit"), definition = .multiforecastgarch1)
setMethod("multiforecast", signature(multifitORspec = "uGARCHmultispec"), definition = .multiforecastgarch2)
#----------------------------------------------------------------------------------
Try the rgarch package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.