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


normal.dccLLH1 = function(pars, data, returnType = "llh", garchenv)
{
	# prepare inputs
	# rejoin fixed and pars
	fixed = get("fixed", garchenv)
	fixid = get("fixid", garchenv)
	mspec = get("mspec", garchenv)
	npar = get("npar", garchenv)
	Qbarx = get("Qbar", garchenv)
	stdresidsx = get("stdresid", garchenv)
	Hx = get("H", garchenv)
	m = dim(data)[2]
	if(!is.null(fixed)){
		pall = vector(mode = "numeric", length = npar)
		pall[fixid] = fixed
		pall[-fixid] = pars
		pars = pall
	}
	T = dim(data)[1]
	omodel = get("omodel", garchenv)
	fit.control = get("fit.control", garchenv)
	mo = omodel$maxOrder
	N = c(mo, T)
	dccOrder = mspec$dccOrder
	pos = omodel$pos.matrix
	
	stdresidsx = rbind( matrix(0, nrow = mo, ncol = m), stdresidsx )
	
	dcca = dccb = skew = shape = 0
	if(pos[1,3] == 1) dcca = pars[pos[1,1]:pos[1,2]]
	if(pos[2,3] == 1) dccb = pars[pos[2,1]:pos[2,2]]
	if(pos[3,3] == 1) skew = pars[pos[3,1]:pos[3,2]]
	if(pos[4,3] == 1) shape = pars[pos[4,1]:pos[4,2]]
	
	dccsum = sum(dcca) + sum(dccb)
	dccax = dcca
	dccbx = dccb
	dccorderx = c(dccOrder, mo)
	dccsumx = sum(dcca) + sum(dccb)
	
	if( fit.control$stationarity ){
		if( !is.na(dccsumx) && dccsumx >= 1 ) return(llh = get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
		
	res = .Call(name = "dccnormC1", Qbar = Qbarx, Z = stdresidsx, 
			dcca = as.double(dccax), dccb = as.double(dccbx), dccorder = as.numeric(dccorderx), 
			dccsum = as.double(dccsumx))
	
	llh = res[[3]]
	
	if(is.finite(llh) | !is.na(llh) | !is.nan(llh)){
		assign(".llh", llh, envir = garchenv)
	} else {
		llh = (get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	return(llh)
}

normal.dccLLH2 = function(pars, garchpars, data, returnType = "llh", garchenv)
{
	# prepare inputs
	# rejoin fixed and pars
	fixed = get("fixed", garchenv)
	fixid = get("fixid", garchenv)
	mspec = get("mspec", garchenv)
	npar = get("npar", garchenv)
	paridx = get("paridx", garchenv)
	m = dim(data)[2]
	T = dim(data)[1]
	speclist = get("speclist", garchenv)
	Hx = matrix(0, nrow = T, ncol = m)
	paridxa = get("paridxa", garchenv)
	resids = matrix(0, nrow = T, ncol = m)
	# simulate new H with which to standardize the dataset
	for(i in 1:m){
		specx = ugarchspec(mean.model = list(
						armaOrder = speclist@spec[[i]]@mean.model$armaOrder, 
						include.mean = speclist@spec[[i]]@mean.model$include.mean,
						garchInMean = speclist@spec[[i]]@mean.model$im, 
						inMeanType = speclist@spec[[i]]@mean.model$inMeanType, 
						arfima = speclist@spec[[i]]@mean.model$arfima, 
						external.regressors = speclist@spec[[i]]@mean.model$mexdata), 
						variance.model = list(
						model = speclist@spec[[i]]@variance.model$model, 
						garchOrder = speclist@spec[[i]]@variance.model$garchOrder,
						submodel = speclist@spec[[i]]@variance.model$submodel,
						external.regressors = speclist@spec[[i]]@variance.model$vexdata),
						distribution.model = speclist@spec[[i]]@distribution.model$distribution)
		fpars = garchpars[paridxa[i,1]:paridxa[i,2]]
		names(fpars) = specx@optimization.model$modelnames
		specx@optimization.model$fixed.pars = as.list(fpars)
		flt = ugarchfilter(spec = specx, data = data[,i])
		Hx[, i] = sigma(flt)
		resids[,i] = residuals(flt)
	}
	
	stdresidsx = resids/Hx
	
	Qbarx = cov(stdresidsx)
	
	if(!is.null(fixed)){
		pall = vector(mode = "numeric", length = npar)
		pall[fixid] = fixed
		pall[-fixid] = pars
		pars = pall
	}
	omodel = get("omodel", garchenv)
	fit.control = get("fit.control", garchenv)
	mo = omodel$maxOrder
	N = c(mo, T)
	dccOrder = mspec$dccOrder
	pos = omodel$pos.matrix
		
	stdresidsx = rbind( matrix(1, nrow = mo, ncol = m), stdresidsx )
	Hx = rbind( matrix(0, nrow = mo, ncol = m), Hx )
	
	dcca = dccb = skew = shape = 0
	if(pos[1,3] == 1) dcca = pars[pos[1,1]:pos[1,2]]
	if(pos[2,3] == 1) dccb = pars[pos[2,1]:pos[2,2]]
	if(pos[3,3] == 1) skew = pars[pos[3,1]:pos[3,2]]
	if(pos[4,3] == 1) shape = pars[pos[4,1]:pos[4,2]]
	
	dccsum = sum(dcca) + sum(dccb)
	dccax = dcca
	dccbx = dccb
	dccorderx = c(dccOrder, mo)
	dccsumx = sum(dcca) + sum(dccb)
	
	if( fit.control$stationarity ){
		if( !is.na(dccsumx) && dccsumx >= 1 ) return(llh = get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	res = .Call(name = "dccnormC2", Qbar = Qbarx, H = Hx, Z = stdresidsx, 
			dcca = as.double(dccax), dccb = as.double(dccbx), dccorder = as.numeric(dccorderx), 
			dccsum = as.double(dccsumx))
	
	Qtout = res[[1]]
	likelihoods = res[[2]]
	llh = res[[3]]
	Rtout = res[[4]]
	Qtout = Qtout[(mo+1):(mo+T)]
	Rtout = Rtout[(mo+1):(mo+T)]
	likelihoods = likelihoods[(mo+1):(mo+T)]
	
	if(is.finite(llh) | !is.na(llh) | !is.nan(llh)){
		assign(".llh", llh, envir = garchenv)
	} else {
		llh = (get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	ans = switch(returnType,
			lik = likelihoods,
			llh = llh,
			all = list(lik = likelihoods, llh = llh, Rt = Rtout, Qt = Qtout))
	return(ans)
}

normal.adccLLH1 = function(pars, data, returnType = "llh", garchenv)
{
	# prepare inputs
	# rejoin fixed and pars
	fixed = get("fixed", garchenv)
	fixid = get("fixid", garchenv)
	mspec = get("mspec", garchenv)
	npar = get("npar", garchenv)
	Qbarx = get("Qbar", garchenv)
	Nbarx = get("Nbar", garchenv)
	stdresidsx = get("stdresid", garchenv)
	Hx = get("H", garchenv)
	m = dim(data)[2]
	if(!is.null(fixed)){
		pall = vector(mode = "numeric", length = npar)
		pall[fixid] = fixed
		pall[-fixid] = pars
		pars = pall
	}
	T = dim(data)[1]
	omodel = get("omodel", garchenv)
	fit.control = get("fit.control", garchenv)
	mo = omodel$maxOrder
	N = c(mo, T)
	dccOrder = mspec$dccOrder
	pos = omodel$pos.matrix
	
	stdresidsx = rbind( matrix(0, nrow = mo, ncol = m), stdresidsx )
	
	dcca = dccb = skew = shape = 0
	if(pos[1,3] == 1) dcca = pars[pos[1,1]:pos[1,2]]
	if(pos[2,3] == 1) dccb = pars[pos[2,1]:pos[2,2]]
	if(pos[2,3] == 1) dccg = pars[pos[2,1]:pos[2,2]]
	
	if(pos[3,3] == 1) skew = pars[pos[3,1]:pos[3,2]]
	if(pos[4,3] == 1) shape = pars[pos[4,1]:pos[4,2]]
	
	dccsum = sum(dcca) + sum(dccb)
	dccax = dcca
	dccbx = dccb
	dccorderx = c(dccOrder, mo)
	dccsumx = sum(dcca) + sum(dccb)
	
	if( fit.control$stationarity ){
		if( !is.na(dccsumx) && dccsumx >= 1 ) return(llh = get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	res = .Call(name = "dccnormC1", Qbar = Qbarx, Z = stdresidsx, 
			dcca = as.double(dccax), dccb = as.double(dccbx), dccorder = as.numeric(dccorderx), 
			dccsum = as.double(dccsumx))
	
	llh = res[[3]]
	
	if(is.finite(llh) | !is.na(llh) | !is.nan(llh)){
		assign(".llh", llh, envir = garchenv)
	} else {
		llh = (get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	return(llh)
}

student.dccLLH1 = function(pars, data, returnType = "llh", garchenv)
{
	# prepare inputs
	# rejoin fixed and pars
	fixed = get("fixed", garchenv)
	fixid = get("fixid", garchenv)
	mspec = get("mspec", garchenv)
	npar = get("npar", garchenv)
	Qbarx = get("Qbar", garchenv)
	stdresidsx = get("stdresid", garchenv)
	Hx = get("H", garchenv)
	m = dim(data)[2]
	if(!is.null(fixed)){
		pall = vector(mode = "numeric", length = npar)
		pall[fixid] = fixed
		pall[-fixid] = pars
		pars = pall
	}
	T = dim(data)[1]
	omodel = get("omodel", garchenv)
	fit.control = get("fit.control", garchenv)
	mo = omodel$maxOrder
	N = c(mo, T)
	dccOrder = mspec$dccOrder
	pos = omodel$pos.matrix
	
	stdresidsx = rbind( matrix(0, nrow = mo, ncol = m), stdresidsx )
	
	dcca = dccb = skew = shape = 0
	if(pos[1,3] == 1) dcca = pars[pos[1,1]:pos[1,2]]
	if(pos[2,3] == 1) dccb = pars[pos[2,1]:pos[2,2]]
	if(pos[3,3] == 1) skew = pars[pos[3,1]:pos[3,2]]
	if(pos[4,3] == 1) shape = pars[pos[4,1]:pos[4,2]]
	
	if( shape < 2.001 ) shape = 2.001
	dccsum = sum(dcca) + sum(dccb)
	dccax = dcca
	dccbx = dccb
	dccorderx = c(dccOrder, mo)
	dccsumx = sum(dcca) + sum(dccb)
	
	if( fit.control$stationarity ){
		if( !is.na(dccsumx) && dccsumx >= 1 ) return(llh = get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	res = .Call(name = "dccstudentC1", Qbar = Qbarx, Z = stdresidsx, 
			dcca = as.double(dccax), dccb = as.double(dccbx), nu = as.double(shape), 
			dccorder = as.numeric(dccorderx), dccsum = as.double(dccsumx))
	
	llh = res[[3]]
	
	if(is.finite(llh) | !is.na(llh) | !is.nan(llh)){
		assign(".llh", llh, envir = garchenv)
	} else {
		llh = (get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	return(llh)
}

student.dccLLH2 = function(pars, garchpars, data, returnType = "llh", garchenv)
{
	# prepare inputs
	# rejoin fixed and pars
	fixed = get("fixed", garchenv)
	fixid = get("fixid", garchenv)
	mspec = get("mspec", garchenv)
	npar = get("npar", garchenv)
	paridx = get("paridx", garchenv)
	m = dim(data)[2]
	T = dim(data)[1]
	speclist = get("speclist", garchenv)
	Hx = matrix(0, nrow = T, ncol = m)
	paridxa = get("paridxa", garchenv)
	resids = matrix(0, nrow = T, ncol = m)
	# simulate new H with which to standardize the dataset
	for(i in 1:m){
		specx = ugarchspec(mean.model = list(
						armaOrder = speclist@spec[[i]]@mean.model$armaOrder, 
						include.mean = speclist@spec[[i]]@mean.model$include.mean,
						garchInMean = speclist@spec[[i]]@mean.model$im, 
						inMeanType = speclist@spec[[i]]@mean.model$inMeanType, 
						arfima = speclist@spec[[i]]@mean.model$arfima, 
						external.regressors = speclist@spec[[i]]@mean.model$mexdata), 
				variance.model = list(
						model = speclist@spec[[i]]@variance.model$model, 
						garchOrder = speclist@spec[[i]]@variance.model$garchOrder,
						submodel = speclist@spec[[i]]@variance.model$submodel,
						external.regressors = speclist@spec[[i]]@variance.model$vexdata),
				distribution.model = speclist@spec[[i]]@distribution.model$distribution)
		fpars = garchpars[paridxa[i,1]:paridxa[i,2]]
		names(fpars) = specx@optimization.model$modelnames
		specx@optimization.model$fixed.pars = as.list(fpars)
		flt = ugarchfilter(spec = specx, data = data[,i])
		Hx[, i] = sigma(flt)
		resids[,i] = residuals(flt)
	}
	
	stdresidsx = resids/Hx
	
	Qbarx = cov(stdresidsx)
	
	if(!is.null(fixed)){
		pall = vector(mode = "numeric", length = npar)
		pall[fixid] = fixed
		pall[-fixid] = pars
		pars = pall
	}
	omodel = get("omodel", garchenv)
	fit.control = get("fit.control", garchenv)
	mo = omodel$maxOrder
	N = c(mo, T)
	dccOrder = mspec$dccOrder
	pos = omodel$pos.matrix
	
	stdresidsx = rbind( matrix(1, nrow = mo, ncol = m), stdresidsx )
	Hx = rbind( matrix(0, nrow = mo, ncol = m), Hx )
	
	dcca = dccb = skew = shape = 0
	if(pos[1,3] == 1) dcca = pars[pos[1,1]:pos[1,2]]
	if(pos[2,3] == 1) dccb = pars[pos[2,1]:pos[2,2]]
	if(pos[3,3] == 1) skew = pars[pos[3,1]:pos[3,2]]
	if(pos[4,3] == 1) shape = pars[pos[4,1]:pos[4,2]]	
	
	if( shape < 2.001 ) shape = 2.001
	
	dccsum = sum(dcca) + sum(dccb)
	dccax = dcca
	dccbx = dccb
	dccorderx = c(dccOrder, mo)
	dccsumx = sum(dcca) + sum(dccb)
	
	if( fit.control$stationarity ){
		if( !is.na(dccsumx) && dccsumx >= 1 ) return(llh = get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	res = .Call(name = "dccstudentC2", Qbar = Qbarx, H = Hx, Z = stdresidsx, 
			dcca = as.numeric(dccax), dccb = as.numeric(dccbx), nu = as.numeric(shape), 
			dccorder = as.numeric(dccorderx), dccsum = as.numeric(dccsumx))
	
	Qtout = res[[1]]
	likelihoods = res[[2]]
	llh = res[[3]]
	Rtout = res[[4]]
	Qtout = Qtout[(mo+1):(mo+T)]
	Rtout = Rtout[(mo+1):(mo+T)]
	likelihoods = likelihoods[(mo+1):(mo+T)]
	
	if(is.finite(llh) | !is.na(llh) | !is.nan(llh)){
		assign(".llh", llh, envir = garchenv)
	} else {
		llh = (get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	ans = switch(returnType,
			lik = likelihoods,
			llh = llh,
			all = list(lik = likelihoods, llh = llh, Rt = Rtout, Qt = Qtout))
	return(ans)
}

laplace.dccLLH1 = function(pars, data, returnType = "llh", garchenv)
{
	# prepare inputs
	# rejoin fixed and pars
	fixed = get("fixed", garchenv)
	fixid = get("fixid", garchenv)
	mspec = get("mspec", garchenv)
	npar = get("npar", garchenv)
	Qbarx = get("Qbar", garchenv)
	stdresidsx = get("stdresid", garchenv)
	Hx = get("H", garchenv)
	m = dim(data)[2]
	if(!is.null(fixed)){
		pall = vector(mode = "numeric", length = npar)
		pall[fixid] = fixed
		pall[-fixid] = pars
		pars = pall
	}
	T = dim(data)[1]
	omodel = get("omodel", garchenv)
	fit.control = get("fit.control", garchenv)
	mo = omodel$maxOrder
	N = c(mo, T)
	dccOrder = mspec$dccOrder
	pos = omodel$pos.matrix
	
	stdresidsx = rbind( matrix(0, nrow = mo, ncol = m), stdresidsx )
	
	dcca = dccb = skew = shape = 0
	if(pos[1,3] == 1) dcca = pars[pos[1,1]:pos[1,2]]
	if(pos[2,3] == 1) dccb = pars[pos[2,1]:pos[2,2]]
	if(pos[3,3] == 1) skew = pars[pos[3,1]:pos[3,2]]
	if(pos[4,3] == 1) shape = pars[pos[4,1]:pos[4,2]]
	
	if( shape < 0 ) shape = 0.001
	dccsum = sum(dcca) + sum(dccb)
	dccax = dcca
	dccbx = dccb
	dccorderx = c(dccOrder, mo)
	dccsumx = sum(dcca) + sum(dccb)
	
	if( fit.control$stationarity ){
		if( !is.na(dccsumx) && dccsumx >= 1 ) return(llh = get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	res = .Call(name = "dcclaplaceC1", Qbar = Qbarx, Z = stdresidsx, 
			dcca = as.double(dccax), dccb = as.double(dccbx),
			dccorder = as.numeric(dccorderx), dccsum = as.double(dccsumx))
	
	llh = res[[3]]
	
	if(is.finite(llh) | !is.na(llh) | !is.nan(llh)){
		assign(".llh", llh, envir = garchenv)
	} else {
		llh = (get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	return(llh)
}

laplace.dccLLH2 = function(pars, garchpars, data, returnType = "llh", garchenv)
{
	# prepare inputs
	# rejoin fixed and pars
	fixed = get("fixed", garchenv)
	fixid = get("fixid", garchenv)
	mspec = get("mspec", garchenv)
	npar = get("npar", garchenv)
	paridx = get("paridx", garchenv)
	m = dim(data)[2]
	T = dim(data)[1]
	speclist = get("speclist", garchenv)
	Hx = matrix(0, nrow = T, ncol = m)
	paridxa = get("paridxa", garchenv)
	resids = matrix(0, nrow = T, ncol = m)
	# simulate new H with which to standardize the dataset
	for(i in 1:m){
		specx = ugarchspec(mean.model = list(
						armaOrder = speclist@spec[[i]]@mean.model$armaOrder, 
						include.mean = speclist@spec[[i]]@mean.model$include.mean,
						garchInMean = speclist@spec[[i]]@mean.model$im, 
						inMeanType = speclist@spec[[i]]@mean.model$inMeanType, 
						arfima = speclist@spec[[i]]@mean.model$arfima, 
						external.regressors = speclist@spec[[i]]@mean.model$mexdata), 
				variance.model = list(
						model = speclist@spec[[i]]@variance.model$model, 
						garchOrder = speclist@spec[[i]]@variance.model$garchOrder,
						submodel = speclist@spec[[i]]@variance.model$submodel,
						external.regressors = speclist@spec[[i]]@variance.model$vexdata),
				distribution.model = speclist@spec[[i]]@distribution.model$distribution)
		fpars = garchpars[paridxa[i,1]:paridxa[i,2]]
		names(fpars) = specx@optimization.model$modelnames
		specx@optimization.model$fixed.pars = as.list(fpars)
		flt = ugarchfilter(spec = specx, data = data[,i])
		Hx[, i] = sigma(flt)
		resids[,i] = residuals(flt)
	}
	
	stdresidsx = resids/Hx
	
	Qbarx = cov(stdresidsx)
	
	if(!is.null(fixed)){
		pall = vector(mode = "numeric", length = npar)
		pall[fixid] = fixed
		pall[-fixid] = pars
		pars = pall
	}
	omodel = get("omodel", garchenv)
	fit.control = get("fit.control", garchenv)
	mo = omodel$maxOrder
	N = c(mo, T)
	dccOrder = mspec$dccOrder
	pos = omodel$pos.matrix
	
	stdresidsx = rbind( matrix(1, nrow = mo, ncol = m), stdresidsx )
	Hx = rbind( matrix(0, nrow = mo, ncol = m), Hx )
	
	dcca = dccb = skew = shape = 0
	if(pos[1,3] == 1) dcca = pars[pos[1,1]:pos[1,2]]
	if(pos[2,3] == 1) dccb = pars[pos[2,1]:pos[2,2]]
	if(pos[3,3] == 1) skew = pars[pos[3,1]:pos[3,2]]
	if(pos[4,3] == 1) shape = pars[pos[4,1]:pos[4,2]]	
	
	if( shape < 0.001 ) shape = 0.001
	
	dccsum = sum(dcca) + sum(dccb)
	dccax = dcca
	dccbx = dccb
	dccorderx = c(dccOrder, mo)
	dccsumx = sum(dcca) + sum(dccb)
	
	if( fit.control$stationarity ){
		if( !is.na(dccsumx) && dccsumx >= 1 ) return(llh = get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	res = .Call(name = "dcclaplaceC2", Qbar = Qbarx, H = Hx, Z = stdresidsx, 
			dcca = as.numeric(dccax), dccb = as.numeric(dccbx), 
			dccorder = as.numeric(dccorderx), dccsum = as.numeric(dccsumx))
	
	Qtout = res[[1]]
	likelihoods = res[[2]]
	llh = res[[3]]
	Rtout = res[[4]]
	Qtout = Qtout[(mo+1):(mo+T)]
	Rtout = Rtout[(mo+1):(mo+T)]
	likelihoods = likelihoods[(mo+1):(mo+T)]
	
	if(is.finite(llh) | !is.na(llh) | !is.nan(llh)){
		assign(".llh", llh, envir = garchenv)
	} else {
		llh = (get(".llh", garchenv) + 0.1*(abs(get(".llh", garchenv))))
	}
	
	ans = switch(returnType,
			lik = likelihoods,
			llh = llh,
			all = list(lik = likelihoods, llh = llh, Rt = Rtout, Qt = Qtout))
	return(ans)
}

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.