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


#####################################################################################
# Transformation Functions
#------------------------------------------------------------------------------------

.pparametric = function(mfit, zres)
{
	m = dim(zres)[2]
	n = dim(zres)[1] 
	ures = matrix(NA, ncol = m, nrow = n)
	
	for(i in 1:m){
		gdist = mfit@fit[[i]]@model$distribution
		lambda = ifelse(gdist == "ghyp", coef(mfit@fit[[i]])["dlambda"], 0)
		skew = ifelse(mfit@fit[[i]]@model$include.skew, coef(mfit@fit[[i]])["skew"],  0)
		shape = ifelse(mfit@fit[[i]]@model$include.shape, coef(mfit@fit[[i]])["shape"],  0)
		ures[,i] = pdist(gdist, zres[,i], mu = 0, sigma = 1, lambda = lambda, skew = skew, shape = shape)
	}
	
	return(ures)
}

.pparametric.filter = function(mflt, zres)
{
	m = dim(zres)[2]
	n = dim(zres)[1] 
	ures = matrix(NA, ncol = m, nrow = n)
	
	for(i in 1:m){
		gdist = mflt[[i]]@model$distribution
		lambda = ifelse(gdist == "ghyp", coef(mflt[[i]])["dlambda"], 0)
		skew = ifelse(mflt[[i]]@model$include.skew, coef(mflt[[i]])["skew"],  0)
		shape = ifelse(mflt[[i]]@model$include.shape, coef(mflt[[i]])["shape"],  0)
		ures[,i] = pdist(gdist, zres[,i], mu = 0, sigma = 1, lambda = lambda, skew = skew, shape = shape)
	}
	
	return(ures)
}

.pempirical = function(zres)
{
	m = dim(zres)[2]
	n = dim(zres)[1] 
	ures = matrix(NA, ncol = m, nrow = n)
	for(i in 1:m){
		fn = ecdf(sort(zres[,i]))
		ures[,i] = fn(zres[,i])
	}
	return(ures)
}



.pspd = function(zres, spd)
{
	m = dim(zres)[2]
	n = dim(zres)[1] 
	ures = matrix(NA, ncol = m, nrow = n)
	sfit = vector(mode = "list", length = m)
	sfit = lapply(as.list(1:m), function(i) spdfit(zres[,i], upper = spd$upper, lower = spd$lower, 
						tailfit = "GPD", type = spd$type, kernelfit = spd$kernel, information = "observed"))
	for(i in 1:m){
		ures[,i] = pspd(zres[,i], sfit[[i]])
	}
	return(list(ures = ures, sfit = sfit))
}

#------------------------------------------------------------------------------------
.qparametric = function(ures, ucoef, include.skew, include.shape, dist)
{
	m = dim(ures)[2]
	zres = matrix(NA, ncol = m, nrow = dim(ures)[1])
	for(i in 1:m){
		gdist = dist[i]
		lambda = ifelse(gdist == "ghyp", ucoef[[i]]["dlambda"], 0)
		skew = ifelse(include.skew[i], ucoef[[i]]["skew"],  0)
		shape = ifelse(include.shape[i], ucoef[[i]]["shape"],  0)
		zres[,i] = qdist(gdist, ures[,i], mu = 0, sigma = 1, lambda = lambda, skew = skew, shape = shape)
	}
	return(zres)
}

.qempirical = function(ures, oldz)
{
	zres = matrix(NA, ncol = dim(ures)[2], nrow = dim(ures)[1])	
	for(i in 1:dim(ures)[2]){
		zres[,i] = quantile(oldz[,i], ures[,i], type = 1)
	}
	return(zres)
}

.qspd = function(ures, sfit)
{
	zres = matrix(NA, ncol = dim(ures)[2], nrow = dim(ures)[1])	
	for(i in 1:dim(ures)[2]){
		zres[,i] = qspd(ures[,i], sfit[[i]])
	}
	return(zres)
}
#------------------------------------------------------------------------------------