Nothing
R/arfima-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.
##
#################################################################################
#----------------------------------------------------------------------------------
# univariate spec method
#----------------------------------------------------------------------------------
arfimaspec = function( mean.model = list(armaOrder = c(1,1), include.mean = TRUE, arfima = FALSE,
external.regressors = NULL),
distribution.model = "norm", start.pars = list(), fixed.pars = list(), ...)
{
UseMethod("arfimaspec")
}
.xarfimaspec = function( mean.model = list(armaOrder = c(1,1), include.mean = TRUE, arfima = FALSE,
external.regressors = NULL),
distribution.model = "norm", start.pars = list(), fixed.pars = list(), ...)
{
# some checks and preparation to be passed on to specific models by switch
# distribution model
dmodel = list()
if(is.null(distribution.model)) dmodel$distribution = "norm"
valid.distribution = c("norm", "snorm", "std", "sstd","ged", "sged", "nig", "ghyp", "jsu")
dmodel$distribution = distribution.model
if(!is.character(dmodel$distribution[1]))
stop("\narfimaspec-->error: cond.distribution argument must be a character")
if(!any(dmodel$distribution == valid.distribution))
stop("\narfimaspec-->error: the cond.distribution does not appear to be a valid choice.")
if(length(dmodel$distribution)!=1) dmodel$distribution = dmodel$distribution[1]
dmodel$distno = which(dmodel$distribution == valid.distribution)
di = .DistributionBounds(dmodel$distribution)
dmodel$include.dlambda = di$include.dlambda
dmodel$include.skew = di$include.skew
dmodel$include.shape = di$include.shape
# mean model:
mmodel=list()
if(is.null(mean.model$armaOrder)) mmodel$armaOrder = c(1,1) else mmodel$armaOrder = mean.model$armaOrder
if(is.null(mean.model$include.mean)) mmodel$include.mean = TRUE else mmodel$include.mean = mean.model$include.mean
if(is.null(mean.model$arfima)) mmodel$arfima = FALSE else mmodel$arfima = mean.model$arfima
mmodel$external.regressors = mean.model$external.regressors
spec = .arfimaspec(mmodel, dmodel, start.pars, fixed.pars)
return(spec)
}
setMethod(f = "arfimaspec", definition = .xarfimaspec)
.getarfimaspec = function(object)
{
spec = arfimaspec(mean.model = list(armaOrder = object@model$armaOrder,
include.mean = object@model$include.mean,
arfima = object@model$arfima, external.regressors = object@model$mexdata),
distribution.model = object@model$distribution, start.pars = object@model$start.pars,
fixed.pars = object@model$start.pars)
return(spec)
}
setMethod(f = "getspec", signature(object = "ARFIMAfit"), definition = .getarfimaspec)
arfimafit = function(spec, data, out.sample = 0, solver = "solnp", solver.control = list(),
fit.control = list(fixed.se = 0, scale = 0), ...)
{
UseMethod("arfimafit")
}
setMethod("arfimafit", signature(spec = "ARFIMAspec"), .arfimafit)
arfimafilter = function(spec, data, out.sample = 0, n.old = NULL, ...)
{
UseMethod("arfimafilter")
}
setMethod("arfimafilter", signature(spec = "ARFIMAspec"), .arfimafilter)
arfimaforecast = function(fitORspec, data = NULL, n.ahead = 10, n.roll = 0, out.sample = 0,
external.forecasts = list(mregfor = NULL), ...)
{
UseMethod("arfimaforecast")
}
setMethod("arfimaforecast", signature(fitORspec = "ARFIMAfit"), .arfimaforecast)
setMethod("arfimaforecast", signature(fitORspec = "ARFIMAspec"), .arfimaforecast2)
arfimasim = function(fit, n.sim = 1000, n.start = 0, m.sim = 1, startMethod = c("unconditional","sample"),
prereturns = NA, preresiduals = NA, rseed = NA, custom.dist = list(name = NA, distfit = NA, type = "z"),
mexsimdata = NULL, ...)
{
UseMethod("arfimasim")
}
setMethod("arfimasim", signature(fit = "ARFIMAfit"), .arfimasim)
arfimapath = function(spec, n.sim = 1000, n.start = 0, m.sim = 1, prereturns = NA, preresiduals = NA,
rseed = NA, custom.dist = list(name = NA, distfit = NA, type = "z"), mexsimdata = NULL, ...)
{
UseMethod("arfimapath")
}
setMethod("arfimapath", signature(spec = "ARFIMAspec"), .arfimapath)
arfimaroll = function(spec, data, n.ahead = 1, forecast.length = 500,
refit.every = 25, refit.window = c("recursive", "moving"), parallel = FALSE,
parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2),
solver = "solnp", fit.control = list(), solver.control = list() ,
calculate.VaR = TRUE, VaR.alpha = c(0.01, 0.05), ...)
{
setMethod("arfimaroll")
}
setMethod("arfimaroll", signature(spec = "ARFIMAspec"), definition = .arfimaroll)
arfimadistribution = function(fitORspec, data = NULL, n.sim = 2000, n.start = 1,
m.sim = 100, recursive = FALSE, recursive.length = 6000, recursive.window = 1000,
prereturns = NA, preresiduals = NA, rseed = NA, custom.dist = list(name = NA, distfit = NA, type = "z"),
mexsimdata = NULL, fit.control = list(), solver = "solnp",
solver.control = list(), parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
setMethod("arfimadistribution")
}
setMethod("arfimadistribution", signature(fitORspec = "ARFIMAfit"), .arfimadistribution)
setMethod("arfimadistribution", signature(fitORspec = "ARFIMAspec"), .arfimadistribution)
setMethod("fpm", signature(object = "ARFIMAforecast"), .fpmarfima)
# forecast performance measures
.arfimarollreport = function(object, type = "VaR", n.ahead = 1, VaR.alpha = 0.01, conf.level = 0.95)
{
switch(type,
VaR = .rollVaRreportarfima(object, n.ahead, VaR.alpha, conf.level),
fpm = .rollfpmreportarfima(object, n.ahead))
invisible(object)
}
.rollfpmreportarfima = function(object, n.ahead = 1)
{
fpmobj = object@roll$fpm[[n.ahead]]
model = fpmobj@details$model
submodel = fpmobj@details$submodel
cat(paste("\nARFIMA Roll Forecast Performance Measures", sep = ""))
cat(paste("\n-----------------------------------------\n", sep = ""))
cat(paste("\nno.refits\t: ", object@roll$n.refit, sep = ""))
cat(paste("\nn.ahead\t\t: ", fpmobj@details$n.ahead, sep = ""))
cat(paste("\nn.roll\t\t: ", fpmobj@details$n.roll, sep = ""))
#cat(paste("\nfpm type : ", fpmobj@details$type, sep = ""))
cat(paste("\n\nForecasts w/th Performance Measures\n",n.ahead,"-ahead rolling\n", sep=""))
fc = matrix(fpmobj@forecasts$series, ncol = 1)
rfc = paste("roll-", seq(1, fpmobj@details$n.roll,by = 1), sep="")
rownames(fc) = rfc
fc = rbind(fc, fpmobj@seriesfpm$meanloss["mse"])
fc = rbind(fc, fpmobj@seriesfpm$meanloss["mad"])
fc = rbind(fc, fpmobj@seriesfpm$meanloss["dac"])
rownames(fc) = c(rfc, "mse", "mad", "dac")
colnames(fc) = ""
cat("\n")
if(dim(fc)[1]>14){
print(head(round(fc,5), 10), digits = 5)
cat("....... ........\n")
print(tail(round(fc,5), 5), digits = 5)
} else{
print(round(fc,6), digits = 5)
}
cat("\n\n")
}
.rollVaRreportarfima = function(object, n.ahead = 1, VaR.alpha = 0.01, conf.level = 0.95)
{
n = object@roll$n.ahead
v.a = object@roll$VaR.alpha
if(is.null(object@roll$VaR.out)) stop("\nplot-->error: VaR was not calculated for this object\n", call.=FALSE)
if(n.ahead > n) stop("\nplot-->error: n.ahead chosen is not valid for object\n", call.=FALSE)
if(!is.null(v.a) && !any(v.a==VaR.alpha[1])) stop("\nplot-->error: VaR.alpha chosen is invalid for the object\n", call.=FALSE)
if(is.list(object@roll$VaR.out)){
dvar = object@roll$VaR.out[[n.ahead]]
m = dim(dvar)[2]
idx = which(colnames(dvar) == paste("alpha(", round(VaR.alpha,2)*100, "%)",sep=""))
.VaRreport(object@roll$dataname, "ARFIMA", object@roll$distribution, p = VaR.alpha, actual=dvar[,m], VaR = dvar[, idx],
conf.level = conf.level)
} else{
dvar = object@roll$VaR.out
m = dim(dvar)[2]
idx = which(colnames(dvar) == paste("alpha(", round(VaR.alpha,2)*100, "%)",sep=""))
.VaRreport(object@roll$dataname, "ARFIMA", object@roll$distribution, p = VaR.alpha, actual=dvar[,m], VaR = dvar[, idx],
conf.level = conf.level)
}
invisible(object)
}
setMethod("report", signature(object = "ARFIMAroll"), .arfimarollreport)
#----------------------------------------------------------------------------------
# univariate fit extractors
#----------------------------------------------------------------------------------
# coef methods
.arfimafitcoef = function(object)
{
object@fit$coef
}
setMethod("coef", signature(object = "ARFIMAfit"), .arfimafitcoef)
.arfimafiltercoef = function(object)
{
object@filter$pars
}
setMethod("coef", signature(object = "ARFIMAfilter"), .arfimafiltercoef)
# multi-fit and multi-filter coefficients:
.arfimamultifitcoef = function(object)
{
if(object@model$type == "equal"){
ans = sapply(object@fit, FUN = function(x) coef(x), simplify = TRUE)
} else{
ans = lapply(object@fit, FUN = function(x) coef(x))
}
return(ans)
}
setMethod("coef", signature(object = "ARFIMAmultifit"), .arfimamultifitcoef)
.arfimamultifiltercoef = function(object)
{
ans = sapply(object@filter, FUN = function(x) coef(x), simplify = TRUE)
return(ans)
}
setMethod("coef", signature(object = "ARFIMAmultifilter"), .arfimamultifiltercoef)
# as.data.frame method for fitted object
.arfimafitdf = function(x, row.names = NULL, optional = FALSE, ...)
{
fit = x@fit
ans = data.frame(data = fit$data, fitted = fit$fitted.values,
residuals = fit$residuals)
rownames(ans) = as.character(fit$dates)
ans
}
setMethod("as.data.frame", signature(x = "ARFIMAfit"), .arfimafitdf)
#----------------------------------------------------------------------------------
# as.data.frame method for filter object
.arfimafilterdf = function(x, row.names = NULL, optional = FALSE, ...)
{
flt = x@filter
ans = data.frame(data = flt$data, fitted = flt$data - flt$residuals,
residuals = flt$residuals)
rownames(ans) = as.character(flt$dates)
ans
}
setMethod("as.data.frame", signature(x = "ARFIMAfilter"), .arfimafilterdf)
#----------------------------------------------------------------------------------
# as.data.frame method for forecast object
.arfimafordfall = function(x, aligned = TRUE, prepad = TRUE, type = 0)
{
if(aligned){
ans = .arfimafordf1(x = x, prepad = prepad)
} else{
ans = .arfimafordf2(x = x, type = type)
}
return(ans)
}
.arfimafordf1 = function(x, prepad = TRUE)
{
# return full frame with columns the rolls and rows the unique dates
# padded with NA for forecasts beyond n.ahead and actual filtered values
# for values before n.roll
forc = x@forecast
n.start = forc$n.start
N = x@forecast$N - n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
fdates = sort(unique(as.vector(sapply(forc$forecast, FUN=function(x) rownames(x)))))
tmp = matrix(NA, ncol = n.roll+1, nrow = length(fdates))
tmp[1:n.ahead, 1] = forc$forecast[[1]][,1]
for(i in 1:n.roll){
if(prepad) {
tmp[1:i, i+1] = x@filter$data[(N):(N+i-1)]
}
tmp[(i+1):(i+n.ahead), i+1] = forc$forecast[[i+1]][,1]
}
tmp = as.data.frame(tmp)
rownames(tmp) = fdates
colnames(tmp) = paste("roll-", seq(0, n.roll,by = 1), sep="")
tmp
}
# retval: 0 is the standard, returns all values
# retval: 1 returns only those values which have in sample equivalent data (for testing purposes)
# retval: 2 returns only those values which are truly forecasts without in sample data
.arfimafordf2 = function(x, type = 0, ...)
{
n.ahead = x@forecast$n.ahead
# n.start == out.sample
n.start = x@forecast$n.start
n.roll = x@forecast$n.roll
tlength = n.ahead + n.roll
mat = matrix(NA, ncol = n.roll + 1, nrow = n.ahead)
mat = sapply(x@forecast$forecast, FUN = function(x) x[,1])
if(is.vector(mat)) mat = matrix(mat, ncol = n.roll+1)
colnames(mat) = paste("roll-", seq(0, n.roll, by = 1), sep = "")
rownames(mat) = paste("t+", 1:n.ahead, sep = "")
if(n.roll == 0 | type == 0) return(as.data.frame(mat))
indices = apply(.embed(1:tlength, n.ahead, by = 1), 1, FUN = function(x) rev(x))
exc = which(indices>n.start)
if(type == 1){
if(length(exc)>0) mat[exc] = NA
} else{
if(length(exc)>0) mat[-exc] = NA
}
return(as.data.frame(mat))
}
# pad applies to when rollframe = "all", whether to pre-pad forecast with actual values else NA's
# post forecast values are always NA's (this relates to the out.sample option and n.roll)
.arfimafordf = function(x, row.names = NULL, optional = FALSE, rollframe = 0, aligned = TRUE,
prepad = TRUE, type = 0)
{
forc = x@forecast
n.start = forc$n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
if(!any(type==(0:2)))
stop("invalid argument for type in as.data.frame", call. = FALSE)
#if(rollframe == "all" && n.roll<=0) rollframe = 0
if(rollframe == "all") return(.arfimafordfall(x, aligned, prepad, type))
# allow type to be used here as well
rollframe = as.integer(rollframe)
if(rollframe>n.roll | rollframe<0) stop("rollframe out of bounds", call. = FALSE)
indx = (rollframe+1):(rollframe+n.ahead)
exc = which(indx>n.start)
ans = forc$forecast[[rollframe+1]]
if(type == 1){
if(length(exc)>0) ans[exc,] = NA
}
if(type == 2){
if(length(exc)>0) ans[-exc,] = NA
}
return(ans)
}
setMethod("as.data.frame", signature(x = "ARFIMAforecast"), .arfimafordf)
# as.array method for forecast object
.arfimaforar = function(x, ...)
{
forc = x@forecast
n.start = forc$n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
forar = array(NA, dim = c(n.ahead, 1, n.roll+1))
for(i in 1:(n.roll+1)){
forar[,,i] = as.matrix(forc$forecast[[i]])
}
return(forar)
}
setMethod("as.array", signature(x = "ARFIMAforecast"), .arfimaforar)
# as.list method for forecast object
.arfimaforlist = function(x, ...)
{
x@forecast$forecast
}
setMethod("as.list", signature(x = "ARFIMAforecast"), .arfimaforlist)
# as.list method for forecast object
.arfimamultiforlist = function(x, ...)
{
ans = lapply(x@forecast, FUN = function(x) x@forecast$forecast)
names(ans) = x@model$asset.names
ans
}
setMethod("as.list", signature(x = "ARFIMAmultiforecast"), .arfimamultiforlist)
.arfimamultiforarray = function(x, ...)
{
n = length(x@forecast)
ns = x@forecast[[1]]@forecast$n.roll
nah = x@forecast[[1]]@forecast$n.ahead
forar = array(NA, dim = c(nah, n, ns+1))
cnames = x@model$asset.names
rnames = paste("n.ahead-", 1:nah, sep = "")
dnames = paste("n.roll-", 0:ns, sep = "")
dimnames(forar) = list(rnames, cnames, dnames)
for(i in 1:(ns+1)) forar[,,i] = as.matrix(sapply(x@forecast, FUN = function(x) unlist(x@forecast$forecasts[[i]])))
return(forar)
}
setMethod("as.array", signature(x = "ARFIMAmultiforecast"), .arfimamultiforarray)
#----------------------------------------------------------------------------------
# as data.frame for fpm object
.arfimafpmdf = function(x, row.names = NULL, optional = FALSE, type = "meanloss", rollframe = 0, ...)
{
if(type == "meanloss"){
ans = as.data.frame(x@seriesfpm$meanloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$series) else colnames(ans) ="roll_t+1"
}
if(type == "medianloss"){
ans = as.data.frame(x@seriesfpm$medianloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$series) else colnames(ans) ="roll_t+1"
}
if(type == "loss")
{
ans = as.data.frame(x@seriesfpm$lossfn[[rollframe+1]])
}
return(ans)
}
setMethod("as.data.frame", signature(x = "ARFIMAfpm"), .arfimafpmdf)
#----------------------------------------------------------------------------------
# as.data.frame method for distribution object
.arfimadistdf = function(x, row.names = NULL, optional = FALSE, which = "coef", window = 1, ...)
{
n = x@dist$details$nwindows
if(window > n) stop("window size greater than actual available", call. = FALSE)
if(which == "rmse"){
ans = as.data.frame(t(x@dist[[window]]$rmse))
colnames(ans) = rownames(x@truecoef)
}
if(which == "stats"){
llh = x@dist[[window]]$likelist
uncmean = x@dist[[window]]$mlongrun
maxret = x@dist[[window]]$simmaxdata[,1]
minret = x@dist[[window]]$simmindata[,1]
meanret = x@dist[[window]]$simmeandata[,1]
kurtosis = x@dist[[window]]$simmomdata[,1]
skewness = x@dist[[window]]$simmomdata[,2]
ans = data.frame(llh = llh, uncmean = uncmean, maxret = maxret, minret = minret,
meanret = meanret, kurtosis = kurtosis, skewness = skewness)
}
if(which == "coef"){
cf = x@dist[[window]]$simcoef
ans = data.frame(coef = cf)
colnames(ans) = rownames(x@truecoef)
}
if(which == "coefse"){
cfe = x@dist[[window]]$simcoefse
ans = data.frame(coefse = cfe)
colnames(ans) = rownames(x@truecoef)
}
ans
}
setMethod("as.data.frame", signature(x = "ARFIMAdistribution"), .arfimadistdf)
#----------------------------------------------------------------------------------
# as.data.frame method for simulation object
.arfimasimdf = function(x, row.names = NULL, optional = FALSE, which = "series")
{
# simframe: series, residuals
#seriesSim=seriesSim, residSim=residSim
sim = x@simulation
dates = x@model$dates
resids = sim$residSim
m = dim(resids)[2]
N = dim(resids)[1]
fwdd = .generatefwd(dates, N = N, dformat = "%Y-%m-%d", periodicity = "days")
if(which == "series"){
series = sim$seriesSim
ans = data.frame(seriessim = series)
}
if(which == "residuals"){
resids = sim$residSim
ans = data.frame(residsim = resids)
}
rownames(ans) = as.character(fwdd)
ans
}
setMethod("as.data.frame", signature(x = "ARFIMAsim"), .arfimasimdf)
#----------------------------------------------------------------------------------
# as.data.frame method for path simulation object
.arfimapathdf = function(x, row.names = NULL, optional = FALSE, which = "series")
{
# simframe: sigma, series, residuals
#sigmaSim=sigmaSim, seriesSim=seriesSim, residSim=residSim
sim = x@path
resids = sim$residSim
m = dim(resids)[2]
N = dim(resids)[1]
if(which == "series"){
series = sim$seriesSim
ans = data.frame(seriessim = series)
}
if(which == "residuals"){
resids = sim$residSim
ans = data.frame(residsim = resids)
}
ans
}
setMethod("as.data.frame", signature(x = "ARFIMApath"), .arfimapathdf)
#----------------------------------------------------------------------------------
# as.data.frame method for bootstrap object
.arfimabootdf = function(x, row.names = NULL, optional = FALSE, type = "raw", qtile = c(0.01, 0.099))
{
n.ahead = x@model$n.ahead
if(type == "raw"){
series = x@fseries
ans = data.frame(bootseries = series)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
}
if(type == "q"){
if(all(is.numeric(qtile)) && (all(qtile<1.0) && all(qtile >0.0))){
series = x@fseries
ans = apply(series, 2, FUN = function(x) quantile(x, qtile))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = paste("q", qtile, sep = "")
} else{
stop("\nfor type q, the qtile value must be numeric and between (>)0 and 1(<)\n", call. = FALSE)
}
}
if(type == "summary"){
series = x@fseries
ans = apply(series, 2, FUN = function(x) c(min(x), quantile(x, 0.25), mean(x), quantile(x, 0.75), max(x) ))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = c("min", "q.25", "mean", "q.75", "max")
}
ans
}
#setMethod("as.data.frame", signature(x = "ARFIMAboot"), .arfimabootdf)
#----------------------------------------------------------------------------------
# as.data.frame method for roll object
# valid which = density, fpm, coefs
.arfimarolldf = function(x, row.names = NULL, optional = FALSE, which = "density", n.ahead = 1, refit = 1)
{
n = x@roll$n.ahead
if(n.ahead>n)
stop("n.ahead chosen exceeds roll object specification", call. = FALSE)
if(which == "coefs"){
ans = as.data.frame(x@roll$coefs)
rownames(ans) = paste("refit-", 1:dim(ans)[1], sep = "")
}
if(which == "density"){
ans = as.data.frame(x@roll$fdensity[[n.ahead]])
rownames(ans) = paste("roll-", 1:dim(ans)[1], sep = "")
}
if(which == "coefmat"){
ans = as.data.frame(x@roll$coefmat[[refit]])
}
if(which == "LLH"){
ans = as.data.frame(x@roll$LLH)
rownames(ans) = paste("refit-", 1:dim(ans)[1], sep = "")
colnames(ans) = "LLH"
}
if(which == "VaR"){
ans = as.data.frame(x@roll$VaR.out[[n.ahead]])
}
return(ans)
}
setMethod("as.data.frame", signature(x = "ARFIMAroll"), .arfimarolldf)
as.ARFIMAforecast = function(object, ...)
{
setMethod("as.ARFIMAforecast")
}
.roll2arfimaforc = function(object, refit = 1)
{
n = object@roll$n.refit
if(refit>n)
stop("refit chosen exceeds roll object specification", call. = FALSE)
object@forecast[[refit]]
}
setMethod("as.ARFIMAforecast", signature(object = "ARFIMAroll"), .roll2arfimaforc)
#----------------------------------------------------------------------------------
# residuals method
.arfimafitresids = function(object)
{
object@fit$residuals
}
setMethod("residuals", signature(object = "ARFIMAfit"), .arfimafitresids)
.arfimafilterresids = function(object)
{
object@filter$residuals
}
setMethod("residuals", signature(object = "ARFIMAfilter"), .arfimafilterresids)
.arfimamultifitresids = function(object)
{
sapply(object@fit, FUN = function(x) residuals(x), simplify = TRUE)
}
setMethod("residuals", signature(object = "ARFIMAmultifit"), .arfimamultifitresids)
.arfimamultifilterresids = function(object)
{
sapply(object@filter, FUN = function(x) residuals(x), simplify = TRUE)
}
setMethod("residuals", signature(object = "ARFIMAmultifilter"), .arfimamultifilterresids)
#----------------------------------------------------------------------------------
# Likelihood method
.arfimafitLikelihood = function(object)
{
return(object@fit$LLH)
}
setMethod("likelihood", signature(object = "ARFIMAfit"), .arfimafitLikelihood)
.arfimafilterLikelihood = function(object)
{
return(object@filter$LLH)
}
setMethod("likelihood", signature(object = "ARFIMAfilter"), .arfimafilterLikelihood)
.arfimamultifilterLikelihood = function(object)
{
sapply(object@filter, FUN = function(x) likelihood(x), simplify = TRUE)
}
setMethod("likelihood", signature(object = "ARFIMAmultifilter"), .arfimamultifilterLikelihood)
.arfimamultifitLikelihood = function(object)
{
sapply(object@fit, FUN = function(x) likelihood(x), simplify = TRUE)
}
setMethod("likelihood", signature(object = "ARFIMAmultifit"), .arfimamultifitLikelihood)
#----------------------------------------------------------------------------------
# Fitted method
.arfimafitted = function(object)
{
return(object@fit$fitted.values)
}
setMethod("fitted", signature(object = "ARFIMAfit"), .arfimafitted)
.arfimafiltered = function(object)
{
return(object@filter$data - object@filter$residuals)
}
setMethod("fitted", signature(object = "ARFIMAfilter"), .arfimafiltered)
.arfimamultifiltered = function(object)
{
sapply(object@filter, FUN = function(x) x@filter$data - residuals(x), simplify = TRUE)
}
setMethod("fitted", signature(object = "ARFIMAmultifilter"), .arfimamultifiltered)
.arfimamultifitted = function(object)
{
sapply(object@fit, FUN = function(x) x@fit$data - residuals(x), simplify = TRUE)
}
setMethod("fitted", signature(object = "ARFIMAmultifit"), .arfimamultifitted)
#----------------------------------------------------------------------------------
# Info Criteria method
.arfimainfocriteria = function(object)
{
itest = .information.test(likelihood(object), nObs = length(fitted(object)),
nPars = length(coef(object)))
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 = "ARFIMAfit"), .arfimainfocriteria)
setMethod("infocriteria", signature(object = "ARFIMAfilter"), .arfimainfocriteria)
#----------------------------------------------------------------------------------
# The mult- methods
#----------------------------------------------------------------------------------
.multispecarfima = function( speclist )
{
# first create a spec which goes through validation process
tp = 1
ans = new("ARFIMAmultispec",
spec = speclist,
type = "equal")
# then check type
n = length(speclist)
for(i in 2:n){
if(length(speclist[[i]]@optimization.model$modelnames)!=length(speclist[[i-1]]@optimization.model$modelnames))
{
tp = 0
break()
} else{
if(!all(speclist[[i]]@optimization.model$modelnames == speclist[[i-1]]@optimization.model$modelnames))
{
tp = 0
break()
}
}
}
if(tp) type = "equal" else type = "unequal"
ans = new("ARFIMAmultispec",
spec = speclist,
type = type)
return(ans)
}
setMethod("multifit", signature(multispec = "ARFIMAmultispec"), definition = .multifitarfima)
setMethod("multifilter", signature(multifitORspec = "ARFIMAmultifit"), definition = .multifilterarfima1)
setMethod("multifilter", signature(multifitORspec = "ARFIMAmultispec"), definition = .multifilterarfima2)
setMethod("multiforecast", signature(multifitORspec = "ARFIMAmultifit"), definition = .multiforecastarfima1)
setMethod("multiforecast", signature(multifitORspec = "ARFIMAmultispec"), definition = .multiforecastarfima2)
#----------------------------------------------------------------------------------
#----------------------------------------------------------------------------------
# univariate plot method / seperate for fit,sim and forecast
#----------------------------------------------------------------------------------
#setMethod(f = "plot", signature(x = "ARFIMAfit", y = "missing"), .plotarfimafit)
#setMethod(f = "plot", signature(x = "ARFIMAfilter", y = "missing"), .plotarfimafilter)
#setMethod(f = "plot", signature(x = "ARFIMAsim", y = "missing"), .plotarfimasim)
#setMethod(f = "plot", signature(x = "ARFIMAforecast", y = "missing"), .plotarfimaforecast)
#setMethod(f = "plot", signature(x = "ARFIMApath", y = "missing"), .plotarfimapath)
#setMethod(f = "plot", signature(x = "ARFIMAroll", y = "missing"), .plotarfimaroll)
#setMethod(f = "plot", signature(x = "ARFIMAdistribution", y = "missing"), .plotarfimadist)
# spec show
setMethod("show",
signature(object = "ARFIMAspec"),
function(object){
model = strsplit(class(object), "spec")
cat(paste("\n*-----------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Spec *", sep = ""))
cat(paste("\n*-----------------------------*", sep = ""))
cat("\n\nMean Model")
cat(paste("\n-------------------------------\n",sep=""))
cat("Include Mean\t: ", as.logical(object@mean.model$include.mean),"\n")
cat("AR-MA Order\t\t: ",object@mean.model$armaOrder[1:2],"\n")
cat("Include ARFIMA\t: ", as.logical(object@mean.model$arfima),"\n")
if(object@mean.model$include.mex)
cat(paste("Exogenous Regressor Dimension: ",
dim(object@mean.model$mexdata)[2],"\n",sep=""))
cat("\nConditional Distribution Model")
cat(paste("\n-------------------------------\n",sep=""))
cat("Distribution\t: ",object@distribution.model$distribution,"\n")
cat("Includes Lambda\t: ", as.logical(object@distribution.model$include.dlambda),"\n")
cat("Includes Skew\t: ", as.logical(object@distribution.model$include.skew),"\n")
cat("Includes Shape\t: ", as.logical(object@distribution.model$include.shape),"\n\n")
invisible(object)
})
# fit show
setMethod("show",
signature(object = "ARFIMAfit"),
function(object){
cat(paste("\n*-----------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Fit *", sep = ""))
cat(paste("\n*-----------------------------*", sep = ""))
cat("\n\nInclude Mean\t: ", object@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@model$armaOrder[1],",",
as.integer(object@model$arfima),
",",object@model$armaOrder[2],")",sep=""))
if(object@model$include.mex){
cat("\nExogenous Regressors: ",object@model$mxn)
} else{
cat("\nExogenous Regressors: none")
}
cat("\nConditional Distribution: ",object@model$distribution,"\n")
if(object@fit$convergence == 0){
cat("\nOptimal Parameters")
cat(paste("\n--------------------------\n", sep = ""))
print(round(object@fit$matcoef,6), digits = 5)
cat("\nRobust Standard Errors:\n")
print(round(object@fit$robust.matcoef,6), digits = 5)
if(!is.null(object@fit$hessian.message)){
cat(paste("\n", object@fit$hessian.message))
}
cat("\nLogLikelihood :", object@fit$LLH, "\n")
stdresid = object@fit$residuals/coef(object)["sigma"]
itest = .information.test(object@fit$LLH, nObs = length(object@fit$data),
nPars=length(coef(object)))
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")
print(itestm, digits = 5)
cat("\n\n")
cat("\nElapsed time :", object@fit$timer,"\n\n")
} else{
cat("\nConvergence Problem:")
cat("\nSolver Message:", object@fit$message,"\n\n")
}
invisible(object)
})
# filter show
setMethod("show",
signature(object = "ARFIMAfilter"),
function(object){
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Filter *", sep = ""))
cat(paste("\n*--------------------------------*", sep = ""))
cat("\n\nInclude Mean\t: ", object@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@model$armaOrder[1],",",
as.integer(object@model$arfima),
",",object@model$armaOrder[2],")",sep=""))
if(object@model$include.mex){
cat("\nExogenous Regressors : ",object@model$mxn)
} else{
cat("\nExogenous Regressors : none")
}
cat("\nConditional Distribution : ",object@model$distribution,"\n")
cat("\nFilter Parameters")
cat(paste("\n--------------------------\n", sep = ""))
print(matrix(object@filter$pars, ncol=1,
dimnames = list(names(coef(object)), "")), digits = 5)
cat("\nLogLikelihood :", object@filter$LLH, "\n")
stdresid = object@filter$residuals/coef(object)["sigma"]
itest = .information.test(object@filter$LLH, nObs = length(object@filter$data),
nPars = length(coef(object)))
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")
print(itestm, digits = 5)
cat("\n\n")
cat("\nElapsed time :", object@filter$timer,"\n\n")
invisible(object)
})
# sim show
setMethod("show",
signature(object = "ARFIMAsim"),
function(object){
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Simulation *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
sim = object@simulation
dates = object@model$dates
series = sim$seriesSim
resids = sim$residSim
m = dim(series)[2]
N = dim(series)[1]
cat(paste("\n\nHorizon: ",N))
cat(paste("\nSimulations: ",m,"\n",sep=""))
rx1 = apply(series, 2, FUN=function(x) mean(x))
rx2 = apply(series, 2, FUN=function(x) range(x))
actual = c(0, mean(object@simulation$series),
min(object@simulation$series), max(object@simulation$series))
dd = data.frame(Seed = object@seed, Series.Mean = rx1, Series.Min = rx2[1,],
Series.Max = rx2[2,])
meansim = apply(dd, 2, FUN = function(x) mean(x))
meansim[1] = 0
dd = rbind(dd, meansim, actual)
rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)", "Actual")
print(dd,digits = 3)
cat("\n\n")
})
# forecast show
setMethod("show",
signature(object = "ARFIMAforecast"),
function(object){
cat(paste("\n*----------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Forecast *", sep = ""))
cat(paste("\n*----------------------------------*", sep = ""))
n.ahead = object@forecast$n.ahead
cat(paste("\n\nHorizon: ", n.ahead, sep = ""))
cat(paste("\nRoll Steps: ",object@forecast$n.roll, sep = ""))
n.start = object@forecast$n.start
if(n.start>0) infor = ifelse(n.ahead>n.start, n.start, n.ahead) else infor = 0
cat(paste("\nOut of Sample: ", infor, "\n", sep = ""))
cat("\n0-roll forecast: \n")
zz = object@forecast$forecast[[1]]
print(zz, digits = 4)
cat("\n\n")
})
# path show
setMethod("show",
signature(object = "ARFIMApath"),
function(object){
model = strsplit(class(object), "path")
cat(paste("\n*--------.........------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Path Simulation *", sep = ""))
cat(paste("\n*-----------------------------------------*", sep = ""))
sim = object@path
series = sim$seriesSim
resids = sim$residSim
m = dim(series)[2]
N = dim(series)[1]
cat(paste("\n\nHorizon: ", N))
cat(paste("\nSimulations: ", m, "\n", sep = ""))
rx1 = apply(series, 2, FUN = function(x) mean(x))
rx2 = apply(series, 2, FUN = function(x) range(x))
dd = data.frame(Seed = object@seed, Series.Mean = rx1, Series.Min = rx2[1,],
Series.Max = rx2[2,])
meansim = apply(dd, 2, FUN = function(x) mean(x))
meansim[1] = 0
dd = rbind(dd, meansim)
rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)")
print(dd, digits = 3)
cat("\n\n")
})
# distribution show
setMethod("show",
signature(object = "ARFIMAdistribution"),
function(object){
cat(paste("\n*------------------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Parameter Distribution *", sep = ""))
cat(paste("\n*------------------------------------------*", sep = ""))
cat(paste("\n\nNo. Paths (m.sim) : ", object@dist$details$m.sim, sep = ""))
cat(paste("\nLength of Paths (n.sim) : ", object@dist$details$n.sim, sep = ""))
cat(paste("\nRecursive : ", object@dist$details$recursive, sep = ""))
if(object@dist$details$recursive){
cat(paste("\nRecursive Length : ", object@dist$details$recursive.length, sep = ""))
cat(paste("\nRecursive Window : ", object@dist$details$recursive.window, sep = ""))
}
cat("\n\n")
cat("Coefficients: True vs Simulation Mean (Window-n)\n")
nwindows = object@dist$details$nwindows
nm = object@dist$details$n.sim + (0:(nwindows-1))*object@dist$details$recursive.window
ns = matrix(0, ncol = dim(object@truecoef)[1], nrow = nwindows)
for(i in 1:nwindows){
ns[i,] = apply(as.data.frame(object, window = i), 2, FUN = function(x) mean(x, na.rm = T))
}
ns = rbind(object@truecoef[,1], ns)
colnames(ns) = rownames(object@truecoef)
rownames(ns) = c("true-coef",paste("window-", nm, sep=""))
print(as.data.frame(ns), digits=5)
for(i in 1:nwindows){
if(any(object@dist[[i]]$convergence==1)) n = length(which(object@dist[[i]]$convergence==1)) else n = 0
if(n>0) cat(paste("\nwindow-",nm[i]," no. of non-converged fits: ", n, "\n",sep=""))
}
cat("\n\n")
})
# fpm show
setMethod("show",
signature(object = "ARFIMAfpm"),
function(object){
cat(paste("\n*---------------------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Forecast Performance Measures *", sep = ""))
cat(paste("\n*---------------------------------------------*", sep = ""))
cat(paste("\n\nn.ahead : ", object@details$n.ahead, sep = ""))
cat(paste("\nn.roll : ", object@details$n.roll, sep = ""))
cat(paste("\nfpm type : ", object@details$type, sep = ""))
if(object@details$type==2){
cat("\nForecasts w/th Mean Loss Functions\n(1-ahead rolling)\n")
fc = NULL
fc = rbind(fc, object@seriesfpm$meanloss["mse"])
fc = rbind(fc, object@seriesfpm$meanloss["mad"])
fc = rbind(fc, object@seriesfpm$meanloss["dac"])
colnames(fc) = c("series")
rownames(fc) = c("MSE", "MAD", "DAC")
cat("\n")
print(round(fc,6), digits = 5)
} else{
cat("\nMean Loss Functions\n(n.ahead/n.roll)\n")
cat("\nseries\n")
fc1 = object@seriesfpm$meanloss
colnames(fc1) = colnames(object@forecasts$series)
print(t(fc1), digits=5)
}
cat("\n\n")
})
#-------------------------------------------------------------------------
# multi-methods
setMethod("show",
signature(object = "ARFIMAmultispec"),
function(object){
cat(paste("\n*---------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Multi-Spec *", sep = ""))
cat(paste("\n*---------------------------------*", sep = ""))
N = length(object@spec)
cat(paste("\n\nMultiple Specifications\t: ", N, sep=""))
cat(paste("\nMulti-Spec Type\t\t\t: ", object@type, sep=""))
cat("\n")
invisible(object)
})
setMethod("show",
signature(object = "ARFIMAmultifit"),
function(object){
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Multi-Fit *", sep = ""))
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n\nNo. Assets :", length(object@fit), sep=""))
asset.names = object@model$asset.names
if(object@model$type == "equal"){
cat(paste("\nMulti-Spec Type : Equal",sep=""))
cat(paste("\n\nModel Spec",sep=""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\nInclude Mean\t: ", object@fit[[1]]@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@fit[[1]]@model$armaOrder[1],",",
as.integer(object@fit[[1]]@model$arfima),
",",object@fit[[1]]@model$armaOrder[2],")",sep=""))
if(object@fit[[1]]@model$include.mex){
cat("\nExogenous Regressors\t: ",object@fit[[1]]@model$mxn)
} else{
cat("\nExogenous Regressors\t: none")
}
cat("\n\nConditional Distribution:",object@fit[[1]]@model$distribution,"\n")
cv = sapply(object@fit, FUN = function(x) x@fit$convergence)
if(any(cv != 0)){
ncv = which(cv != 0)
nncv = length(ncv)
cat("\nNo. of non converged fits: ", ncv,"\n")
if(ncv>0) cat("\nNon converged fits: ", nncv,"\n")
} else{
cat(paste("\nModel Fit", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\n")
ll = t(likelihood(object))
rownames(ll) = "Log-Lik"
cf = coef(object)
colnames(cf) = asset.names
print(round(rbind(cf, ll), digits = 5))
cat("\n")
}
} else{
cat(paste("\nARFIMA Model Fit", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat(paste("\nModel Fit", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\n")
print(coef(object), digits = 5)
}
invisible(object)
})
setMethod("show",
signature(object = "ARFIMAmultifilter"),
function(object){
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Multi-Filter *", sep = ""))
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n\nNo. Assets :", length(object@filter), sep=""))
asset.names = object@model$asset.names
if(object@model$type == "equal"){
cat(paste("\nMulti-Spec Type : Equal",sep=""))
cat(paste("\n\nModel Spec",sep=""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\nInclude Mean\t: ", object@filter[[1]]@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@filter[[1]]@model$armaOrder[1],",",
as.integer(object@filter[[1]]@model$arfima),
",",object@filter[[1]]@model$armaOrder[2],")",sep=""))
if(object@filter[[1]]@model$include.mex){
cat("\nExogenous Regressors\t: ",object@filter[[1]]@model$mxn)
} else{
cat("\nExogenous Regressors\t: none")
}
cat("\n\nConditional Distribution:",object@filter[[1]]@model$distribution,"\n")
cat(paste("\nModel Filter", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\n")
ll = t(likelihood(object))
rownames(ll) = "Log-Lik"
cf = coef(object)
colnames(cf) = asset.names
print(round(rbind(cf, ll), digits = 5))
cat("\n")
} else{
cat(paste("\nARFIMA Model Filter", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat(paste("\nModel Fit", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\n")
print(coef(object), digits = 5)
}
invisible(object)
})
setMethod("show",
signature(object = "ARFIMAmultiforecast"),
function(object){
asset.names = object@model$asset.names
cat(paste("\n*----------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Multi-Forecast *", sep = ""))
cat(paste("\n*----------------------------------*", sep = ""))
cat(paste("\n\nNo. Assets :", length(object@forecast), sep=""))
cat(paste("\n--------------------------\n",sep=""))
fc = as.array(object)
print(fc, digits = 5)
invisible(object)
})
.uncarfima = function(object)
{
include.mean = object@model$include.mean
if(is(object, "ARFIMAfilter")){
data = object@filter$data
} else{
data = object@fit$data
}
N = length(data)
arfima = object@model$arfima
include.mex = object@model$include.mex
pars = coef(object)
if(include.mex){
mxn = object@model$mxn
mxreg = coef(object)[paste("mxreg", 1:mxn, sep="")]
if(is(object, "ARFIMAfilter")){
mexdata = as.matrix(object@model$mexdata[1:N, 1:mxn])
} else{
mexdata = as.matrix(object@model$mexdata[1:N, 1:mxn])
}
meanmex = apply(mexdata, 2, "mean")
umeanmex = sum(mxreg*meanmex)
} else{
umeanmex = 0
}
if(include.mean) mu = coef(object)["mu"] else mu = 0
#if(arfima){
# umean = mu + umeanmex
#} else{
# armaOrder = object@model$armaOrder
# if(armaOrder[1] == 0) {
# umean = mu + umeanmex
# } else{
# ar = sum(coef(object)[paste("ar", 1:armaOrder[1], sep="")])
# umean = (mu + umeanmex)/(1 - ar)
# }
#}
umean = mu + umeanmex
return(umean)
}
setMethod("uncmean", signature(object = "ARFIMAfit"), definition = .uncarfima)
setMethod("uncmean", signature(object = "ARFIMAfilter"), definition = .uncarfima)
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
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#################################################################################
##
## 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.
##
#################################################################################
#----------------------------------------------------------------------------------
# univariate spec method
#----------------------------------------------------------------------------------
arfimaspec = function( mean.model = list(armaOrder = c(1,1), include.mean = TRUE, arfima = FALSE,
external.regressors = NULL),
distribution.model = "norm", start.pars = list(), fixed.pars = list(), ...)
{
UseMethod("arfimaspec")
}
.xarfimaspec = function( mean.model = list(armaOrder = c(1,1), include.mean = TRUE, arfima = FALSE,
external.regressors = NULL),
distribution.model = "norm", start.pars = list(), fixed.pars = list(), ...)
{
# some checks and preparation to be passed on to specific models by switch
# distribution model
dmodel = list()
if(is.null(distribution.model)) dmodel$distribution = "norm"
valid.distribution = c("norm", "snorm", "std", "sstd","ged", "sged", "nig", "ghyp", "jsu")
dmodel$distribution = distribution.model
if(!is.character(dmodel$distribution[1]))
stop("\narfimaspec-->error: cond.distribution argument must be a character")
if(!any(dmodel$distribution == valid.distribution))
stop("\narfimaspec-->error: the cond.distribution does not appear to be a valid choice.")
if(length(dmodel$distribution)!=1) dmodel$distribution = dmodel$distribution[1]
dmodel$distno = which(dmodel$distribution == valid.distribution)
di = .DistributionBounds(dmodel$distribution)
dmodel$include.dlambda = di$include.dlambda
dmodel$include.skew = di$include.skew
dmodel$include.shape = di$include.shape
# mean model:
mmodel=list()
if(is.null(mean.model$armaOrder)) mmodel$armaOrder = c(1,1) else mmodel$armaOrder = mean.model$armaOrder
if(is.null(mean.model$include.mean)) mmodel$include.mean = TRUE else mmodel$include.mean = mean.model$include.mean
if(is.null(mean.model$arfima)) mmodel$arfima = FALSE else mmodel$arfima = mean.model$arfima
mmodel$external.regressors = mean.model$external.regressors
spec = .arfimaspec(mmodel, dmodel, start.pars, fixed.pars)
return(spec)
}
setMethod(f = "arfimaspec", definition = .xarfimaspec)
.getarfimaspec = function(object)
{
spec = arfimaspec(mean.model = list(armaOrder = object@model$armaOrder,
include.mean = object@model$include.mean,
arfima = object@model$arfima, external.regressors = object@model$mexdata),
distribution.model = object@model$distribution, start.pars = object@model$start.pars,
fixed.pars = object@model$start.pars)
return(spec)
}
setMethod(f = "getspec", signature(object = "ARFIMAfit"), definition = .getarfimaspec)
arfimafit = function(spec, data, out.sample = 0, solver = "solnp", solver.control = list(),
fit.control = list(fixed.se = 0, scale = 0), ...)
{
UseMethod("arfimafit")
}
setMethod("arfimafit", signature(spec = "ARFIMAspec"), .arfimafit)
arfimafilter = function(spec, data, out.sample = 0, n.old = NULL, ...)
{
UseMethod("arfimafilter")
}
setMethod("arfimafilter", signature(spec = "ARFIMAspec"), .arfimafilter)
arfimaforecast = function(fitORspec, data = NULL, n.ahead = 10, n.roll = 0, out.sample = 0,
external.forecasts = list(mregfor = NULL), ...)
{
UseMethod("arfimaforecast")
}
setMethod("arfimaforecast", signature(fitORspec = "ARFIMAfit"), .arfimaforecast)
setMethod("arfimaforecast", signature(fitORspec = "ARFIMAspec"), .arfimaforecast2)
arfimasim = function(fit, n.sim = 1000, n.start = 0, m.sim = 1, startMethod = c("unconditional","sample"),
prereturns = NA, preresiduals = NA, rseed = NA, custom.dist = list(name = NA, distfit = NA, type = "z"),
mexsimdata = NULL, ...)
{
UseMethod("arfimasim")
}
setMethod("arfimasim", signature(fit = "ARFIMAfit"), .arfimasim)
arfimapath = function(spec, n.sim = 1000, n.start = 0, m.sim = 1, prereturns = NA, preresiduals = NA,
rseed = NA, custom.dist = list(name = NA, distfit = NA, type = "z"), mexsimdata = NULL, ...)
{
UseMethod("arfimapath")
}
setMethod("arfimapath", signature(spec = "ARFIMAspec"), .arfimapath)
arfimaroll = function(spec, data, n.ahead = 1, forecast.length = 500,
refit.every = 25, refit.window = c("recursive", "moving"), parallel = FALSE,
parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2),
solver = "solnp", fit.control = list(), solver.control = list() ,
calculate.VaR = TRUE, VaR.alpha = c(0.01, 0.05), ...)
{
setMethod("arfimaroll")
}
setMethod("arfimaroll", signature(spec = "ARFIMAspec"), definition = .arfimaroll)
arfimadistribution = function(fitORspec, data = NULL, n.sim = 2000, n.start = 1,
m.sim = 100, recursive = FALSE, recursive.length = 6000, recursive.window = 1000,
prereturns = NA, preresiduals = NA, rseed = NA, custom.dist = list(name = NA, distfit = NA, type = "z"),
mexsimdata = NULL, fit.control = list(), solver = "solnp",
solver.control = list(), parallel = FALSE, parallel.control = list(pkg = c("multicore", "snowfall"), cores = 2), ...)
{
setMethod("arfimadistribution")
}
setMethod("arfimadistribution", signature(fitORspec = "ARFIMAfit"), .arfimadistribution)
setMethod("arfimadistribution", signature(fitORspec = "ARFIMAspec"), .arfimadistribution)
setMethod("fpm", signature(object = "ARFIMAforecast"), .fpmarfima)
# forecast performance measures
.arfimarollreport = function(object, type = "VaR", n.ahead = 1, VaR.alpha = 0.01, conf.level = 0.95)
{
switch(type,
VaR = .rollVaRreportarfima(object, n.ahead, VaR.alpha, conf.level),
fpm = .rollfpmreportarfima(object, n.ahead))
invisible(object)
}
.rollfpmreportarfima = function(object, n.ahead = 1)
{
fpmobj = object@roll$fpm[[n.ahead]]
model = fpmobj@details$model
submodel = fpmobj@details$submodel
cat(paste("\nARFIMA Roll Forecast Performance Measures", sep = ""))
cat(paste("\n-----------------------------------------\n", sep = ""))
cat(paste("\nno.refits\t: ", object@roll$n.refit, sep = ""))
cat(paste("\nn.ahead\t\t: ", fpmobj@details$n.ahead, sep = ""))
cat(paste("\nn.roll\t\t: ", fpmobj@details$n.roll, sep = ""))
#cat(paste("\nfpm type : ", fpmobj@details$type, sep = ""))
cat(paste("\n\nForecasts w/th Performance Measures\n",n.ahead,"-ahead rolling\n", sep=""))
fc = matrix(fpmobj@forecasts$series, ncol = 1)
rfc = paste("roll-", seq(1, fpmobj@details$n.roll,by = 1), sep="")
rownames(fc) = rfc
fc = rbind(fc, fpmobj@seriesfpm$meanloss["mse"])
fc = rbind(fc, fpmobj@seriesfpm$meanloss["mad"])
fc = rbind(fc, fpmobj@seriesfpm$meanloss["dac"])
rownames(fc) = c(rfc, "mse", "mad", "dac")
colnames(fc) = ""
cat("\n")
if(dim(fc)[1]>14){
print(head(round(fc,5), 10), digits = 5)
cat("....... ........\n")
print(tail(round(fc,5), 5), digits = 5)
} else{
print(round(fc,6), digits = 5)
}
cat("\n\n")
}
.rollVaRreportarfima = function(object, n.ahead = 1, VaR.alpha = 0.01, conf.level = 0.95)
{
n = object@roll$n.ahead
v.a = object@roll$VaR.alpha
if(is.null(object@roll$VaR.out)) stop("\nplot-->error: VaR was not calculated for this object\n", call.=FALSE)
if(n.ahead > n) stop("\nplot-->error: n.ahead chosen is not valid for object\n", call.=FALSE)
if(!is.null(v.a) && !any(v.a==VaR.alpha[1])) stop("\nplot-->error: VaR.alpha chosen is invalid for the object\n", call.=FALSE)
if(is.list(object@roll$VaR.out)){
dvar = object@roll$VaR.out[[n.ahead]]
m = dim(dvar)[2]
idx = which(colnames(dvar) == paste("alpha(", round(VaR.alpha,2)*100, "%)",sep=""))
.VaRreport(object@roll$dataname, "ARFIMA", object@roll$distribution, p = VaR.alpha, actual=dvar[,m], VaR = dvar[, idx],
conf.level = conf.level)
} else{
dvar = object@roll$VaR.out
m = dim(dvar)[2]
idx = which(colnames(dvar) == paste("alpha(", round(VaR.alpha,2)*100, "%)",sep=""))
.VaRreport(object@roll$dataname, "ARFIMA", object@roll$distribution, p = VaR.alpha, actual=dvar[,m], VaR = dvar[, idx],
conf.level = conf.level)
}
invisible(object)
}
setMethod("report", signature(object = "ARFIMAroll"), .arfimarollreport)
#----------------------------------------------------------------------------------
# univariate fit extractors
#----------------------------------------------------------------------------------
# coef methods
.arfimafitcoef = function(object)
{
object@fit$coef
}
setMethod("coef", signature(object = "ARFIMAfit"), .arfimafitcoef)
.arfimafiltercoef = function(object)
{
object@filter$pars
}
setMethod("coef", signature(object = "ARFIMAfilter"), .arfimafiltercoef)
# multi-fit and multi-filter coefficients:
.arfimamultifitcoef = function(object)
{
if(object@model$type == "equal"){
ans = sapply(object@fit, FUN = function(x) coef(x), simplify = TRUE)
} else{
ans = lapply(object@fit, FUN = function(x) coef(x))
}
return(ans)
}
setMethod("coef", signature(object = "ARFIMAmultifit"), .arfimamultifitcoef)
.arfimamultifiltercoef = function(object)
{
ans = sapply(object@filter, FUN = function(x) coef(x), simplify = TRUE)
return(ans)
}
setMethod("coef", signature(object = "ARFIMAmultifilter"), .arfimamultifiltercoef)
# as.data.frame method for fitted object
.arfimafitdf = function(x, row.names = NULL, optional = FALSE, ...)
{
fit = x@fit
ans = data.frame(data = fit$data, fitted = fit$fitted.values,
residuals = fit$residuals)
rownames(ans) = as.character(fit$dates)
ans
}
setMethod("as.data.frame", signature(x = "ARFIMAfit"), .arfimafitdf)
#----------------------------------------------------------------------------------
# as.data.frame method for filter object
.arfimafilterdf = function(x, row.names = NULL, optional = FALSE, ...)
{
flt = x@filter
ans = data.frame(data = flt$data, fitted = flt$data - flt$residuals,
residuals = flt$residuals)
rownames(ans) = as.character(flt$dates)
ans
}
setMethod("as.data.frame", signature(x = "ARFIMAfilter"), .arfimafilterdf)
#----------------------------------------------------------------------------------
# as.data.frame method for forecast object
.arfimafordfall = function(x, aligned = TRUE, prepad = TRUE, type = 0)
{
if(aligned){
ans = .arfimafordf1(x = x, prepad = prepad)
} else{
ans = .arfimafordf2(x = x, type = type)
}
return(ans)
}
.arfimafordf1 = function(x, prepad = TRUE)
{
# return full frame with columns the rolls and rows the unique dates
# padded with NA for forecasts beyond n.ahead and actual filtered values
# for values before n.roll
forc = x@forecast
n.start = forc$n.start
N = x@forecast$N - n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
fdates = sort(unique(as.vector(sapply(forc$forecast, FUN=function(x) rownames(x)))))
tmp = matrix(NA, ncol = n.roll+1, nrow = length(fdates))
tmp[1:n.ahead, 1] = forc$forecast[[1]][,1]
for(i in 1:n.roll){
if(prepad) {
tmp[1:i, i+1] = x@filter$data[(N):(N+i-1)]
}
tmp[(i+1):(i+n.ahead), i+1] = forc$forecast[[i+1]][,1]
}
tmp = as.data.frame(tmp)
rownames(tmp) = fdates
colnames(tmp) = paste("roll-", seq(0, n.roll,by = 1), sep="")
tmp
}
# retval: 0 is the standard, returns all values
# retval: 1 returns only those values which have in sample equivalent data (for testing purposes)
# retval: 2 returns only those values which are truly forecasts without in sample data
.arfimafordf2 = function(x, type = 0, ...)
{
n.ahead = x@forecast$n.ahead
# n.start == out.sample
n.start = x@forecast$n.start
n.roll = x@forecast$n.roll
tlength = n.ahead + n.roll
mat = matrix(NA, ncol = n.roll + 1, nrow = n.ahead)
mat = sapply(x@forecast$forecast, FUN = function(x) x[,1])
if(is.vector(mat)) mat = matrix(mat, ncol = n.roll+1)
colnames(mat) = paste("roll-", seq(0, n.roll, by = 1), sep = "")
rownames(mat) = paste("t+", 1:n.ahead, sep = "")
if(n.roll == 0 | type == 0) return(as.data.frame(mat))
indices = apply(.embed(1:tlength, n.ahead, by = 1), 1, FUN = function(x) rev(x))
exc = which(indices>n.start)
if(type == 1){
if(length(exc)>0) mat[exc] = NA
} else{
if(length(exc)>0) mat[-exc] = NA
}
return(as.data.frame(mat))
}
# pad applies to when rollframe = "all", whether to pre-pad forecast with actual values else NA's
# post forecast values are always NA's (this relates to the out.sample option and n.roll)
.arfimafordf = function(x, row.names = NULL, optional = FALSE, rollframe = 0, aligned = TRUE,
prepad = TRUE, type = 0)
{
forc = x@forecast
n.start = forc$n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
if(!any(type==(0:2)))
stop("invalid argument for type in as.data.frame", call. = FALSE)
#if(rollframe == "all" && n.roll<=0) rollframe = 0
if(rollframe == "all") return(.arfimafordfall(x, aligned, prepad, type))
# allow type to be used here as well
rollframe = as.integer(rollframe)
if(rollframe>n.roll | rollframe<0) stop("rollframe out of bounds", call. = FALSE)
indx = (rollframe+1):(rollframe+n.ahead)
exc = which(indx>n.start)
ans = forc$forecast[[rollframe+1]]
if(type == 1){
if(length(exc)>0) ans[exc,] = NA
}
if(type == 2){
if(length(exc)>0) ans[-exc,] = NA
}
return(ans)
}
setMethod("as.data.frame", signature(x = "ARFIMAforecast"), .arfimafordf)
# as.array method for forecast object
.arfimaforar = function(x, ...)
{
forc = x@forecast
n.start = forc$n.start
n.ahead = forc$n.ahead
n.roll = forc$n.roll
forar = array(NA, dim = c(n.ahead, 1, n.roll+1))
for(i in 1:(n.roll+1)){
forar[,,i] = as.matrix(forc$forecast[[i]])
}
return(forar)
}
setMethod("as.array", signature(x = "ARFIMAforecast"), .arfimaforar)
# as.list method for forecast object
.arfimaforlist = function(x, ...)
{
x@forecast$forecast
}
setMethod("as.list", signature(x = "ARFIMAforecast"), .arfimaforlist)
# as.list method for forecast object
.arfimamultiforlist = function(x, ...)
{
ans = lapply(x@forecast, FUN = function(x) x@forecast$forecast)
names(ans) = x@model$asset.names
ans
}
setMethod("as.list", signature(x = "ARFIMAmultiforecast"), .arfimamultiforlist)
.arfimamultiforarray = function(x, ...)
{
n = length(x@forecast)
ns = x@forecast[[1]]@forecast$n.roll
nah = x@forecast[[1]]@forecast$n.ahead
forar = array(NA, dim = c(nah, n, ns+1))
cnames = x@model$asset.names
rnames = paste("n.ahead-", 1:nah, sep = "")
dnames = paste("n.roll-", 0:ns, sep = "")
dimnames(forar) = list(rnames, cnames, dnames)
for(i in 1:(ns+1)) forar[,,i] = as.matrix(sapply(x@forecast, FUN = function(x) unlist(x@forecast$forecasts[[i]])))
return(forar)
}
setMethod("as.array", signature(x = "ARFIMAmultiforecast"), .arfimamultiforarray)
#----------------------------------------------------------------------------------
# as data.frame for fpm object
.arfimafpmdf = function(x, row.names = NULL, optional = FALSE, type = "meanloss", rollframe = 0, ...)
{
if(type == "meanloss"){
ans = as.data.frame(x@seriesfpm$meanloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$series) else colnames(ans) ="roll_t+1"
}
if(type == "medianloss"){
ans = as.data.frame(x@seriesfpm$medianloss)
if(x@details$type==1) colnames(ans) = colnames(x@forecasts$series) else colnames(ans) ="roll_t+1"
}
if(type == "loss")
{
ans = as.data.frame(x@seriesfpm$lossfn[[rollframe+1]])
}
return(ans)
}
setMethod("as.data.frame", signature(x = "ARFIMAfpm"), .arfimafpmdf)
#----------------------------------------------------------------------------------
# as.data.frame method for distribution object
.arfimadistdf = function(x, row.names = NULL, optional = FALSE, which = "coef", window = 1, ...)
{
n = x@dist$details$nwindows
if(window > n) stop("window size greater than actual available", call. = FALSE)
if(which == "rmse"){
ans = as.data.frame(t(x@dist[[window]]$rmse))
colnames(ans) = rownames(x@truecoef)
}
if(which == "stats"){
llh = x@dist[[window]]$likelist
uncmean = x@dist[[window]]$mlongrun
maxret = x@dist[[window]]$simmaxdata[,1]
minret = x@dist[[window]]$simmindata[,1]
meanret = x@dist[[window]]$simmeandata[,1]
kurtosis = x@dist[[window]]$simmomdata[,1]
skewness = x@dist[[window]]$simmomdata[,2]
ans = data.frame(llh = llh, uncmean = uncmean, maxret = maxret, minret = minret,
meanret = meanret, kurtosis = kurtosis, skewness = skewness)
}
if(which == "coef"){
cf = x@dist[[window]]$simcoef
ans = data.frame(coef = cf)
colnames(ans) = rownames(x@truecoef)
}
if(which == "coefse"){
cfe = x@dist[[window]]$simcoefse
ans = data.frame(coefse = cfe)
colnames(ans) = rownames(x@truecoef)
}
ans
}
setMethod("as.data.frame", signature(x = "ARFIMAdistribution"), .arfimadistdf)
#----------------------------------------------------------------------------------
# as.data.frame method for simulation object
.arfimasimdf = function(x, row.names = NULL, optional = FALSE, which = "series")
{
# simframe: series, residuals
#seriesSim=seriesSim, residSim=residSim
sim = x@simulation
dates = x@model$dates
resids = sim$residSim
m = dim(resids)[2]
N = dim(resids)[1]
fwdd = .generatefwd(dates, N = N, dformat = "%Y-%m-%d", periodicity = "days")
if(which == "series"){
series = sim$seriesSim
ans = data.frame(seriessim = series)
}
if(which == "residuals"){
resids = sim$residSim
ans = data.frame(residsim = resids)
}
rownames(ans) = as.character(fwdd)
ans
}
setMethod("as.data.frame", signature(x = "ARFIMAsim"), .arfimasimdf)
#----------------------------------------------------------------------------------
# as.data.frame method for path simulation object
.arfimapathdf = function(x, row.names = NULL, optional = FALSE, which = "series")
{
# simframe: sigma, series, residuals
#sigmaSim=sigmaSim, seriesSim=seriesSim, residSim=residSim
sim = x@path
resids = sim$residSim
m = dim(resids)[2]
N = dim(resids)[1]
if(which == "series"){
series = sim$seriesSim
ans = data.frame(seriessim = series)
}
if(which == "residuals"){
resids = sim$residSim
ans = data.frame(residsim = resids)
}
ans
}
setMethod("as.data.frame", signature(x = "ARFIMApath"), .arfimapathdf)
#----------------------------------------------------------------------------------
# as.data.frame method for bootstrap object
.arfimabootdf = function(x, row.names = NULL, optional = FALSE, type = "raw", qtile = c(0.01, 0.099))
{
n.ahead = x@model$n.ahead
if(type == "raw"){
series = x@fseries
ans = data.frame(bootseries = series)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
}
if(type == "q"){
if(all(is.numeric(qtile)) && (all(qtile<1.0) && all(qtile >0.0))){
series = x@fseries
ans = apply(series, 2, FUN = function(x) quantile(x, qtile))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = paste("q", qtile, sep = "")
} else{
stop("\nfor type q, the qtile value must be numeric and between (>)0 and 1(<)\n", call. = FALSE)
}
}
if(type == "summary"){
series = x@fseries
ans = apply(series, 2, FUN = function(x) c(min(x), quantile(x, 0.25), mean(x), quantile(x, 0.75), max(x) ))
ans = as.data.frame(ans)
colnames(ans) = paste("t+", 1:n.ahead, sep="")
rownames(ans) = c("min", "q.25", "mean", "q.75", "max")
}
ans
}
#setMethod("as.data.frame", signature(x = "ARFIMAboot"), .arfimabootdf)
#----------------------------------------------------------------------------------
# as.data.frame method for roll object
# valid which = density, fpm, coefs
.arfimarolldf = function(x, row.names = NULL, optional = FALSE, which = "density", n.ahead = 1, refit = 1)
{
n = x@roll$n.ahead
if(n.ahead>n)
stop("n.ahead chosen exceeds roll object specification", call. = FALSE)
if(which == "coefs"){
ans = as.data.frame(x@roll$coefs)
rownames(ans) = paste("refit-", 1:dim(ans)[1], sep = "")
}
if(which == "density"){
ans = as.data.frame(x@roll$fdensity[[n.ahead]])
rownames(ans) = paste("roll-", 1:dim(ans)[1], sep = "")
}
if(which == "coefmat"){
ans = as.data.frame(x@roll$coefmat[[refit]])
}
if(which == "LLH"){
ans = as.data.frame(x@roll$LLH)
rownames(ans) = paste("refit-", 1:dim(ans)[1], sep = "")
colnames(ans) = "LLH"
}
if(which == "VaR"){
ans = as.data.frame(x@roll$VaR.out[[n.ahead]])
}
return(ans)
}
setMethod("as.data.frame", signature(x = "ARFIMAroll"), .arfimarolldf)
as.ARFIMAforecast = function(object, ...)
{
setMethod("as.ARFIMAforecast")
}
.roll2arfimaforc = function(object, refit = 1)
{
n = object@roll$n.refit
if(refit>n)
stop("refit chosen exceeds roll object specification", call. = FALSE)
object@forecast[[refit]]
}
setMethod("as.ARFIMAforecast", signature(object = "ARFIMAroll"), .roll2arfimaforc)
#----------------------------------------------------------------------------------
# residuals method
.arfimafitresids = function(object)
{
object@fit$residuals
}
setMethod("residuals", signature(object = "ARFIMAfit"), .arfimafitresids)
.arfimafilterresids = function(object)
{
object@filter$residuals
}
setMethod("residuals", signature(object = "ARFIMAfilter"), .arfimafilterresids)
.arfimamultifitresids = function(object)
{
sapply(object@fit, FUN = function(x) residuals(x), simplify = TRUE)
}
setMethod("residuals", signature(object = "ARFIMAmultifit"), .arfimamultifitresids)
.arfimamultifilterresids = function(object)
{
sapply(object@filter, FUN = function(x) residuals(x), simplify = TRUE)
}
setMethod("residuals", signature(object = "ARFIMAmultifilter"), .arfimamultifilterresids)
#----------------------------------------------------------------------------------
# Likelihood method
.arfimafitLikelihood = function(object)
{
return(object@fit$LLH)
}
setMethod("likelihood", signature(object = "ARFIMAfit"), .arfimafitLikelihood)
.arfimafilterLikelihood = function(object)
{
return(object@filter$LLH)
}
setMethod("likelihood", signature(object = "ARFIMAfilter"), .arfimafilterLikelihood)
.arfimamultifilterLikelihood = function(object)
{
sapply(object@filter, FUN = function(x) likelihood(x), simplify = TRUE)
}
setMethod("likelihood", signature(object = "ARFIMAmultifilter"), .arfimamultifilterLikelihood)
.arfimamultifitLikelihood = function(object)
{
sapply(object@fit, FUN = function(x) likelihood(x), simplify = TRUE)
}
setMethod("likelihood", signature(object = "ARFIMAmultifit"), .arfimamultifitLikelihood)
#----------------------------------------------------------------------------------
# Fitted method
.arfimafitted = function(object)
{
return(object@fit$fitted.values)
}
setMethod("fitted", signature(object = "ARFIMAfit"), .arfimafitted)
.arfimafiltered = function(object)
{
return(object@filter$data - object@filter$residuals)
}
setMethod("fitted", signature(object = "ARFIMAfilter"), .arfimafiltered)
.arfimamultifiltered = function(object)
{
sapply(object@filter, FUN = function(x) x@filter$data - residuals(x), simplify = TRUE)
}
setMethod("fitted", signature(object = "ARFIMAmultifilter"), .arfimamultifiltered)
.arfimamultifitted = function(object)
{
sapply(object@fit, FUN = function(x) x@fit$data - residuals(x), simplify = TRUE)
}
setMethod("fitted", signature(object = "ARFIMAmultifit"), .arfimamultifitted)
#----------------------------------------------------------------------------------
# Info Criteria method
.arfimainfocriteria = function(object)
{
itest = .information.test(likelihood(object), nObs = length(fitted(object)),
nPars = length(coef(object)))
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 = "ARFIMAfit"), .arfimainfocriteria)
setMethod("infocriteria", signature(object = "ARFIMAfilter"), .arfimainfocriteria)
#----------------------------------------------------------------------------------
# The mult- methods
#----------------------------------------------------------------------------------
.multispecarfima = function( speclist )
{
# first create a spec which goes through validation process
tp = 1
ans = new("ARFIMAmultispec",
spec = speclist,
type = "equal")
# then check type
n = length(speclist)
for(i in 2:n){
if(length(speclist[[i]]@optimization.model$modelnames)!=length(speclist[[i-1]]@optimization.model$modelnames))
{
tp = 0
break()
} else{
if(!all(speclist[[i]]@optimization.model$modelnames == speclist[[i-1]]@optimization.model$modelnames))
{
tp = 0
break()
}
}
}
if(tp) type = "equal" else type = "unequal"
ans = new("ARFIMAmultispec",
spec = speclist,
type = type)
return(ans)
}
setMethod("multifit", signature(multispec = "ARFIMAmultispec"), definition = .multifitarfima)
setMethod("multifilter", signature(multifitORspec = "ARFIMAmultifit"), definition = .multifilterarfima1)
setMethod("multifilter", signature(multifitORspec = "ARFIMAmultispec"), definition = .multifilterarfima2)
setMethod("multiforecast", signature(multifitORspec = "ARFIMAmultifit"), definition = .multiforecastarfima1)
setMethod("multiforecast", signature(multifitORspec = "ARFIMAmultispec"), definition = .multiforecastarfima2)
#----------------------------------------------------------------------------------
#----------------------------------------------------------------------------------
# univariate plot method / seperate for fit,sim and forecast
#----------------------------------------------------------------------------------
#setMethod(f = "plot", signature(x = "ARFIMAfit", y = "missing"), .plotarfimafit)
#setMethod(f = "plot", signature(x = "ARFIMAfilter", y = "missing"), .plotarfimafilter)
#setMethod(f = "plot", signature(x = "ARFIMAsim", y = "missing"), .plotarfimasim)
#setMethod(f = "plot", signature(x = "ARFIMAforecast", y = "missing"), .plotarfimaforecast)
#setMethod(f = "plot", signature(x = "ARFIMApath", y = "missing"), .plotarfimapath)
#setMethod(f = "plot", signature(x = "ARFIMAroll", y = "missing"), .plotarfimaroll)
#setMethod(f = "plot", signature(x = "ARFIMAdistribution", y = "missing"), .plotarfimadist)
# spec show
setMethod("show",
signature(object = "ARFIMAspec"),
function(object){
model = strsplit(class(object), "spec")
cat(paste("\n*-----------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Spec *", sep = ""))
cat(paste("\n*-----------------------------*", sep = ""))
cat("\n\nMean Model")
cat(paste("\n-------------------------------\n",sep=""))
cat("Include Mean\t: ", as.logical(object@mean.model$include.mean),"\n")
cat("AR-MA Order\t\t: ",object@mean.model$armaOrder[1:2],"\n")
cat("Include ARFIMA\t: ", as.logical(object@mean.model$arfima),"\n")
if(object@mean.model$include.mex)
cat(paste("Exogenous Regressor Dimension: ",
dim(object@mean.model$mexdata)[2],"\n",sep=""))
cat("\nConditional Distribution Model")
cat(paste("\n-------------------------------\n",sep=""))
cat("Distribution\t: ",object@distribution.model$distribution,"\n")
cat("Includes Lambda\t: ", as.logical(object@distribution.model$include.dlambda),"\n")
cat("Includes Skew\t: ", as.logical(object@distribution.model$include.skew),"\n")
cat("Includes Shape\t: ", as.logical(object@distribution.model$include.shape),"\n\n")
invisible(object)
})
# fit show
setMethod("show",
signature(object = "ARFIMAfit"),
function(object){
cat(paste("\n*-----------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Fit *", sep = ""))
cat(paste("\n*-----------------------------*", sep = ""))
cat("\n\nInclude Mean\t: ", object@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@model$armaOrder[1],",",
as.integer(object@model$arfima),
",",object@model$armaOrder[2],")",sep=""))
if(object@model$include.mex){
cat("\nExogenous Regressors: ",object@model$mxn)
} else{
cat("\nExogenous Regressors: none")
}
cat("\nConditional Distribution: ",object@model$distribution,"\n")
if(object@fit$convergence == 0){
cat("\nOptimal Parameters")
cat(paste("\n--------------------------\n", sep = ""))
print(round(object@fit$matcoef,6), digits = 5)
cat("\nRobust Standard Errors:\n")
print(round(object@fit$robust.matcoef,6), digits = 5)
if(!is.null(object@fit$hessian.message)){
cat(paste("\n", object@fit$hessian.message))
}
cat("\nLogLikelihood :", object@fit$LLH, "\n")
stdresid = object@fit$residuals/coef(object)["sigma"]
itest = .information.test(object@fit$LLH, nObs = length(object@fit$data),
nPars=length(coef(object)))
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")
print(itestm, digits = 5)
cat("\n\n")
cat("\nElapsed time :", object@fit$timer,"\n\n")
} else{
cat("\nConvergence Problem:")
cat("\nSolver Message:", object@fit$message,"\n\n")
}
invisible(object)
})
# filter show
setMethod("show",
signature(object = "ARFIMAfilter"),
function(object){
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Filter *", sep = ""))
cat(paste("\n*--------------------------------*", sep = ""))
cat("\n\nInclude Mean\t: ", object@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@model$armaOrder[1],",",
as.integer(object@model$arfima),
",",object@model$armaOrder[2],")",sep=""))
if(object@model$include.mex){
cat("\nExogenous Regressors : ",object@model$mxn)
} else{
cat("\nExogenous Regressors : none")
}
cat("\nConditional Distribution : ",object@model$distribution,"\n")
cat("\nFilter Parameters")
cat(paste("\n--------------------------\n", sep = ""))
print(matrix(object@filter$pars, ncol=1,
dimnames = list(names(coef(object)), "")), digits = 5)
cat("\nLogLikelihood :", object@filter$LLH, "\n")
stdresid = object@filter$residuals/coef(object)["sigma"]
itest = .information.test(object@filter$LLH, nObs = length(object@filter$data),
nPars = length(coef(object)))
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")
print(itestm, digits = 5)
cat("\n\n")
cat("\nElapsed time :", object@filter$timer,"\n\n")
invisible(object)
})
# sim show
setMethod("show",
signature(object = "ARFIMAsim"),
function(object){
cat(paste("\n*------------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Simulation *", sep = ""))
cat(paste("\n*------------------------------------*", sep = ""))
sim = object@simulation
dates = object@model$dates
series = sim$seriesSim
resids = sim$residSim
m = dim(series)[2]
N = dim(series)[1]
cat(paste("\n\nHorizon: ",N))
cat(paste("\nSimulations: ",m,"\n",sep=""))
rx1 = apply(series, 2, FUN=function(x) mean(x))
rx2 = apply(series, 2, FUN=function(x) range(x))
actual = c(0, mean(object@simulation$series),
min(object@simulation$series), max(object@simulation$series))
dd = data.frame(Seed = object@seed, Series.Mean = rx1, Series.Min = rx2[1,],
Series.Max = rx2[2,])
meansim = apply(dd, 2, FUN = function(x) mean(x))
meansim[1] = 0
dd = rbind(dd, meansim, actual)
rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)", "Actual")
print(dd,digits = 3)
cat("\n\n")
})
# forecast show
setMethod("show",
signature(object = "ARFIMAforecast"),
function(object){
cat(paste("\n*----------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Forecast *", sep = ""))
cat(paste("\n*----------------------------------*", sep = ""))
n.ahead = object@forecast$n.ahead
cat(paste("\n\nHorizon: ", n.ahead, sep = ""))
cat(paste("\nRoll Steps: ",object@forecast$n.roll, sep = ""))
n.start = object@forecast$n.start
if(n.start>0) infor = ifelse(n.ahead>n.start, n.start, n.ahead) else infor = 0
cat(paste("\nOut of Sample: ", infor, "\n", sep = ""))
cat("\n0-roll forecast: \n")
zz = object@forecast$forecast[[1]]
print(zz, digits = 4)
cat("\n\n")
})
# path show
setMethod("show",
signature(object = "ARFIMApath"),
function(object){
model = strsplit(class(object), "path")
cat(paste("\n*--------.........------------------------*", sep = ""))
cat(paste("\n* ARFIMA Model Path Simulation *", sep = ""))
cat(paste("\n*-----------------------------------------*", sep = ""))
sim = object@path
series = sim$seriesSim
resids = sim$residSim
m = dim(series)[2]
N = dim(series)[1]
cat(paste("\n\nHorizon: ", N))
cat(paste("\nSimulations: ", m, "\n", sep = ""))
rx1 = apply(series, 2, FUN = function(x) mean(x))
rx2 = apply(series, 2, FUN = function(x) range(x))
dd = data.frame(Seed = object@seed, Series.Mean = rx1, Series.Min = rx2[1,],
Series.Max = rx2[2,])
meansim = apply(dd, 2, FUN = function(x) mean(x))
meansim[1] = 0
dd = rbind(dd, meansim)
rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)")
print(dd, digits = 3)
cat("\n\n")
})
# distribution show
setMethod("show",
signature(object = "ARFIMAdistribution"),
function(object){
cat(paste("\n*------------------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Parameter Distribution *", sep = ""))
cat(paste("\n*------------------------------------------*", sep = ""))
cat(paste("\n\nNo. Paths (m.sim) : ", object@dist$details$m.sim, sep = ""))
cat(paste("\nLength of Paths (n.sim) : ", object@dist$details$n.sim, sep = ""))
cat(paste("\nRecursive : ", object@dist$details$recursive, sep = ""))
if(object@dist$details$recursive){
cat(paste("\nRecursive Length : ", object@dist$details$recursive.length, sep = ""))
cat(paste("\nRecursive Window : ", object@dist$details$recursive.window, sep = ""))
}
cat("\n\n")
cat("Coefficients: True vs Simulation Mean (Window-n)\n")
nwindows = object@dist$details$nwindows
nm = object@dist$details$n.sim + (0:(nwindows-1))*object@dist$details$recursive.window
ns = matrix(0, ncol = dim(object@truecoef)[1], nrow = nwindows)
for(i in 1:nwindows){
ns[i,] = apply(as.data.frame(object, window = i), 2, FUN = function(x) mean(x, na.rm = T))
}
ns = rbind(object@truecoef[,1], ns)
colnames(ns) = rownames(object@truecoef)
rownames(ns) = c("true-coef",paste("window-", nm, sep=""))
print(as.data.frame(ns), digits=5)
for(i in 1:nwindows){
if(any(object@dist[[i]]$convergence==1)) n = length(which(object@dist[[i]]$convergence==1)) else n = 0
if(n>0) cat(paste("\nwindow-",nm[i]," no. of non-converged fits: ", n, "\n",sep=""))
}
cat("\n\n")
})
# fpm show
setMethod("show",
signature(object = "ARFIMAfpm"),
function(object){
cat(paste("\n*---------------------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Forecast Performance Measures *", sep = ""))
cat(paste("\n*---------------------------------------------*", sep = ""))
cat(paste("\n\nn.ahead : ", object@details$n.ahead, sep = ""))
cat(paste("\nn.roll : ", object@details$n.roll, sep = ""))
cat(paste("\nfpm type : ", object@details$type, sep = ""))
if(object@details$type==2){
cat("\nForecasts w/th Mean Loss Functions\n(1-ahead rolling)\n")
fc = NULL
fc = rbind(fc, object@seriesfpm$meanloss["mse"])
fc = rbind(fc, object@seriesfpm$meanloss["mad"])
fc = rbind(fc, object@seriesfpm$meanloss["dac"])
colnames(fc) = c("series")
rownames(fc) = c("MSE", "MAD", "DAC")
cat("\n")
print(round(fc,6), digits = 5)
} else{
cat("\nMean Loss Functions\n(n.ahead/n.roll)\n")
cat("\nseries\n")
fc1 = object@seriesfpm$meanloss
colnames(fc1) = colnames(object@forecasts$series)
print(t(fc1), digits=5)
}
cat("\n\n")
})
#-------------------------------------------------------------------------
# multi-methods
setMethod("show",
signature(object = "ARFIMAmultispec"),
function(object){
cat(paste("\n*---------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Multi-Spec *", sep = ""))
cat(paste("\n*---------------------------------*", sep = ""))
N = length(object@spec)
cat(paste("\n\nMultiple Specifications\t: ", N, sep=""))
cat(paste("\nMulti-Spec Type\t\t\t: ", object@type, sep=""))
cat("\n")
invisible(object)
})
setMethod("show",
signature(object = "ARFIMAmultifit"),
function(object){
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Multi-Fit *", sep = ""))
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n\nNo. Assets :", length(object@fit), sep=""))
asset.names = object@model$asset.names
if(object@model$type == "equal"){
cat(paste("\nMulti-Spec Type : Equal",sep=""))
cat(paste("\n\nModel Spec",sep=""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\nInclude Mean\t: ", object@fit[[1]]@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@fit[[1]]@model$armaOrder[1],",",
as.integer(object@fit[[1]]@model$arfima),
",",object@fit[[1]]@model$armaOrder[2],")",sep=""))
if(object@fit[[1]]@model$include.mex){
cat("\nExogenous Regressors\t: ",object@fit[[1]]@model$mxn)
} else{
cat("\nExogenous Regressors\t: none")
}
cat("\n\nConditional Distribution:",object@fit[[1]]@model$distribution,"\n")
cv = sapply(object@fit, FUN = function(x) x@fit$convergence)
if(any(cv != 0)){
ncv = which(cv != 0)
nncv = length(ncv)
cat("\nNo. of non converged fits: ", ncv,"\n")
if(ncv>0) cat("\nNon converged fits: ", nncv,"\n")
} else{
cat(paste("\nModel Fit", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\n")
ll = t(likelihood(object))
rownames(ll) = "Log-Lik"
cf = coef(object)
colnames(cf) = asset.names
print(round(rbind(cf, ll), digits = 5))
cat("\n")
}
} else{
cat(paste("\nARFIMA Model Fit", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat(paste("\nModel Fit", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\n")
print(coef(object), digits = 5)
}
invisible(object)
})
setMethod("show",
signature(object = "ARFIMAmultifilter"),
function(object){
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Multi-Filter *", sep = ""))
cat(paste("\n*--------------------------------*", sep = ""))
cat(paste("\n\nNo. Assets :", length(object@filter), sep=""))
asset.names = object@model$asset.names
if(object@model$type == "equal"){
cat(paste("\nMulti-Spec Type : Equal",sep=""))
cat(paste("\n\nModel Spec",sep=""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\nInclude Mean\t: ", object@filter[[1]]@model$include.mean)
cat(paste("\nAR(FI)MA Model\t: (",object@filter[[1]]@model$armaOrder[1],",",
as.integer(object@filter[[1]]@model$arfima),
",",object@filter[[1]]@model$armaOrder[2],")",sep=""))
if(object@filter[[1]]@model$include.mex){
cat("\nExogenous Regressors\t: ",object@filter[[1]]@model$mxn)
} else{
cat("\nExogenous Regressors\t: none")
}
cat("\n\nConditional Distribution:",object@filter[[1]]@model$distribution,"\n")
cat(paste("\nModel Filter", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\n")
ll = t(likelihood(object))
rownames(ll) = "Log-Lik"
cf = coef(object)
colnames(cf) = asset.names
print(round(rbind(cf, ll), digits = 5))
cat("\n")
} else{
cat(paste("\nARFIMA Model Filter", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat(paste("\nModel Fit", sep = ""))
cat(paste("\n-------------------------------\n",sep=""))
cat("\n")
print(coef(object), digits = 5)
}
invisible(object)
})
setMethod("show",
signature(object = "ARFIMAmultiforecast"),
function(object){
asset.names = object@model$asset.names
cat(paste("\n*----------------------------------*", sep = ""))
cat(paste("\n* ARFIMA Multi-Forecast *", sep = ""))
cat(paste("\n*----------------------------------*", sep = ""))
cat(paste("\n\nNo. Assets :", length(object@forecast), sep=""))
cat(paste("\n--------------------------\n",sep=""))
fc = as.array(object)
print(fc, digits = 5)
invisible(object)
})
.uncarfima = function(object)
{
include.mean = object@model$include.mean
if(is(object, "ARFIMAfilter")){
data = object@filter$data
} else{
data = object@fit$data
}
N = length(data)
arfima = object@model$arfima
include.mex = object@model$include.mex
pars = coef(object)
if(include.mex){
mxn = object@model$mxn
mxreg = coef(object)[paste("mxreg", 1:mxn, sep="")]
if(is(object, "ARFIMAfilter")){
mexdata = as.matrix(object@model$mexdata[1:N, 1:mxn])
} else{
mexdata = as.matrix(object@model$mexdata[1:N, 1:mxn])
}
meanmex = apply(mexdata, 2, "mean")
umeanmex = sum(mxreg*meanmex)
} else{
umeanmex = 0
}
if(include.mean) mu = coef(object)["mu"] else mu = 0
#if(arfima){
# umean = mu + umeanmex
#} else{
# armaOrder = object@model$armaOrder
# if(armaOrder[1] == 0) {
# umean = mu + umeanmex
# } else{
# ar = sum(coef(object)[paste("ar", 1:armaOrder[1], sep="")])
# umean = (mu + umeanmex)/(1 - ar)
# }
#}
umean = mu + umeanmex
return(umean)
}
setMethod("uncmean", signature(object = "ARFIMAfit"), definition = .uncarfima)
setMethod("uncmean", signature(object = "ARFIMAfilter"), definition = .uncarfima)
Try the rgarch package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
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.