rgarch
Flexible GARCH modelling in R

Package index
Search the rgarch package
Vignettes
Functions
564
Source code
60
Man pages
114
Home
/
R-Forge
/
rgarch
/
R/rdcc-methods.R

R/rdcc-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.
##
#################################################################################

#----------------------------------------------------------------------------------
# spec method
#----------------------------------------------------------------------------------
dccspec = function(uspec, VAR = FALSE, VAR.opt = list(robust = FALSE, lag = 1, lag.max = NULL, 
				lag.criterion = c("AIC", "HQ", "SC", "FPE"), external.regressors = NULL, 
				robust.control = list("gamma" = 0.25, "delta" = 0.01, "nc" = 10, "ns" = 500)),
		dccOrder = c(1,1), distribution = c("mvnorm", "mvt", "mvlaplace"),
		start.pars = list(), fixed.pars = list())
{
	UseMethod("dccspec")
}

setMethod(f = "dccspec", definition = .dccspec)

#----------------------------------------------------------------------------------
# fit method
#----------------------------------------------------------------------------------

dccfit = function(spec, data, out.sample = 0, solver = "solnp", solver.control = list(), 
		fit.control = list(eval.se = TRUE, stationarity = TRUE, scale = TRUE), 
		parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), 
		fit = NULL, VAR.fit = NULL, ...)
{
	UseMethod("dccfit")
}


.dccfit = function(spec, data, out.sample = 0, solver = "solnp", solver.control = list(), 
		fit.control = list(eval.se = TRUE, stationarity = TRUE, scale = TRUE), 
		parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), 
		fit = NULL, VAR.fit = NULL, ...)
{
	ans = switch(spec@mspec$distribution,
			mvnorm = dccfit.norm(spec = spec, data = data, out.sample = out.sample, 
					solver = solver, solver.control = solver.control, fit.control = fit.control, 
					parallel = parallel, parallel.control = parallel.control,
					fit = fit, VAR.fit = VAR.fit, ...),
			mvt = dccfit.student(spec = spec, data = data, out.sample = out.sample, 
					solver = solver, solver.control = solver.control, fit.control = fit.control, 
					parallel = parallel, parallel.control = parallel.control,
					fit = fit, VAR.fit = VAR.fit, ...),
			mvlaplace = dccfit.laplace(spec = spec, data = data, out.sample = out.sample, 
					solver = solver, solver.control = solver.control, fit.control = fit.control, 
					parallel = parallel, parallel.control = parallel.control,
					fit = fit, VAR.fit = VAR.fit, ...))
	return( ans )
}

setMethod("dccfit", signature(spec = "DCCspec"), .dccfit)

#----------------------------------------------------------------------------------
# filter method
#----------------------------------------------------------------------------------
dccfilter = function(spec, data, out.sample = 0, filter.control = list(n.old = NULL), 
		parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), VAR.fit = NULL, ...)
{
	UseMethod("dccfilter")
}


.dccfilter = function(spec, data, out.sample = 0, filter.control = list(n.old = NULL), 
		parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), VAR.fit = NULL, ...)
{
	ans = switch(spec@mspec$distribution,
			mvnorm = dccfilter.norm(spec = spec, data = data, out.sample = out.sample, 
					filter.control = filter.control, parallel = parallel, parallel.control = parallel.control, 
					VAR.fit = VAR.fit, ...),
			mvt = dccfilter.student(spec = spec, data = data, out.sample = out.sample, 
					filter.control = filter.control, parallel = parallel, parallel.control = parallel.control, 
					VAR.fit = VAR.fit, ...),
			mvlaplace = dccfilter.laplace(spec = spec, data = data, out.sample = out.sample, 
					filter.control = filter.control, parallel = parallel, parallel.control = parallel.control, 
					VAR.fit = VAR.fit, ...))
	return( ans )
}

setMethod("dccfilter", signature(spec = "DCCspec"), .dccfilter)

#----------------------------------------------------------------------------------
# forecast method
#----------------------------------------------------------------------------------
dccforecast = function(fit, n.ahead = 1, n.roll = 0, external.forecasts = list(mregfor = NULL, vregfor = NULL), 
		parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
	UseMethod("dccforecast")
}



setMethod("dccforecast", signature(fit = "DCCfit"), .dccforecast)

#----------------------------------------------------------------------------------
# roll method
#----------------------------------------------------------------------------------

dccroll = function(spec, data, n.ahead = 1, forecast.length = 50, refit.every = 25, 
		refit.window = c("recursive", "moving"), solver = "solnp", 
		fit.control = list(eval.se = TRUE), parallel = FALSE, 
		parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), 
		solver.control = list(), save.fit = FALSE, save.wdir = NULL, trace = FALSE, ...)
{
	UseMethod("dccroll")
}


setMethod("dccroll", signature(spec = "DCCspec"), .rolldcc)


#----------------------------------------------------------------------------------
# simulation method
#----------------------------------------------------------------------------------

dccsim = function(fitORspec, n.sim = 1000, n.start = 0, m.sim = 1, startMethod = c("unconditional", "sample"), 
		presigma = NULL, preresiduals = NULL, prereturns = NULL, preR = NULL, preH = NULL, rseed = NULL, mexsimdata = NULL, 
		vexsimdata = NULL, parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), 
		VAR.fit = NULL, ...)
{
	UseMethod("dccsim")
}

.dccsim.fit =  function(fitORspec, n.sim = 1000, n.start = 0, m.sim = 1, startMethod = c("unconditional", "sample"), 
		presigma = NULL, preresiduals = NULL, prereturns = NULL, preR = NULL, preH = NULL, rseed = NULL, mexsimdata = NULL, 
		vexsimdata = NULL, parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), 
		VAR.fit = NULL, ...)
{
	ans = switch(fitORspec@mfit$model$distribution,
		mvnorm = dccsim1.norm(fitORspec, n.sim = n.sim, n.start = n.start, m.sim = m.sim, 
				startMethod = startMethod[1], presigma = presigma, preresiduals = preresiduals, 
				prereturns = prereturns, preR = preR, preH = preH, rseed = rseed, mexsimdata = mexsimdata, 
				vexsimdata = vexsimdata, parallel = parallel, parallel.control = parallel.control, VAR.fit = VAR.fit, ...),
		mvt = dccsim1.student(fitORspec, n.sim = n.sim, n.start = n.start, m.sim = m.sim, 
				startMethod = startMethod[1], presigma = presigma, preresiduals = preresiduals, 
				prereturns = prereturns, preR = preR, preH = preH, rseed = rseed, mexsimdata = mexsimdata, 
				vexsimdata = vexsimdata, parallel = parallel, parallel.control = parallel.control, VAR.fit = VAR.fit, ...),
		mvlaplace = dccsim1.laplace(fitORspec, n.sim = n.sim, n.start = n.start, m.sim = m.sim, 
				startMethod = startMethod[1], presigma = presigma, preresiduals = preresiduals, 
				prereturns = prereturns, preR = preR, preH = preH, rseed = rseed, mexsimdata = mexsimdata, 
				vexsimdata = vexsimdata, parallel = parallel, parallel.control = parallel.control, VAR.fit = VAR.fit, ...))

	return( ans )

}

setMethod("dccsim", signature(fitORspec = "DCCfit"), .dccsim.fit)

.dccsim.spec =  function(fitORspec, n.sim = 1000, n.start = 0, m.sim = 1, startMethod = c("unconditional", "sample"), 
		presigma = NA, preresiduals = NA, prereturns = NA, preR = NA, preH = NA, rseed = NA,
		mexsimdata = NULL, vexsimdata = NULL, parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), 
		VAR.fit = NULL, ...)
{
	ans = switch(fitORspec@mspec$distribution,
			mvnorm 	= dccsim2.norm(fitORspec, n.sim = n.sim, n.start = n.start, m.sim = m.sim, startMethod = startMethod, 
					presigma = presigma, preresiduals = preresiduals, 
					prereturns = prereturns, preR = preR, preH = preH, 
					rseed = rseed, mexsimdata = mexsimdata, vexsimdata = vexsimdata, 
					parallel = parallel, parallel.control = parallel.control, VAR.fit = VAR.fit, ...),
			mvt   	= dccsim2.student(fitORspec, n.sim = n.sim, n.start = n.start, m.sim = m.sim, startMethod = startMethod, 
					presigma = presigma, preresiduals = preresiduals, 
					prereturns = prereturns, preR = preR, preH = preH, 
					rseed = rseed, mexsimdata = mexsimdata, vexsimdata = vexsimdata, 
					parallel = parallel, parallel.control = parallel.control, VAR.fit = VAR.fit, ...),
		  mvlaplace = dccsim2.laplace(fitORspec, n.sim = n.sim, n.start = n.start, m.sim = m.sim, startMethod = startMethod, 
					presigma = presigma, preresiduals = preresiduals, 
					prereturns = prereturns, preR = preR, preH = preH, 
					rseed = rseed, mexsimdata = mexsimdata, vexsimdata = vexsimdata, 
					parallel = parallel, parallel.control = parallel.control, VAR.fit = VAR.fit, ...))
	
	return( ans )
	
}

setMethod("dccsim", signature(fitORspec = "DCCspec"), .dccsim.spec)
#----------------------------------------------------------------------------------
# extraction methods
#----------------------------------------------------------------------------------
.fitted.dccfit = function(object)
{
	if(!is.null(object@mfit$model$vrmodel)){
		ans = object@mfit$model$vrmodel$xfitted
	} else{
		ans = sapply(object@ufit@fit, FUN = function(x) x@fit$fitted)
	}
	
	return( ans )
}

setMethod("fitted", signature(object = "DCCfit"), .fitted.dccfit)

.fitted.dccfilter = function(object)
{
	if(!is.null(object@mfilter$model$vrmodel)){
		ans = object@mfilter$model$vrmodel$xfitted	
	} else{
		ans = sapply(object@ufilter@filter, FUN = function(x) fitted(x))
	}
	return( ans )
}

setMethod("fitted", signature(object = "DCCfilter"), .fitted.dccfilter)


.fitted.dccforecast = function(object)
{
	if(!is.null(object@mforecast$VARf)){
		ans = object@mforecast$VARf
	} else{
		ufor = object@uforecast
		ans = sapply(ufor@forecast, FUN = function(x) as.matrix(sapply(x@forecast$forecasts, FUN = function(y) y[, 'series'])))
	}
	return( ans )
}

setMethod("fitted", signature(object = "DCCforecast"), .fitted.dccforecast)

.fitted.dccsim = function(object, sim = 1)
{
	n = length(object@msim$simR)
	m.sim = as.integer(sim)
	if( m.sim > n | m.sim < 1 ) stop("\rgarch-->error: fitted (simulation) sim index out of bounds!")
	ans = object@msim$simX[[m.sim]]
	return( ans )
}

setMethod("fitted", signature(object = "DCCsim"), .fitted.dccsim)

.fitted.dccroll = function(object, roll = 1)
{
	n = length(object@forecast)
	m.roll = as.integer(roll)
	if( m.roll > n | m.roll < 1 ) stop("\rgarch-->error: fitted roll index out of bounds!")
	ans = fitted( object@forecast[[m.roll]] )
	return( ans )
}

setMethod("fitted", signature(object = "DCCroll"), .fitted.dccroll)

#----------------------------------------------------------------------------------
.rcor.dccfit = function(object, type = "R")
{
	if( type == "R"){
		tmp = object@mfit$R
		N = length(tmp)
		m = dim(tmp[[1]])[2]
		R = array(NA, dim = c(m, m, N))
		R[1:m,1:m, ] = sapply(tmp, FUN = function(x) x)
		return( R )
	} else{
		tmp = object@mfit$Q
		N = length(tmp)
		m = dim(tmp[[1]])[2]
		Q = array(NA, dim = c(m, m, N))
		Q[1:m,1:m, ] = sapply(tmp, FUN = function(x) x)
		return( Q )
	}
}

setMethod("rcor", signature(object = "DCCfit"), .rcor.dccfit)

.rcor.dccfilter = function(object, type = "R")
{
	if( type == "R"){
		tmp = object@mfilter$R
		N = length(tmp)
		m = dim(tmp[[1]])[2]
		R = array(NA, dim = c(m, m, N))
		R[1:m,1:m, ] = sapply(tmp, FUN = function(x) x)
		return( R )
	} else{
		tmp = object@mfilter$Q
		N = length(tmp)
		m = dim(tmp[[1]])[2]
		Q = array(NA, dim = c(m, m, N))
		Q[1:m,1:m, ] = sapply(tmp, FUN = function(x) x)
		return( Q )
	}
}

setMethod("rcor", signature(object = "DCCfilter"), .rcor.dccfilter)

.rcor.dccforecast = function(object, type = "R")
{
	if( type == "R"){
		tmp = object@mforecast$R
		return( tmp )
	} else{
		tmp = object@mforecast$Q
		return( tmp )
	}
}

setMethod("rcor", signature(object = "DCCforecast"), .rcor.dccforecast)

.rcor.dccsim = function(object, type = "R", sim = 1)
{
	n = length(object@msim$simR)
	m.sim = as.integer(sim)
	if( m.sim > n | m.sim < 1 ) stop("\rgarch-->error: rcor sim index out of bounds!")
	if( type == "R"){
		tmp = object@msim$simR[[m.sim]]
		return( tmp )
	} else{
		tmp = object@msim$simQ[[m.sim]]
		return( tmp )
	}
}

setMethod("rcor", signature(object = "DCCsim"), .rcor.dccsim)


.rcor.dccroll = function(object, type = "R", roll = 1)
{
	n = length(object@forecast)
	m.roll = as.integer(roll)
	if( m.roll > n | m.roll < 1 ) stop("\rgarch-->error: rcor roll index out of bounds!")
	tmp = rcor( object@forecast[[m.roll]], type = type)
	return( tmp )
}

setMethod("rcor", signature(object = "DCCroll"), .rcor.dccroll)
#----------------------------------------------------------------------------------

.rcov.dccfit = function(object)
{
	H = object@mfit$H
	return( H )
}

setMethod("rcov", signature(object = "DCCfit"), .rcov.dccfit)

.rcov.dccfilter = function(object)
{
	H = object@mfilter$H
	return( H )
}

setMethod("rcov", signature(object = "DCCfilter"), .rcov.dccfilter)

.rcov.dccforecast = function(object)
{
	H = object@mforecast$H
	return( H )
}

setMethod("rcov", signature(object = "DCCforecast"), .rcov.dccforecast)


.rcov.dccsim = function(object, sim = 1)
{
	n = length(object@msim$simH)
	m.sim = as.integer(sim)
	if( m.sim > n | m.sim < 1 ) stop("\rgarch-->error: rcov sim index out of bounds!")
	tmp = object@msim$simH[[m.sim]]
	return( tmp )
}

setMethod("rcov", signature(object = "DCCsim"), .rcov.dccsim)

.rcov.dccroll = function(object, roll = 1)
{
	n = length(object@forecast)
	m.roll = as.integer(roll)
	if( m.roll > n | m.roll < 1 ) stop("\rgarch-->error: rcov roll index out of bounds!")
	tmp = rcov( object@forecast[[m.roll]] )
	return( tmp )
}

setMethod("rcov", signature(object = "DCCroll"), .rcov.dccroll)
#----------------------------------------------------------------------------------
.sigma.dccfit = function(object)
{
	sig = as.matrix(sapply(object@ufit@fit, FUN = function(x) x@fit$sigma) )
	return( sig )
}

setMethod("sigma", signature(object = "DCCfit"), .sigma.dccfit)


.sigma.dccfilter = function(object)
{
	sig = as.matrix(sapply(object@ufilter@filter, FUN = function(x) x@filter$sigma) )
	return( sig )
}

setMethod("sigma", signature(object = "DCCfilter"), .sigma.dccfilter)

.sigma.dccforecast = function(object)
{
	ufor = object@uforecast
	sig = sapply(ufor@forecast, FUN = function(x) as.matrix(sapply(x@forecast$forecasts, FUN = function(y) y[, 'sigma'])))
	return( sig )
}

setMethod("sigma", signature(object = "DCCforecast"), .sigma.dccforecast)

.sigma.dccsim = function(object, sim = 1)
{
	H = rcov(object, m.sim = sim)
	m = dim(H)[1]
	n = dim(H)[3]
	sig = sapply(1:m, FUN = function(i) H[i,i, ])
	return( sig )
}

setMethod("sigma", signature(object = "DCCsim"), .sigma.dccsim)

.sigma.dccroll = function(object, roll = 1)
{
	n = length(object@forecast)
	m.roll = as.integer(roll)
	if( m.roll > n | m.roll < 1 ) stop("\rgarch-->error: rcor roll index out of bounds!")
	H = rcov(object, roll = roll)
	n = length(H)
	m = dim(H[[1]])[1]
	sig = t( sapply( 1:n, FUN = function(x) sapply(1:m, FUN = function(i) H[[x]][i,i, ]) ) )
	colnames(sig) = object@spec$asset.names
	return( sig )
}

setMethod("sigma", signature(object = "DCCroll"), .sigma.dccroll)

#----------------------------------------------------------------------------------
# skew method
rskew = function(object, ...)
{
	UseMethod("rskew")
}

.skew.dccfit = function(object)
{
	sk = NA
	if( object@mfit$model$include.skew ){
		cf = coef(object, type = "dcc")
		nx = which( substr(names(cf), 1, 4) == "skew" )
		sk = cf[nx]
	}
	return( sk )
}

setMethod("rskew", signature(object = "DCCfit"), .skew.dccfit)

.skew.dccfilter = function(object)
{
	sk = NA
	if( object@mfilter$model$include.skew ){
		cf = coef(object, type = "dcc")
		nx = which( substr(names(cf), 1, 4) == "skew" )
		sk = cf[nx]
	}
	return( sk )
}

setMethod("rskew", signature(object = "DCCfilter"), .skew.dccfilter)

.skew.dccforecast = function(object)
{
	sk = NA
	if( object@mforecast$model$include.skew ){
		sk = object@mforecast$skew
	}
	
	return( sk )
}

setMethod("rskew", signature(object = "DCCforecast"), .skew.dccforecast)

.skew.dccroll = function(object)
{
	n = length(object@forecast)
	sk = rep(NA, n)
	if( object@mforecast$model$include.skew ){
		sk = sapply(object@spec$coef, FUN = function(x) x[ which(substr(names(x), 1, 4) == "skew") ] )
		colnames(sk) = paste("roll-", 1:n, sep = "")
	}
	return( sk )
}

setMethod("rskew", signature(object = "DCCroll"), .skew.dccroll)
#----------------------------------------------------------------------------------
# shape method
rshape = function(object, ...)
{
	UseMethod("rshape")
}

.shape.dccfit = function(object)
{
	sh = NA
	if( object@mfit$model$include.shape ){
		cf = coef(object, type = "dcc")
		nx = which( substr(names(cf), 1, 5) == "shape" )
		sh = cf[nx]
	}
	return( sh )
}

setMethod("rshape", signature(object = "DCCfit"), .shape.dccfit)

.shape.dccfilter = function(object)
{
	sh = NA
	if( object@mfilter$model$include.shape ){
		cf = coef(object, type = "dcc")
		nx = which( substr(names(cf), 1, 5) == "shape" )
		sh = cf[nx]
	}
	return( sh )
}

setMethod("rshape", signature(object = "DCCfilter"), .shape.dccfilter)

.shape.dccforecast = function(object)
{
	sh = NA
	if( object@mforecast$model$include.shape ){
		sh = object@mforecast$shape
	}
	
	return( sh )
}

setMethod("rshape", signature(object = "DCCforecast"), .shape.dccforecast)


.shape.dccroll = function(object)
{
	n = length(object@forecast)
	sh = rep(NA, n)
	if( object@mforecast$model$include.shape ){
		sh = sapply(object@spec$coef, FUN = function(x) x[ which(substr(names(x), 1, 5) == "shape") ] )
		colnames(sh) = paste("roll-", 1:n, sep = "")
	}
	return( sh )
}

setMethod("rshape", signature(object = "DCCroll"), .shape.dccroll)
#----------------------------------------------------------------------------------
.coef.dccfit = function(object, type = "all")
{
	if( type == "all" ){
		cf = object@mfit$coef
	} else if( type == "dcc" ){
		cf = object@mfit$dcccoef
	} else{
		cf = object@mfit$garchcoef
	}
	return( cf )
}

setMethod("coef", signature(object = "DCCfit"), .coef.dccfit)

.coef.dccfilter = function(object, type = "all")
{
	if( type == "all" ){
		cf = object@mfilter$coef
	} else if( type == "dcc" ){
		cf = object@mfilter$dcccoef
	} else{
		cf = object@mfilter$garchcoef
	}
	return( cf )
}

setMethod("coef", signature(object = "DCCfilter"), .coef.dccfilter)

.coef.dccroll = function(object)
{
	n = length(object@forecast)
	cf = sapply( object@spec$coef, FUN = function(x) x )
	colnames(cf) = paste("roll-", 1:n, sep = "")
	return( cf )
}

setMethod("coef", signature(object = "DCCroll"), .coef.dccroll)


#----------------------------------------------------------------------------------
.likelihood.dccfit = function(object)
{
	object@mfit$llh
}

setMethod("likelihood", signature(object = "DCCfit"), .likelihood.dccfit)

.likelihood.dccfilter = function(object)
{
	object@mfilter$llh
}

setMethod("likelihood", signature(object = "DCCfilter"), .likelihood.dccfilter)

.likelihood.dccroll = function(object)
{
	n = length(object@forecast)
	cf = sapply( object@spec$likelihood, FUN = function(x) x )
	names(cf) = paste("roll-", 1:n, sep = "")
	return( cf )
}

setMethod("likelihood", signature(object = "DCCroll"), .likelihood.dccroll)
#----------------------------------------------------------------------------------
.dccinfocriteria.fit = function(object)
{
	n = length(object@ufit@fit[[1]]@fit$data)
	m = length(object@ufit@fit)
	np = length(coef(object))
	# add the unconditional correlation which was estimated:
	np = np + ( (m^2 - m)/2 )
	itest = .information.test(likelihood(object), nObs =n, nPars = np)
	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 = "DCCfit"), .dccinfocriteria.fit)

.dccinfocriteria.filter = function(object)
{
	n = length(object@ufilter@filter[[1]]@filter$data)
	m = length(object@ufilter@filter)
	np = length(coef(object))
	# add the unconditional correlation which was estimated:
	np = np + ( (m^2 - m)/2 )
	itest = .information.test(likelihood(object), nObs =n, nPars = np)
	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 = "DCCfilter"), .dccinfocriteria.filter)
#----------------------------------------------------------------------------------

dcc.symcheck = function(x, m, d = rep(1, m), tol = 1e-12)
{
	n1 = dim(x)[1]
	n2 = dim(x)[2]
	if( n1 != n2 ) stop("\nmatrix not square!")
	if( n1 != m )  stop("\nmatrix not of expected dimension!")
	if( max(abs(x - t(x))) > tol ) stop("\nmatrix is not symmetric!")
	if( !is.null( d ) ){
		if( any( diag(x) != d ) ) stop("\nwrong values on diagonal of matrix!")
	}
	return( 0 )
}

#----------------------------------------------------------------------------------
# show methods
#----------------------------------------------------------------------------------
setMethod("show",
		signature(object = "DCCspec"),
		function(object){
			m = length(object@uspec@spec)
			dccOrder = object@mspec$dccOrder[1:2]
			dccn = max(object@mspec$optimization.model$pos.matrix[,1])
			garchn = sum( sapply(object@uspec@spec, FUN = function(x) max(x@optimization.model$pos.matrix[,1]) ) )
			cat(paste("\n*------------------------------*", sep = ""))
			cat(paste("\n*       DCC GARCH Spec         *", sep = ""))
			cat(paste("\n*------------------------------*", sep = ""))			
			cat("\n\nDistribution\t\t: ", object@mspec$distribution)
			cat("\nDCC Order\t\t: ", dccOrder)
			cat("\nNo. of Parameters\t: ", dccn + garchn + ( (m^2 - m)/2 ))
			cat("\nNo. of Series\t\t: ", m)
			cat("\n\n")
			invisible(object)
		})
		
# fit show
setMethod("show",
		signature(object = "DCCfit"),
		function(object){
			m = length(object@ufit@fit)
			cat(paste("\n*---------------------------------*", sep = ""))
			cat(paste("\n*          DCC GARCH Fit          *", sep = ""))
			cat(paste("\n*---------------------------------*", sep = ""))	
			cat("\n\nDistribution\t\t: ", object@mfit$model$distribution)
			cat("\nDCC Order\t\t\t: ", object@mfit$model$dccOrder[1:2])
			cat("\nNo. of Parameters\t: ", length(object@mfit$matcoef[,1]) + ( (m^2 - m)/2 ))
			cat("\nNo. of Series\t\t: ", dim(object@mfit$origdata)[2])
			cat("\nNo. of Observations\t: ", dim(object@mfit$origdata)[1])
			cat("\nOut-of-Sample\t\t: ", object@mfit$model$out.sample)
			cat("\nLog-Likelihood\t\t: ", object@mfit$llh)
			cat("\nAv.Log-Likelihood\t: ", round(object@mfit$llh/(dim(object@mfit$origdata)[1] - object@mfit$model$out.sample), 2), "\n")
			cat("\nOptimal Parameters")
			cat(paste("\n---------------------------------------------------\n", sep = ""))
			print(round(object@mfit$matcoef,6), digits = 5)
			itest = .information.test(object@mfit$llh, nObs = dim(object@mfit$origdata)[1] - object@mfit$model$out.sample, 
					nPars = length(object@mfit$matcoef[,1]))
			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(paste("\n---------------------\n", sep = ""))
			print(itestm,digits=5)
			cat("\n")
			cat("\nElapsed time :", object@mfit$timer,"\n\n")
			invisible(object)
		})
		
# filter show
setMethod("show",
		signature(object = "DCCfilter"),
		function(object){
			m = length(object@ufilter@filter)
			cat(paste("\n*---------------------------------*", sep = ""))
			cat(paste("\n*        DCC GARCH Filter         *", sep = ""))
			cat(paste("\n*---------------------------------*", sep = ""))
			cat("\n\nDistribution\t\t: ", object@mfilter$model$distribution)
			cat("\nDCC Order\t\t: ", object@mfilter$model$dccOrder[1:2])
			cat("\nNo. of Parameters\t: ", length(object@mfilter$coef) +  ( (m^2 - m)/2 ))
			cat("\nNo. of Series\t\t: ", dim(object@mfilter$origdata)[2])
			cat("\nNo. of Observations\t: ", dim(object@mfilter$origdata)[1])
			cat("\nOut-of-Sample\t\t: ", object@mfilter$model$out.sample)
			cat("\nLog-Likelihood\t\t: ", object@mfilter$llh)
			cat("\nAv.Log-Likelihood\t: ", round(object@mfilter$llh/(dim(object@mfilter$origdata)[1] - object@mfilter$model$out.sample), 2), "\n")
			cat("\nFilter Parameters")
			cat(paste("\n---------------------------------------------------\n", sep = ""))
			parm = matrix(round(object@mfilter$coef, 6), ncol = 1)
			rownames(parm) = names(object@mfilter$coef)
			colnames(parm) = "Coef"
			print(parm, digits = 5)
			itest = .information.test(object@mfilter$llh, nObs = dim(object@mfilter$origdata)[1] - object@mfilter$model$out.sample, 
					nPars = length(object@mfilter$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(paste("\n---------------------\n", sep = ""))
			print(itestm,digits=5)
			cat("\n")
			cat("\nElapsed time :", object@mfilter$timer,"\n\n")
			invisible(object)
		})
		
# forecast show
setMethod("show",
		signature(object = "DCCforecast"),
		function(object){
			cat(paste("\n*---------------------------------*", sep = ""))
			cat(paste("\n*       DCC GARCH Forecast        *", sep = ""))
			cat(paste("\n*---------------------------------*", sep = ""))
			cat("\n\nDistribution\t:", object@mforecast$model$distribution)
			n.ahead = object@mforecast$model$n.ahead
			cat(paste("\nHorizon\t\t: ", n.ahead, sep = ""))
			cat(paste("\nRoll Steps\t: ",object@mforecast$model$n.roll, sep = ""))
			cat(paste("\n----------------------------------",sep=""))
			cat("\n\n0-roll forecast: \n")
			forc = object@mforecast$R[[1]]
			if( dim(forc)[3] > 5 ){
				cat("\nFirst 2 Correlation Forecasts\n")
				print(forc[, , 1:2], digits = 4)
				cat(paste(rep(".", dim(forc[,,1])[1], collapse = TRUE)))
				cat("\n")
				cat(paste(rep(".", dim(forc[,,1])[1], collapse = TRUE)))
				cat("\n")
				cat("\nLast 2 Correlation Forecasts\n")
				print(last(forc, 2), digits = 4)
			} else{
				print(forc, digits = 4)
			}
			cat("\n\n")
			invisible(object)
		})

setMethod("show",
		signature(object = "DCCsim"),
		function(object){
			cat(paste("\n*---------------------------------*", sep = ""))
			cat(paste("\n*      DCC GARCH Simulation       *", sep = ""))
			cat(paste("\n*---------------------------------*", sep = ""))
			cat("\n\nDistribution\t\t:", object@msim$model$distribution)
			cat(paste("\nSimulation Horizon\t: ",  object@msim$model$n.sim, sep = ""))
			cat(paste("\nBurn In\t\t\t\t: ",  object@msim$model$n.start, sep = ""))
			cat(paste("\nNo. of Simulations\t: ",object@msim$model$m.sim, sep = ""))
			cat("\n\n")
			invisible(object)
		})

setMethod("show",
		signature(object = "DCCroll"),
		function(object){
			cat(paste("\n*---------------------------------*", sep = ""))
			cat(paste("\n*         DCC GARCH Roll          *", sep = ""))
			cat(paste("\n*---------------------------------*", sep = ""))
			cat("\n\nDistribution\t\t:", object@spec$dccspec@mspec$distribution)
			cat(paste("\nSimulation Horizon\t: ",  object@spec$forecast.length, sep = ""))
			cat(paste("\nRefits\t\t\t: ",  object@spec$refit.every, sep = ""))
			cat(paste("\nWindow\t\t\t: ",  object@spec$refit.window, sep = ""))
			cat(paste("\nNo.Assets\t\t: ", length(object@spec$asset.names), sep = ""))
			cat("\n\nOptimal Parameters Across Rolls")
			cat(paste("\n---------------------------------------------------\n", sep = ""))
			print(round(coef(object), 6), digits = 5)
			cat("\n")
			invisible(object)
		})

setMethod(f = "plot", signature(x = "DCCfit", y = "missing"), .plotdccfit)
setMethod(f = "plot", signature(x = "DCCfilter", y = "missing"), .plotdccfilter)
setMethod(f = "plot", signature(x = "DCCforecast", y = "missing"), .plotdccforecast)
#setMethod(f = "plot", signature(x = "DCCsim", y = "missing"), .plotdccsim)
setMethod(f = "plot", signature(x = "DCCroll", y = "missing"), .plotdccroll)


################
# First and Last object method
first = function(x, index = 1, ...)
{
	UseMethod("first")
}

.first.array = function(x, index = 1)
{
	T = dim(x)[3]
	if( index > T | index < 1 ) stop("\nindex out of bounds")
	x[, , 1:index, drop = FALSE]
}

setMethod("first", signature(x = "array"), .first.array)

last = function(x, index = 1, ...)
{
	UseMethod("last")
}

.last.array = function(x, index = 1)
{
	T = dim(x)[3]
	if( index > T | index < 1 ) stop("\nindex out of bounds")
	x[, , (T - index + 1):T, drop = FALSE]
}

setMethod("last", signature(x = "array"), .last.array)

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

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
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.

Close