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


fgarchKappa<-function(lambda, delta, gamma1, gamma2, fk, dlambda, shape, skew, cond.density,...)
{
	kappa = try(expr=integrate(.ffunE, lower = -Inf, upper = Inf, lambda, delta, gamma1, gamma2, fk, dlambda, shape, skew, cond.density,...)[[1]],
			silent=TRUE)
	if(inherits(kappa, "try-error")){
		kappa<-NA}	
	kappa
}

.ffunE<-function(x, lambda, delta, gamma1, gamma2, fk, dlambda, shape, skew, cond.density,...)
{   # A function implemented by Alexios Ghalanos
	# Compute Expectation Value
	kdelta=delta+fk*lambda
	cond.density = cond.density[1]
	if (cond.density == "norm"){
		fun = (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * dnorm(x)
	}
	else if(cond.density == "ged") {
		fun =  (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * dged(x, nu = shape)
	}
	else if(cond.density == "std") {
		fun =  (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * dstd(x, nu = shape)
	}
	else if(cond.density == "snorm") {
		fun =  (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * dsnorm(x, xi = skew)
	}
	else if(cond.density == "sged") {
		fun =  (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * dsged(x, nu = shape, xi = skew)
	}
	else if(cond.density == "sstd") {
		fun =  (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * dsstd(x, nu = shape, xi = skew)
	}
	else if(cond.density == "nig") {
		fun =  (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * dsnig(x, zeta = shape, rho = skew)
	}
	else if(cond.density == "ghyp") {
		fun =  (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * dsgh(x, zeta = shape, rho = skew, lambda = dlambda)
	}
	else if(cond.density == "jsu") {
		fun =  (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * djsu(x, mu = 0, sigma = 1, nu = skew, tau = shape)
	}
	else{
		temp<-paste("d",cond.density,sep="")
		.ddist<-eval(parse(text=paste(temp)))
		fun = (((abs(x - gamma2) - gamma1*(x - gamma2)))^kdelta) * .ddist(x,...)
	}
	# Return Value:
	fun
}

gjrgarchKappa<-function(gm, dlambda, shape, skew, cond.density,...)
{
	kappa = try(expr=integrate(.gjrfunE, lower = -Inf, upper = Inf, gm, dlambda, shape, skew, cond.density,...)[[1]],
			silent=TRUE)
	if(inherits(kappa, "try-error")){
		kappa<-NA}
	else{kappa<-integrate(.gjrfunE, lower = -Inf, upper = Inf, gm, dlambda, shape, skew, cond.density,...)[[1]]}
	
	kappa
}

.gjrfunE<-function(x, gm, dlambda, shape, skew, cond.density,...)
{   # A function implemented by Alexios Ghalanos
	# Compute Expectation Value
	cond.density = cond.density[1]
	if (cond.density == "norm"){
		fun = (x^2 + gm*(x^2)*(x<0)) * dnorm(x)
	}
	else if(cond.density == "ged") {
		fun =  (x^2 + gm*(x^2)*(x<0)) * dged(x, nu = shape)
	}
	else if(cond.density == "std") {
		fun =  (x^2 + gm*(x^2)*(x<0)) * dstd(x, nu = shape)
	}
	else if(cond.density == "snorm") {
		fun =  (x^2 + gm*(x^2)*(x<0)) * dsnorm(x, xi = skew)
	}
	else if(cond.density == "sged") {
		fun =  (x^2 + gm*(x^2)*(x<0)) * dsged(x, nu = shape, xi = skew)
	}
	else if(cond.density == "sstd") {
		fun =  (x^2 + gm*(x^2)*(x<0)) * dsstd(x, nu = shape, xi = skew)
	}
	else if(cond.density == "nig") {
		fun =  (x^2 + gm*(x^2)*(x<0)) * dsnig(x, zeta = shape, rho = skew)
	}
	else if(cond.density == "ghyp") {
		fun =  (x^2 + gm*(x^2)*(x<0)) * dsgh(x, zeta = shape, rho = skew, lambda = dlambda)
	}
	else if(cond.density == "jsu") {
		fun =  (x^2 + gm*(x^2)*(x<0)) * djsu(x, mu = 0, sigma = 1, nu = skew, tau = shape)
	}
	else{
		temp<-paste("d",cond.density,sep="")
		.ddist<-eval(parse(text=paste(temp)))
		fun =  (x^2 + gm*(x^2)*(x<0)) * .ddist(x,...)
	}
	# Return Value:
	fun
}


# probability that x<0
pneg<-function(dlambda, shape, skew, cond.density,...)
{
	kappa = try(expr=integrate(.pnegfunE, lower = -Inf, upper = 0, dlambda, shape, skew, cond.density,...)[[1]],
			silent=TRUE)
	if(inherits(kappa, "try-error")){
		kappa<-NA}
	else{kappa<-integrate(.pnegfunE, lower = -Inf, upper = 0, dlambda, shape, skew, cond.density,...)[[1]]}
	
	kappa
}

.pnegfunE<-function(x, dlambda, shape, skew, cond.density,...)
{   # A function implemented by Alexios Ghalanos
	# Compute Expectation Value
	cond.density = cond.density[1]
	if (cond.density == "norm"){
		fun = dnorm(x)
	}
	else if(cond.density == "ged") {
		fun = dged(x, nu = shape)
	}
	else if(cond.density == "std") {
		fun = dstd(x, nu = shape)
	}
	else if(cond.density == "snorm") {
		fun =dsnorm(x, xi = skew)
	}
	else if(cond.density == "sged") {
		fun = dsged(x, nu = shape, xi = skew)
	}
	else if(cond.density == "sstd") {
		fun = dsstd(x, nu = shape, xi = skew)
	}
	else if(cond.density == "nig") {
		fun = dsnig(x, zeta = shape, rho = skew)
	}
	else if(cond.density == "ghyp") {
		fun = dsgh(x, zeta = shape, rho = skew, lambda = dlambda)
	}
	else if(cond.density == "jsu") {
		fun = djsu(x, mu = 0, sigma = 1, nu = skew, tau = shape)
	}
	else{
		temp<-paste("d",cond.density,sep="")
		.ddist<-eval(parse(text=paste(temp)))
		fun = .ddist(x,...)
	}
	# Return Value:
	fun
}

egarchKappa<-function(dlambda, shape, skew, cond.density,...)
{
	kappa = try(expr=integrate(.efunE, lower = -Inf, upper = Inf, dlambda, shape, skew, cond.density,...)[[1]],
			silent=TRUE)
	if(inherits(kappa, "try-error")){
		kappa<-NA}
	else{kappa<-integrate(.efunE, lower = -Inf, upper = Inf, dlambda, shape, skew, cond.density,...)[[1]]}
	
	kappa
}

.efunE<-function(x, dlambda, shape, skew, cond.density,...)
{   # A function implemented by Alexios Ghalanos
	# Compute Expectation Value
	cond.density = cond.density[1]
	if(cond.density == "norm"){
		fun = abs(x) * dnorm(x)
	}
	else if(cond.density == "ged") {
		fun = abs(x) * dged(x, nu = shape)
	}
	else if(cond.density == "std") {
		fun = abs(x) * dstd(x, nu = shape)
	}
	else if(cond.density == "snorm") {
		fun = abs(x) * dsnorm(x, xi = skew)
	}
	else if(cond.density == "sged") {
		fun = abs(x) * dsged(x, nu = shape, xi = skew)
	}
	else if(cond.density == "sstd") {
		fun = abs(x) * dsstd(x, nu = shape, xi = skew)
	}
	else if(cond.density == "nig") {
		fun = abs(x) * dsnig(x, zeta = shape, rho = skew)
	}
	else if(cond.density == "ghyp") {
		fun = abs(x) * dsgh(x, zeta = shape, rho = skew, lambda = dlambda)
	}
	else if(cond.density == "jsu") {
		fun = abs(x) * djsu(x, mu = 0, sigma = 1, nu = skew, tau = shape)
	}
	else{
		temp<-paste("d",cond.density,sep="")
		.ddist<-eval(parse(text=paste(temp)))
		fun = abs(x) * .ddist(x,...)
	}
	# Return Value:
	fun
}

aparchKappa<-function(gm, delta, dlambda, shape, skew, cond.density,...)
{
	kappa = try(expr=integrate(.afunE, lower = -Inf, upper = Inf, gm, delta, dlambda, shape, skew, cond.density,...)[[1]],
			silent=TRUE)
	if(inherits(kappa, "try-error")){
		kappa<-NA}
	else{kappa<-integrate(.afunE, lower = -Inf, upper = Inf, gm, delta, dlambda, shape, skew, cond.density,...)[[1]]}
	
	kappa
}

.afunE<-function(x, gm, delta, dlambda, shape, skew, cond.density,...)
{   # A function implemented by Alexios Ghalanos
	# Compute Expectation Value
	cond.density = cond.density[1]
	if (cond.density == "norm"){
		fun = ((abs(x)-gm*x)^(delta)) * dnorm(x)
	}
	else if(cond.density == "ged") {
		fun =  ((abs(x)-gm*x)^(delta)) * dged(x, nu = shape)
	}
	else if(cond.density == "std") {
		fun =  ((abs(x)-gm*x)^(delta)) * dstd(x, nu = shape)
	}
	else if(cond.density == "snorm") {
		fun =  ((abs(x)-gm*x)^(delta)) * dsnorm(x, xi = skew)
	}
	else if(cond.density == "sged") {
		fun =  ((abs(x)-gm*x)^(delta)) * dsged(x, nu = shape, xi = skew)
	}
	else if(cond.density == "sstd") {
		fun =  ((abs(x)-gm*x)^(delta)) * dsstd(x, nu = shape, xi = skew)
	}
	else if(cond.density == "nig") {
		fun =  ((abs(x)-gm*x)^(delta)) * dsnig(x, zeta = shape, rho = skew)
	}
	else if(cond.density == "ghyp") {
		fun =  ((abs(x)-gm*x)^(delta)) * dsgh(x, zeta = shape, rho = skew, lambda = dlambda)
	}
	else if(cond.density == "jsu") {
		fun =  ((abs(x)-gm*x)^(delta)) * djsu(x, mu = 0, sigma = 1, nu = skew, tau = shape)
	}
	else{
		temp<-paste("d",cond.density,sep="")
		.ddist<-eval(parse(text=paste(temp)))
		fun =  ((abs(x)-gm*x)^(delta)) * .ddist(x,...)
	}
	# Return Value:
	fun
}