R/copula-methods.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.
##
#################################################################################
cgarchspec = 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.model = list(copula = c("mvnorm", "mvt"), method = c("Kendall", "ML"),
				time.varying = FALSE, transformation = c("parametric", "empirical", "spd")),
		start.pars = list(), fixed.pars = list())
{
	UseMethod("cgarchspec")
	
}

cgarchfit = function(spec, data, spd.control = list(lower = 0.1, upper = 0.9, type = "pwm", kernel = "epanech"), 
		fit.control = list(eval.se = TRUE, trace = TRUE, stationarity = TRUE), solver = "solnp", solver.control = list(), out.sample = 0, parallel = FALSE, 
		parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), fit = NULL, VAR.fit = NULL, ...)
{
	UseMethod("cgarchfit")
}

cgarchfilter = function(spec, data, out.sample = 0, filter.control = list(n.old = NULL), spd.control = list(lower = 0.1, upper = 0.9, type = "pwm", kernel = "epanech"), 
		parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), 
		VAR.fit = NULL, ...)
{
	UseMethod("cgarchfilter")
}


cgarchsim = function(fit, n.sim = 1000, n.start = 0, m.sim = 1, startMethod = c("unconditional", "sample"), 
		presigma = NULL, preresiduals = NULL, prereturns = NULL, preR = NULL, rseed = NULL, mexsimdata = NULL, 
		vexsimdata = NULL, parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), VAR.fit = NULL, ...)
{
	UseMethod("cgarchsim")
}
#----------------------------------------------------------------------------------
# show methods
#----------------------------------------------------------------------------------
setMethod("show",
		signature(object = "cGARCHspec"),
		function(object){
			m = length(object@uspec@spec)
			garchn = sum( sapply(object@uspec@spec, FUN = function(x) max(x@optimization.model$pos.matrix[,1]) ) )
			cat(paste("\n*--------------------------------*", sep = ""))
			cat(paste("\n*       Copula GARCH Spec        *", sep = ""))
			cat(paste("\n*--------------------------------*", sep = ""))			
			cat("\n\nDistribution\t\t: ", object@mspec$distribution)
			dccn = max(object@mspec$optimization.model$pos.matrix[,1])
			if(object@mspec$timecopula){
				dccOrder = object@mspec$dccOrder[1:2]
				cat("\nDCC Order\t\t\t: ", dccOrder)
			} else{
				cat("\nMethod\t\t\t: ", object@mspec$method)
			}
			cat("\nTransformation\t\t: ", object@mspec$transformation)
			
			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 = "cGARCHfit"),
		function(object){
			m = dim(object@mfit$origdata)[2]
			cat(paste("\n*-----------------------------------*", sep = ""))
			cat(paste("\n*          Copula GARCH Fit         *", sep = ""))
			cat(paste("\n*-----------------------------------*", sep = ""))	
			cat("\n\nDistribution\t\t: ", object@model$copula.distribution)
			if(object@mspec$timecopula){
				cat("\nDCC Order\t\t\t: ", object@mspec$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@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@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@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 = "cGARCHfilter"),
		function(object){
			m = dim(object@mfilter$origdata)[2]
			cat(paste("\n*-----------------------------------*", sep = ""))
			cat(paste("\n*          Copula GARCH Filter      *", sep = ""))
			cat(paste("\n*-----------------------------------*", sep = ""))	
			cat("\n\nDistribution\t\t: ", object@model$copula.distribution)
			if(object@mspec$timecopula){
				cat("\nDCC Order\t\t\t: ", object@mspec$dccOrder[1:2])
			}
			cat("\nNo. of Parameters\t: ", length(object@mfilter$matcoef[,1]) + ( (m^2 - m)/2 ))
			cat("\nNo. of Series\t\t: ", m)
			cat("\nNo. of Observations\t: ", dim(object@mfilter$origdata)[1])
			cat("\nOut-of-Sample\t\t: ", object@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@model$out.sample), 2), "\n")
			cat("\nOptimal Parameters")
			cat(paste("\n---------------------------------------------------\n", sep = ""))
			print(round(object@mfilter$matcoef[,1],6), digits = 5)
			itest = .information.test(object@mfilter$llh, nObs = dim(object@mfilter$origdata)[1] - object@model$out.sample, 
					nPars = length(object@mfilter$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@mfilter$timer,"\n\n")
			invisible(object)
})


setMethod("show",
		signature(object = "cGARCHsim"),
		function(object){
			cat(paste("\n*---------------------------------*", sep = ""))
			cat(paste("\n*      Copula GARCH Simulation    *", sep = ""))
			cat(paste("\n*---------------------------------*", sep = ""))
			cat("\n\nDistribution\t\t:", object@msim$model$distribution)
			cat("\nTransformation\t\t:", object@msim$model$transformation)
			cat("\nTime-Varying\t\t:", object@msim$model$time.varying)
			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)
		})
#----------------------------------------------------------------------------------
# extractor methods
#----------------------------------------------------------------------------------

.fitted.cgarchfit = function(object)
{
	if(!is.null(object@mfit$vrmodel)){
		ans = object@mfit$vrmodel$xfitted
	} else{
		spec = object@uspec
		origdata = object@mfit$origdata
		out.sample = object@model$out.sample
		# create spec with fixed pars
		# pass to multifilter and return fitted
		m = length(spec@spec)
		if( spec@type == "equal" ){
			for(i in 1:m){
				pars = as.list(object@mfit$garchpars[,i])
				spec@spec[[i]]@optimization.model$fixed.pars = pars
			}
		} else{
			for(i in 1:m){
				pars = as.list(object@mfit$garchpars[[i]])
				spec@spec[[i]]@optimization.model$fixed.pars = pars
			}
		}
		filt = multifilter(spec, data = origdata, out.sample = out.sample)
		ans = fitted(filt)
	}
	return(ans)	
}

setMethod("fitted", signature(object = "cGARCHfit"), .fitted.cgarchfit)


.fitted.cgarchfilter = function(object)
{
	if(!is.null(object@mfit$vrmodel)){
		ans = object@mfit$vrmodel$xfitted
	} else{
		spec = object@uspec
		origdata = object@mfilter$origdata
		out.sample = object@model$out.sample
		# create spec with fixed pars
		# pass to multifilter and return fitted
		m = length(spec@spec)
		if( spec@type == "equal" ){
			for(i in 1:m){
				pars = as.list(object@mfilter$garchpars[,i])
				spec@spec[[i]]@optimization.model$fixed.pars = pars
			}
		} else{
			for(i in 1:m){
				pars = as.list(object@mfilter$garchpars[[i]])
				spec@spec[[i]]@optimization.model$fixed.pars = pars
			}
		}
		filt = multifilter(spec, data = origdata, out.sample = out.sample)
		ans = fitted(filt)
	}
	return(ans)	
}

setMethod("fitted", signature(object = "cGARCHfilter"), .fitted.cgarchfilter)


.fitted.cgarchsim = function(object, sim = 1)
{
	n = length(object@msim$simX)
	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 = "cGARCHsim"), .fitted.cgarchsim)


.residuals.cgarchfit = function(object)
{
	if(!is.null(object@mfit$vrmodel)){
		ans = object@mfit$vrmodel$xresiduals
	} else{
		spec = object@uspec
		origdata = object@mfit$origdata
		out.sample = object@model$out.sample
		# create spec with fixed pars
		# pass to multifilter and return fitted
		m = length(spec@spec)
		if( spec@type == "equal" ){
			for(i in 1:m){
				pars = as.list(object@mfit$garchpars[,i])
				spec@spec[[i]]@optimization.model$fixed.pars = pars
			}
		} else{
			for(i in 1:m){
				pars = as.list(object@mfit$garchpars[[i]])
				spec@spec[[i]]@optimization.model$fixed.pars = pars
			}
		}
		filt = multifilter(spec, data = origdata, out.sample = out.sample)
		ans = residuals(filt)
	}
	return(ans)	
}

setMethod("residuals", signature(object = "cGARCHfit"), .residuals.cgarchfit)


.residuals.cgarchfilter = function(object)
{
	if(!is.null(object@mfit$vrmodel)){
		ans = object@mfit$vrmodel$xresiduals
	} else{
		spec = object@uspec
		origdata = object@mfilter$origdata
		out.sample = object@model$out.sample
		# create spec with fixed pars
		# pass to multifilter and return fitted
		m = length(spec@spec)
		if( spec@type == "equal" ){
			for(i in 1:m){
				pars = as.list(object@mfilter$garchpars[,i])
				spec@spec[[i]]@optimization.model$fixed.pars = pars
			}
		} else{
			for(i in 1:m){
				pars = as.list(object@mfilter$garchpars[[i]])
				spec@spec[[i]]@optimization.model$fixed.pars = pars
			}
		}
		filt = multifilter(spec, data = origdata, out.sample = out.sample)
		ans = residuals(filt)
	}
	return(ans)	
}

setMethod("residuals", signature(object = "cGARCHfilter"), .residuals.cgarchfilter)

.sigma.cgarchfit = function(object)
{

	spec = object@uspec
	origdata = object@mfit$origdata
	out.sample = object@model$out.sample
	# create spec with fixed pars
	# pass to multifilter and return fitted
	m = length(spec@spec)
	if( spec@type == "equal" ){
		for(i in 1:m){
			pars = as.list(object@mfit$garchpars[,i])
			spec@spec[[i]]@optimization.model$fixed.pars = pars
		}
	} else{
		for(i in 1:m){
			pars = as.list(object@mfit$garchpars[[i]])
			spec@spec[[i]]@optimization.model$fixed.pars = pars
		}
	}
	filt = multifilter(spec, data = origdata, out.sample = out.sample)
	ans = sigma(filt)
	
	return(ans)	
}

setMethod("sigma", signature(object = "cGARCHfit"), .sigma.cgarchfit)


.sigma.cgarchfilter = function(object)
{
	
	spec = object@uspec
	origdata = object@mfilter$origdata
	out.sample = object@model$out.sample
	# create spec with fixed pars
	# pass to multifilter and return fitted
	m = length(spec@spec)
	if( spec@type == "equal" ){
		for(i in 1:m){
			pars = as.list(object@mfilter$garchpars[,i])
			spec@spec[[i]]@optimization.model$fixed.pars = pars
		}
	} else{
		for(i in 1:m){
			pars = as.list(object@mfilter$garchpars[[i]])
			spec@spec[[i]]@optimization.model$fixed.pars = pars
		}
	}
	filt = multifilter(spec, data = origdata, out.sample = out.sample)
	ans = sigma(filt)
	
	return(ans)	
}

setMethod("sigma", signature(object = "cGARCHfilter"), .sigma.cgarchfilter)

.rcov.cgarchfit = function(object)
{
	spec = object@uspec
	m = length(spec@spec)
	origdata = object@mfit$origdata
	out.sample = object@model$out.sample
	if( spec@type == "equal" ){
		for(i in 1:m){
			pars = as.list(object@mfit$garchpars[,i])
			spec@spec[[i]]@optimization.model$fixed.pars = pars
		}
	} else{
		for(i in 1:m){
			pars = as.list(object@mfit$garchpars[[i]])
			spec@spec[[i]]@optimization.model$fixed.pars = pars
		}
	}
	filt = multifilter(spec, data = origdata, out.sample = out.sample)
	sig = sigma(filt)
	n = dim(sig)[1]
	m = dim(sig)[2]
	V = array(data = NA, dim = c(m, m, n))
	R = object@copula$R
	if(object@model$time.varying){
		for(i in 1:n)  V[,,i] = .cor2cov(R[[i]], sig[i,])
	} else{
		for(i in 1:n)  V[,,i] = .cor2cov(R, sig[i,])
	}
	return(V)
}

setMethod("rcov", signature(object = "cGARCHfit"), .rcov.cgarchfit)

.rcov.cgarchfilter = function(object)
{
	spec = object@uspec
	m = length(spec@spec)
	origdata = object@mfilter$origdata
	out.sample = object@model$out.sample
	if( spec@type == "equal" ){
		for(i in 1:m){
			pars = as.list(object@mfilter$garchpars[,i])
			spec@spec[[i]]@optimization.model$fixed.pars = pars
		}
	} else{
		for(i in 1:m){
			pars = as.list(object@mfilter$garchpars[[i]])
			spec@spec[[i]]@optimization.model$fixed.pars = pars
		}
	}
	filt = multifilter(spec, data = origdata, out.sample = out.sample)
	sig = sigma(filt)
	n = dim(sig)[1]
	m = dim(sig)[2]
	V = array(data = NA, dim = c(m, m, n))
	R = object@copula$R
	if(object@model$time.varying){
		for(i in 1:n)  V[,,i] = .cor2cov(R[[i]], sig[i,])
	} else{
		for(i in 1:n)  V[,,i] = .cor2cov(R, sig[i,])
	}
	return(V)
}

setMethod("rcov", signature(object = "cGARCHfilter"), .rcov.cgarchfilter)


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

setMethod("rcov", signature(object = "cGARCHsim"), .rcov.cgarchsim)

.rcor.cgarchfit = function(object)
{
	R = object@copula$R
	if(object@model$time.varying){
		n = length(R)
		m = dim(R[[1]])[2]
		C = array(data = NA, dim = c(m, m, n))
		for(i in 1:n)  C[,,i] = R[[i]]
	} else{
		C = R
	}
	return(C)
}


setMethod("rcor", signature(object = "cGARCHfit"), .rcor.cgarchfit)


.rcor.cgarchfilter = function(object)
{
	R = object@copula$R
	if(object@model$time.varying){
		n = length(R)
		m = dim(R[[1]])[2]
		C = array(data = NA, dim = c(m, m, n))
		for(i in 1:n)  C[,,i] = R[[i]]
	} else{
		C = R
	}
	return(C)
}


setMethod("rcor", signature(object = "cGARCHfilter"), .rcor.cgarchfilter)




.rcor.cgarchsim = function(object, sim = 1)
{
	n = length(object@msim$simH)
	m.sim = as.integer(sim)
	if( m.sim > n | m.sim < 1 ) stop("\rgarch-->error: rcor sim index out of bounds!")
	
	if(object@msim$model$time.varying){
		ans = object@msim$simR[[sim]]
	} else{
		# fixed
		ans = cov2cor(object@msim$simH[[1]][,,1])
	}
	return( ans )
}

setMethod("rcor", signature(object = "cGARCHsim"), .rcor.cgarchsim)



.coef.cgarchfit = function(object, type = "all")
{
	if( type == "all" ){
		cf = object@mfit$matcoef[,1]
	} else if( type == "st" ){
		cf = object@mfit$stpars
	} else{
		cf = object@mfit$garchpars
	}
	return( cf )
}

setMethod("coef", signature(object = "cGARCHfit"), .coef.cgarchfit)

.coef.cgarchfilter = function(object, type = "all")
{
	if( type == "all" ){
		cf = object@mfilter$matcoef[,1]
	} else if( type == "st" ){
		cf = object@mfilter$stpars
	} else{
		cf = object@mfilter$garchpars
	}
	return( cf )
}

setMethod("coef", signature(object = "cGARCHfilter"), .coef.cgarchfilter)


.likelihood.cgarchfit = function(object)
{
	object@mfit$llh
}

setMethod("likelihood", signature(object = "cGARCHfit"), .likelihood.cgarchfit)

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

setMethod("likelihood", signature(object = "cGARCHfilter"), .likelihood.cgarchfilter)

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.