Nothing
#################################################################################
##
## 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.
##
#################################################################################
.plotdccfit = function(x, which = "ask", series = c(1, 2), ...)
{
n = length(x@ufit@fit)
xseries = unique( as.integer( series ) )
xseries = xseries[xseries > 0]
if( any(xseries > n) ) stop( "\nrgarch-->error: series index out of bounds in DCCfit plot.")
if( length(xseries) < 2 ) stop( "\nrgarch-->error: series length must be 2 or more.")
series = xseries
choices = c(
"Conditional Mean",
"Conditional Sigma",
"Conditional Covariance",
"Conditional Correlation",
"EW Portfolio Plot with conditional density VaR limits")
.interdccfitPlot(x, choices = choices, plotFUN = paste(".plot.dccfit", 1:5, sep = "."), which = which, series = series, ...)
# Return Value:
invisible(x)
}
.interdccfitPlot = function(x, choices, plotFUN, which, series = c(1, 2), ...)
{
if (is.numeric(which)) {
if(which>length(choices)) stop("Not a valid choice. Plots choices are 1-5.\n",call. = FALSE)
FUN = match.fun(plotFUN[which])
FUN(x, series = series, ...)
}
if(is.character(which))
{
if( which!="ask" ) stop("Not a valid choice.\n",call. = FALSE)
.multdccfitPlot(x, choices, series = series, ...)
}
invisible(x)
}
.multdccfitPlot = function(x, choices, series = c(1, 2), ...)
{
pick = 1
while (pick > 0) {
pick = menu (
choices = paste(" ", choices),
title = "\nMake a plot selection (or 0 to exit):")
switch (pick,
.plot.dccfit.1(x, series, ...), .plot.dccfit.2(x, series, ...),
.plot.dccfit.3(x, series, ...), .plot.dccfit.4(x, series, ...),
.plot.dccfit.5(x, ...))
}
}
.plot.dccfit.1 = function(x, series = c(1, 2), ...)
{
ops = list(...)
n = length( series )
cnames = x@mfit$model$asset.names
if(!is.null(x@mfit$model$vrmodel)) p = x@mfit$model$vrmodel$p else p = 0
xDat = x@mfit$origdata
ns = x@mfit$model$out.sample
xDat = head(xDat, dim(xDat)[1] - ns)
yDat = head(x@mfit$origdates, length(x@mfit$origdates) - ns)
if( p > 0 ){
xDat = xDat[-c(1:p), ]
yDat = yDat[-c(1:p)]
}
xFit = fitted(x)
if( n > 16 ){
scr = floor( n/16 )
z = n - 16 * floor( n/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
plot( yDat, xDat[, series[i + xn]], type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
lines( yDat, xFit[, series[i + xn]], type = "l", col = colors()[132])
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Mean\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
plot( yDat, xDat[, series[i + xn]], type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
lines( yDat, xFit[, series[i + xn]], type = "l", col = colors()[132])
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Mean\n(page...", j, ")", sep = ""), outer =TRUE, line = -2, cex = 0.75)
grid()
}
} else{
d = .divisortable( n )
par( mfrow= c(d[1], d[2]) )
for(i in 1:n){
plot( yDat, xDat[, series[i]], type = "l", col = colors()[16], main = cnames[series[i]], ylab = "", xlab = "")
lines( yDat, xFit[, series[i]], type = "l", col = colors()[132])
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
title( paste( "DCC Conditional Mean", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
}
invisible()
}
.plot.dccfit.2 = function(x, series = c(1, 2), ...)
{
ops = list(...)
n = length( series )
cnames = x@mfit$model$asset.names
xDat = sigma(x)
yDat = x@ufit@fit[[1]]@fit$dates
if( n > 16 ){
scr = floor( n/16 )
z = n - 16 * floor( n/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
plot( yDat, xDat[, series[i + xn]], type = "l", col = colors()[131], main = cnames[series[i + xn]], ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Sigma\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
plot( yDat, xDat[, series[i + xn]], type = "l", col = colors()[131], main = cnames[series[i + xn]], ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Sigma\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
} else{
d = .divisortable( n )
par( mfrow= c(d[1], d[2]) )
for(i in 1:n){
plot( yDat, xDat[, series[i]], type = "l", col = colors()[131], main = cnames[series[i]], ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
title( paste( "DCC Conditional Sigma", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
}
invisible()
}
.plot.dccfit.3 = function(x, series, ...)
{
ops = list(...)
n = length( series )
nc = ( (n^2 - n)/2 )
cnames = x@mfit$model$asset.names
idx = .lowertri.index( n )
yDat = x@ufit@fit[[1]]@fit$dates
H = rcov(x)
if( nc > 16 ){
scr = floor( nc/16 )
z = nc - 16 * floor( nc/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
plot( yDat, H[ series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Covariance\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
plot( yDat, H[ series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Covariance\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
} else{
d = .divisortable( nc )
par( mfrow= c(d[1], d[2]) )
for(i in 1:nc){
plot( yDat, H[ series[idx[i, 1]], series[idx[i, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i, 1]]], "-", cnames[series[idx[i, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
title( paste( "DCC Conditional Covariance", sep = ""), outer = TRUE, line = -1.5, cex = 0.75)
grid()
}
}
invisible()
}
.plot.dccfit.4 = function(x, series, ...)
{
ops = list(...)
n = length( series )
nc = ( (n^2 - n)/2 )
cnames = x@mfit$model$asset.names
idx = .lowertri.index( n )
yDat = x@ufit@fit[[1]]@fit$dates
R = rcor(x)
if( nc > 16 ){
scr = floor( nc/16 )
z = nc - 16 * floor( nc/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
plot( yDat, R[ series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Correlation\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
plot( yDat, R[ series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Correlation\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
} else{
d = .divisortable( nc )
par( mfrow= c(d[1], d[2]) )
for(i in 1:nc){
plot( yDat, R[ series[idx[i, 1]], series[idx[i, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i, 1]]], "-", cnames[series[idx[i, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
title( paste( "DCC Conditional Correlation", sep = ""), outer = TRUE, line = -1.5, cex = 0.75)
grid()
}
}
invisible()
}
.plot.dccfit.5 = function(x, series, ...)
{
if(!is.null(x@mfit$model$vrmodel)) p = x@mfit$model$vrmodel$p else p = 0
xDat = x@mfit$origdata
ns = x@mfit$model$out.sample
xDat = head(xDat, dim(xDat)[1] - ns)
yDat = head(x@mfit$origdates, length(x@mfit$origdates) - ns)
if( p > 0 ){
xDat = xDat[-c(1:p), ]
yDat = yDat[-c(1:p)]
}
port = as.numeric( apply(xDat, 1, "mean") )
n = dim(xDat)[2]
w = rep(1/n , n)
dport = wmargin(distribution = x@mfit$model$distribution, weights = w, cov = rcov(x), mu = fitted(x),
shape = rshape(x), skew = rskew(x))
dm = switch(x@mfit$model$distribution,
mvnorm = "norm",
mvlaplace = "ged",
mvt = "std")
q025 = apply(dport, 1, FUN = function(x)
qdist(distribution = dm, p = 0.025, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
q975 = apply(dport, 1, FUN = function(x)
qdist(distribution = dm, p = 0.975, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
plot(yDat, port, type = "l", col = "steelblue", ylab = "", xlab = "",
main = "EW Portfolio with with 2.5% VaR Limits \n(based on Conditional Weighted Density)",
cex.main = 0.8)
lines(yDat, q025, col = "tomato1")
lines(yDat, q975, col = "green")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
abline(h = 0, col = "grey", lty = 3)
grid()
}
.plotdccfilter = function(x, which = "ask", series = c(1, 2), ...)
{
n = length(x@ufilter@filter)
xseries = unique( as.integer( series ) )
xseries = xseries[xseries > 0]
if( any(xseries > n) ) stop( "\nrgarch-->error: series index out of bounds in DCCfit plot.")
if( length(xseries) < 2 ) stop( "\nrgarch-->error: series length must be 2 or more.")
series = xseries
choices = c(
"Conditional Mean",
"Conditional Sigma",
"Conditional Covariance",
"Conditional Correlation",
"EW Portfolio Plot with conditional density VaR limits")
.interdccfilterPlot(x, choices = choices, plotFUN = paste(".plot.dccfilter", 1:5, sep = "."), which = which, series = series, ...)
# Return Value:
invisible(x)
}
.interdccfilterPlot = function(x, choices, plotFUN, which, series = c(1, 2), ...)
{
if (is.numeric(which)) {
if(which>length(choices)) stop("Not a valid choice. Plots choices are 1-5.\n",call. = FALSE)
FUN = match.fun(plotFUN[which])
FUN(x, series = series, ...)
}
if(is.character(which))
{
if( which!="ask" ) stop("Not a valid choice.\n",call. = FALSE)
.multdccfilterPlot(x, choices, series = series, ...)
}
invisible(x)
}
.multdccfilterPlot = function(x, choices, series = c(1, 2), ...)
{
pick = 1
while (pick > 0) {
pick = menu (
choices = paste(" ", choices),
title = "\nMake a plot selection (or 0 to exit):")
switch (pick,
.plot.dccfilter.1(x, series, ...), .plot.dccfilter.2(x, series, ...),
.plot.dccfilter.3(x, series, ...), .plot.dccfilter.4(x, series, ...),
.plot.dccfilter.5(x, ...))
}
}
.plot.dccfilter.1 = function(x, series = c(1, 2), ...)
{
ops = list(...)
n = length( series )
cnames = x@mfilter$model$asset.names
if(!is.null(x@mfilter$model$vrmodel)) p = x@mfilter$model$vrmodel$p else p = 0
xDat = x@mfilter$origdata
ns = x@mfilter$model$out.sample
xDat = head(xDat, dim(xDat)[1] - ns)
yDat = head(x@mfilter$origdates, length(x@mfilter$origdates) - ns)
if( p > 0 ){
xDat = xDat[-c(1:p), ]
yDat = yDat[-c(1:p)]
}
xFit = fitted(x)
if( n > 16 ){
scr = floor( n/16 )
z = n - 16 * floor( n/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
plot( yDat, xDat[, series[i + xn]], type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
lines( yDat, xFit[, series[i + xn]], type = "l", col = colors()[132])
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Mean\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
plot( yDat, xDat[, series[i + xn]], type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
lines( yDat, xFit[, series[i + xn]], type = "l", col = colors()[132])
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Mean\n(page...", j, ")", sep = ""), outer =TRUE, line = -2, cex = 0.75)
grid()
}
} else{
d = .divisortable( n )
par( mfrow= c(d[1], d[2]) )
for(i in 1:n){
plot( yDat, xDat[, series[i]], type = "l", col = colors()[16], main = cnames[series[i]], ylab = "", xlab = "")
lines( yDat, xFit[, series[i]], type = "l", col = colors()[132])
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
title( paste( "DCC Conditional Mean", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
}
invisible()
}
.plot.dccfilter.2 = function(x, series = c(1, 2), ...)
{
ops = list(...)
n = length( series )
cnames = x@mfilter$model$asset.names
xDat = sigma(x)
yDat = x@ufilter@filter[[1]]@filter$dates
if( n > 16 ){
scr = floor( n/16 )
z = n - 16 * floor( n/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
plot( yDat, xDat[, series[i + xn]], type = "l", col = colors()[131], main = cnames[series[i + xn]], ylab = "", xlab = "")
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Sigma\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
plot( yDat, xDat[, series[i + xn]], type = "l", col = colors()[131], main = cnames[series[i + xn]], ylab = "", xlab = "")
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Sigma\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
} else{
d = .divisortable( n )
par( mfrow= c(d[1], d[2]) )
for(i in 1:n){
plot( yDat, xDat[, series[i]], type = "l", col = colors()[131], main = cnames[series[i]], ylab = "", xlab = "")
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
title( paste( "DCC Conditional Sigma", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
}
invisible()
}
.plot.dccfilter.3 = function(x, series, ...)
{
ops = list(...)
n = length( series )
nc = ( (n^2 - n)/2 )
cnames = x@mfilter$model$asset.names
idx = .lowertri.index( n )
yDat = x@ufilter@filter[[1]]@filter$dates
H = rcov(x)
if( nc > 16 ){
scr = floor( nc/16 )
z = nc - 16 * floor( nc/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
plot( yDat, H[ series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Covariance\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
plot( yDat, H[ series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Covariance\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
} else{
d = .divisortable( nc )
par( mfrow= c(d[1], d[2]) )
for(i in 1:nc){
plot( yDat, H[ series[idx[i, 1]], series[idx[i, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i, 1]]], "-", cnames[series[idx[i, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
title( paste( "DCC Conditional Covariance", sep = ""), outer = TRUE, line = -1.5, cex = 0.75)
grid()
}
}
invisible()
}
.plot.dccfilter.4 = function(x, series, ...)
{
ops = list(...)
n = length( series )
nc = ( (n^2 - n)/2 )
cnames = x@mfilter$model$asset.names
idx = .lowertri.index( n )
yDat = x@ufilter@filter[[1]]@filter$dates
R = rcor(x)
if( nc > 16 ){
scr = floor( nc/16 )
z = nc - 16 * floor( nc/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
plot( yDat, R[ series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Correlation\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
plot( yDat, R[ series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
}
title( paste( "DCC Conditional Correlation\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
grid()
}
} else{
d = .divisortable( nc )
par( mfrow= c(d[1], d[2]) )
for(i in 1:nc){
plot( yDat, R[ series[idx[i, 1]], series[idx[i, 2]], ], type = "l", col = colors()[35],
main = paste(cnames[series[idx[i, 1]]], "-", cnames[series[idx[i, 2]]], sep = ""), ylab = "", xlab = "")
mtext(paste("rgarch : DCC model filter"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
title( paste( "DCC Conditional Correlation", sep = ""), outer = TRUE, line = -1.5, cex = 0.75)
grid()
}
}
invisible()
}
.plot.dccfilter.5 = function(x, series, ...)
{
xDat = sapply( x@ufilter@filter, FUN = function(x) x@filter$data )
port = as.numeric( apply(xDat, 1, "mean") )
yDat = x@ufilter@filter[[1]]@filter$dates
n = dim(xDat)[2]
w = rep(1/n , n)
dport = wmargin(distribution = x@mfilter$model$distribution, weights = w, cov = rcov(x), mu = fitted(x),
shape = rshape(x), skew = rskew(x))
dm = switch(x@mfilter$model$distribution,
mvnorm = "norm",
mvlaplace = "ged",
mvt = "std")
q025 = apply(dport, 1, FUN = function(x)
qdist(distribution = dm, p = 0.025, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
q975 = apply(dport, 1, FUN = function(x)
qdist(distribution = dm, p = 0.975, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
plot(yDat, port, type = "l", col = "steelblue", ylab = "", xlab = "",
main = "EW Portfolio with with 2.5% VaR Limits \n(based on Conditional Weighted Density)",
cex.main = 0.8)
lines(yDat, q025, col = "tomato1")
lines(yDat, q975, col = "green")
mtext(paste("rgarch : DCC model fit"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
abline(h = 0, col = "grey", lty = 3)
grid()
}
.plotdccforecast = function(x, which = "ask", series = c(1, 2), ...)
{
n = length(x@uforecast@forecast)
xseries = unique( as.integer( series ) )
xseries = xseries[xseries > 0]
if( any(xseries > n) ) stop( "\nrgarch-->error: series index out of bounds in DCCfit plot.")
if( length(xseries) < 2 ) stop( "\nrgarch-->error: series length must be 2 or more.")
series = xseries
choices = c(
"Conditional Mean Forecast",
"Conditional Sigma Forecast",
"Conditional Covariance Forecast",
"Conditional Correlation Forecast",
"EW Portfolio Plot with forecast conditional density VaR limits")
.interdccforecastPlot(x, choices = choices, plotFUN = paste(".plot.dccforecast", 1:5, sep = "."), which = which, series = series, ...)
# Return Value:
invisible(x)
}
.interdccforecastPlot = function(x, choices, plotFUN, which, series = c(1, 2), ...)
{
if (is.numeric(which)) {
if(which>length(choices)) stop("Not a valid choice. Plots choices are 1-5.\n",call. = FALSE)
FUN = match.fun(plotFUN[which])
FUN(x, series = series, ...)
}
if(is.character(which))
{
if( which!="ask" ) stop("Not a valid choice.\n",call. = FALSE)
.multdccforecastPlot(x, choices, series = series, ...)
}
invisible(x)
}
.multdccforecastPlot = function(x, choices, series = c(1, 2), ...)
{
pick = 1
while (pick > 0) {
pick = menu (
choices = paste(" ", choices),
title = "\nMake a plot selection (or 0 to exit):")
switch (pick,
.plot.dccforecast.1(x, series, ...), .plot.dccforecast.2(x, series, ...),
.plot.dccforecast.3(x, series, ...), .plot.dccforecast.4(x, series, ...),
.plot.dccforecast.5(x, ...))
}
}
.plot.dccforecast.1 = function(x, series = c(1, 2), ...)
{
if( !is.null(x@mforecast$VARf) ){
stop("\nConditional Mean Forecast Plots not implemented for VARX method!\n")
}
ops = list(...)
n = length( series )
n.start = x@uforecast@forecast[[1]]@model$n.start
n.ahead = x@mforecast$model$n.ahead
n.roll = x@mforecast$model$n.roll
cnames = x@mforecast$model$asset.names
xDat = sapply( x@uforecast@forecast, FUN = function(x) tail(x@forecast$series, 50) )
nn = length(x@uforecast@forecast[[1]]@forecast$series)
yDat = tail( x@uforecast@forecast[[1]]@model$dates, 50 )
nac = dim(xDat)[1]
if( n.ahead == 1 && n.roll > 0 ){
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], which = "series", rollframe = "all") )
nf = length(yforDat)
rollxDat = rbind( sapply( x@uforecast@forecast, FUN = function(x) tail(x@forecast$series, 50) ),
sapply( x@uforecast@forecast, FUN = function(x) x@model$origdata[(nn+1):(nn+nf)]))
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
xForc = lapply( x@uforecast@forecast, FUN = function(x) as.data.frame(x, which = "series", aligned = FALSE, type = 2, rollframe = "all") )
if( n > 16 ){
scr = floor( n/16 )
z = n - 16 * floor( n/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
tmp = rollxDat[,series[i + xn]]
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), rollxDat[(nac+1):(nac+nf),series[i + xn]])
lines( yDat, tmp, type = "l", col = 1)
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i + xn]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Series Rolling Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
tmp = rollxDat[,series[i + xn]]
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), rollxDat[(nac+1):(nac+nf),series[i + xn]])
lines( yDat, tmp, type = "l", col = 1)
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i + xn]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Series Rolling Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else{
d = .divisortable( n )
par( mfrow= c(d[1], d[2]) )
for(i in 1:n){
tmp = rollxDat[,series[i]]
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), rollxDat[(nac+1):(nac+nf),series[i]])
lines( yDat, tmp, type = "l", col = 1)
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Series Rolling Forecast", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else if( n.ahead > 1 && n.roll == 0 ){
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], rollframe = 0)["series"] )
nf = length(yforDat)
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
xForc = lapply( x@uforecast@forecast, FUN = function(x) as.data.frame(x, rollframe = 0)[,"series"] )
if( n > 16 ){
scr = floor( n/16 )
z = n - 16 * floor( n/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
tmp = c(xDat[,series[i + xn]], rep(NA, n.ahead))
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i + xn]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Series Unconditional Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
tmp = c(xDat[,series[i + xn]], rep(NA, n.ahead))
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i + xn]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Series Unconditional Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else{
d = .divisortable( n )
par( mfrow= c(d[1], d[2]) )
for(i in 1:n){
tmp = c(xDat[,series[i]], rep(NA, n.ahead))
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i]], ylab = "", xlab = "")
tmp = c(rep(NA, nac - 1), xDat[50,series[i]], as.numeric( unlist( xForc[[series[i]]] ) ) )
lines( yDat, tmp, type = "l", col = colors()[16])
tmp = c(rep(NA, nac), as.numeric( unlist( xForc[[series[i]]] ) ) )
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Series Unconditional Forecast", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else if( n.ahead > 1 && n.roll > 0 ){
cat("\nNo plot available for mixed unconditional and rolling forecasts.")
}
invisible()
}
.plot.dccforecast.2 = function(x, series = c(1, 2), ...)
{
ops = list(...)
n = length( series )
n.start = x@uforecast@forecast[[1]]@model$n.start
n.ahead = x@mforecast$model$n.ahead
n.roll = x@mforecast$model$n.roll
cnames = x@mforecast$model$asset.names
xDat = sapply( x@uforecast@forecast, FUN = function(x) tail(x@forecast$sigma, 50) )
nn = length(x@uforecast@forecast[[1]]@forecast$sigma)
yDat = tail( x@uforecast@forecast[[1]]@model$dates, 50 )
nac = dim(xDat)[1]
# filter == 1-ahead forecast
if( n.ahead == 1 && n.roll >= 0 ){
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], which = "sigma", rollframe = "all") )
nf = length(yforDat)
rollxDat = rbind( sapply( x@uforecast@forecast, FUN = function(x) tail(x@forecast$sigma, 50) ),
sapply( x@uforecast@forecast, FUN = function(x) x@filter$sigma[(nn+1):(nn+nf)]) )
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
xForc = lapply( x@uforecast@forecast, FUN = function(x) as.data.frame(x, which = "sigma", aligned = FALSE, type = 2, rollframe = "all") )
if( n > 16 ){
scr = floor( n/16 )
z = n - 16 * floor( n/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
tmp = rollxDat[,series[i + xn]]
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), rollxDat[(nac+1):(nac+nf),series[i + xn]])
lines( yDat, tmp, type = "l", col = 1)
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i + xn]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Sigma Rolling Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
tmp = rollxDat[,series[i + xn]]
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), rollxDat[(nac+1):(nac+nf),series[i + xn]])
lines( yDat, tmp, type = "l", col = 1)
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i + xn]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Sigma Rolling Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else{
d = .divisortable( n )
par( mfrow= c(d[1], d[2]) )
for(i in 1:n){
tmp = rollxDat[,series[i]]
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), rollxDat[(nac+1):(nac+nf),series[i]])
lines( yDat, tmp, type = "l", col = 1)
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC Sigma forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Sigma Rolling Forecast", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else if( n.ahead > 1 && n.roll == 0 ){
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], rollframe = 0)["sigma"] )
nf = length(yforDat)
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
xForc = lapply( x@uforecast@forecast, FUN = function(x) as.data.frame(x, rollframe = 0)[,"sigma"] )
if( n > 16 ){
scr = floor( n/16 )
z = n - 16 * floor( n/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
tmp = c(xDat[,series[i + xn]], rep(NA, n.ahead))
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i + xn]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Sigma Unconditional Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
tmp = c(xDat[,series[i + xn]], rep(NA, n.ahead))
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i + xn]], ylab = "", xlab = "")
tmp = c(rep(NA, nac), as.numeric( xForc[[series[i + xn]]][1, ]))
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Sigma Unconditional Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else{
d = .divisortable( n )
par( mfrow= c(d[1], d[2]) )
for(i in 1:n){
tmp = c(xDat[,series[i]], rep(NA, n.ahead))
plot( yDat, tmp, type = "l", col = colors()[16], main = cnames[series[i]], ylab = "", xlab = "")
tmp = c(rep(NA, nac - 1), xDat[50,series[i]], as.numeric( unlist( xForc[[series[i]]] ) ) )
lines( yDat, tmp, type = "l", col = colors()[16])
tmp = c(rep(NA, nac), as.numeric( unlist( xForc[[series[i]]] ) ) )
lines( yDat, tmp, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Sigma Unconditional Forecast", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else if( n.ahead > 1 && n.roll > 0 ){
cat("\nNo plot available for mixed unconditional and rolling forecasts.")
}
invisible()
}
.plot.dccforecast.3 = function(x, series = c(1, 2), ...)
{
ops = list(...)
n = length( series )
nc = ( (n^2 - n)/2 )
cnames = x@mforecast$model$asset.names
idx = .lowertri.index( n )
n.start = x@uforecast@forecast[[1]]@model$n.start
n.ahead = x@mforecast$model$n.ahead
n.roll = x@mforecast$model$n.roll
cnames = x@mforecast$model$asset.names
xForc = rcov(x)
xDat = x@mforecast$model$H
nac = dim(xDat)[3]
yDat = tail( x@uforecast@forecast[[1]]@model$dates, nac )
if( n.ahead == 1 && n.roll >= 0 ){
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], which = "sigma", rollframe = "all") )
nf = length(yforDat)
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
if( nc > 16 ){
scr = floor( nc/16 )
z = nc - 16 * floor( nc/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
tmpf = as.numeric( sapply(xForc, FUN = function(x) x[series[idx[i + xn, 1]], series[idx[i + xn, 2]],]) )
tmp = c( xDat[series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Covariance Rolling Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
tmpf = as.numeric( sapply(xForc, FUN = function(x) x[series[idx[i + xn, 1]], series[idx[i + xn, 2]],]) )
tmp = c( xDat[series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Covariance Rolling Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else{
d = .divisortable( nc )
par( mfrow= c(d[1], d[2]) )
for(i in 1:nc){
tmpf = as.numeric( sapply(xForc, FUN = function(x) x[series[idx[i, 1]], series[idx[i, 2]],]) )
tmp = c( xDat[series[idx[i, 1]], series[idx[i, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i, 1]]], "-", cnames[series[idx[i, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Covariance Rolling Forecast", sep = ""), outer = TRUE, line = -1.5, cex = 0.75)
}
} else if( n.ahead > 1 && n.roll == 0 ){
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], rollframe = 0)["sigma"] )
nf = length(yforDat)
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
if( nc > 16 ){
scr = floor( nc/16 )
z = nc - 16 * floor( nc/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
tmpf = as.numeric( xForc[[1]][series[idx[i + xn, 1]], series[idx[i + xn, 2]],] )
tmp = c( xDat[series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Covariance Unconditional Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
tmpf = as.numeric( xForc[[1]][series[idx[i + xn, 1]], series[idx[i + xn, 2]],] )
tmp = c( xDat[series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Covariance Unconditional Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else{
d = .divisortable( nc )
par( mfrow= c(d[1], d[2]) )
for(i in 1:nc){
tmpf = as.numeric( xForc[[1]][series[idx[i, 1]], series[idx[i, 2]],] )
tmp = c( xDat[series[idx[i, 1]], series[idx[i, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i, 1]]], "-", cnames[series[idx[i, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Covariance Unconditional Forecast", sep = ""), outer = TRUE, line = -1.5, cex = 0.75)
}
} else if( n.ahead > 1 && n.roll > 0 ){
cat("\nNo plot available for mixed unconditional and rolling forecasts.")
}
invisible()
}
.plot.dccforecast.4 = function(x, series = c(1, 2), ...)
{
ops = list(...)
n = length( series )
nc = ( (n^2 - n)/2 )
cnames = x@mforecast$model$asset.names
idx = .lowertri.index( n )
n.start = x@uforecast@forecast[[1]]@model$n.start
n.ahead = x@mforecast$model$n.ahead
n.roll = x@mforecast$model$n.roll
cnames = x@mforecast$model$asset.names
xForc = rcor(x)
xDat = x@mforecast$model$R
nac = dim(xDat)[3]
yDat = tail( x@uforecast@forecast[[1]]@model$dates, nac )
if( n.ahead == 1 && n.roll >= 0 ){
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], which = "sigma", rollframe = "all") )
nf = length(yforDat)
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
if( nc > 16 ){
scr = floor( nc/16 )
z = nc - 16 * floor( nc/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
tmpf = as.numeric( sapply(xForc, FUN = function(x) x[series[idx[i + xn, 1]], series[idx[i + xn, 2]],]) )
tmp = c( xDat[series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Correlation Rolling Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
tmpf = as.numeric( sapply(xForc, FUN = function(x) x[series[idx[i + xn, 1]], series[idx[i + xn, 2]],]) )
tmp = c( xDat[series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Correlation Rolling Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else{
d = .divisortable( nc )
par( mfrow= c(d[1], d[2]) )
for(i in 1:nc){
tmpf = as.numeric( sapply(xForc, FUN = function(x) x[series[idx[i, 1]], series[idx[i, 2]],]) )
tmp = c( xDat[series[idx[i, 1]], series[idx[i, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i, 1]]], "-", cnames[series[idx[i, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Correlation Rolling Forecast", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else if( n.ahead > 1 && n.roll == 0 ){
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], rollframe = 0)["sigma"] )
nf = length(yforDat)
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
if( nc > 16 ){
scr = floor( nc/16 )
z = nc - 16 * floor( nc/16 )
start = dev.next( which = dev.cur() )
xn = 0
for( j in 1:scr ){
dev.new( start + j )
par( mfrow = c(4, 4) )
for(i in 1:16){
tmpf = as.numeric( xForc[[1]][series[idx[i + xn, 1]], series[idx[i + xn, 2]],] )
tmp = c( xDat[series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Correlation Unconditional Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
xn = xn + 16
}
if( z != 0 ){
dev.new( dev.next( which = dev.cur() ) + 1 )
par( mfrow = c(4, 4) )
for(i in 1:z){
tmpf = as.numeric( xForc[[1]][series[idx[i + xn, 1]], series[idx[i + xn, 2]],] )
tmp = c( xDat[series[idx[i + xn, 1]], series[idx[i + xn, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i + xn, 1]]], "-", cnames[series[idx[i + xn, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Correlation Unconditional Forecast\n(page...", j, ")", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else{
d = .divisortable( nc )
par( mfrow= c(d[1], d[2]) )
for(i in 1:nc){
tmpf = as.numeric( xForc[[1]][series[idx[i, 1]], series[idx[i, 2]],] )
tmp = c( xDat[series[idx[i, 1]], series[idx[i, 2]], ], tmpf )
plot( yDat, tmp, type = "l", col = colors()[16],
main = paste(cnames[series[idx[i, 1]]], "-", cnames[series[idx[i, 2]]], sep = ""),
ylab = "", xlab = "")
tmpf = c(rep(NA, nac), tmpf )
lines( yDat, tmpf, type = "l", col = colors()[552])
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
grid()
}
title( paste( "DCC Correlation Unconditional Forecast", sep = ""), outer = TRUE, line = -2, cex = 0.75)
}
} else if( n.ahead > 1 && n.roll > 0 ){
cat("\nNo plot available for mixed unconditional and rolling forecasts.")
}
invisible()
}
.plot.dccforecast.5 = function(x, series, ...)
{
if( !is.null(x@mforecast$VARf) ){
stop("\nEW Portfolio Plot not implemented for VARX method!\n")
}
ops = list(...)
N = length(x@uforecast@forecast[[1]]@forecast$series)
n.start = x@uforecast@forecast[[1]]@model$n.start
n.ahead = x@mforecast$model$n.ahead
n.roll = x@mforecast$model$n.roll
cnames = x@mforecast$model$asset.names
if( n.ahead == 1 && n.roll >= 0 ){
Hx = x@mforecast$model$H
nac = dim(Hx)[3]
m = dim(Hx)[1]
w = rep(1/m, m)
yDat = tail( x@uforecast@forecast[[1]]@model$dates, nac )
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], which = "sigma", rollframe = "all") )
nf = length(yforDat)
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
dm = switch(x@mforecast$model$distribution,
mvnorm = "norm",
mvlaplace = "ged",
mvt = "std")
xx = x@mforecast$model$fitted
dportx = wmargin(distribution = x@mforecast$model$distribution, weights = w, cov = Hx, mu = xx,
shape = rshape(x), skew = rskew(x))
q025x = apply(dportx, 1, FUN = function(x)
qdist(distribution = dm, p = 0.025, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
q975x = apply(dportx, 1, FUN = function(x)
qdist(distribution = dm, p = 0.975, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
Hf = array( unlist( rcov(x) ), dim = c(m, m, nf))
muf = fitted(x)
dportf = wmargin(distribution = x@mforecast$model$distribution, weights = w, cov = Hf, mu = muf,
shape = rshape(x), skew = rskew(x))
q025f = apply(dportf, 1, FUN = function(x)
qdist(distribution = dm, p = 0.025, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
q975f = apply(dportf, 1, FUN = function(x)
qdist(distribution = dm, p = 0.975, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
xDat = sapply( x@uforecast@forecast, FUN = function(x) x@model$origdata[(N - nac + 1):(N + n.roll + 1)] )
m = dim(xDat)[2]
w = rep(1/m , m)
port = as.numeric( apply(xDat, 1, "mean") )
plot(yDat, port, type = "l", col = "steelblue", ylab = "", xlab = "",
main = "EW Forecast Portfolio with Rolling 2.5% VaR Limits \n(based on Conditional Weighted Density)",
cex.main = 0.8)
lines(yDat, c(rep(NA, nac), tail(port, nf)), col = 1)
lines(yDat, c(q025x, q025f), col = colors()[55])
lines(yDat, c(q975x, q975f), col = colors()[11])
lines(yDat, c(rep(NA, nac), q025f), col = colors()[553], lwd = 2)
lines(yDat, c(rep(NA, nac), q975f), col = colors()[578], lwd = 2)
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
grid()
} else if( n.ahead > 1 && n.roll == 0 ){
Hx = x@mforecast$model$H
nac = dim(Hx)[3]
m = dim(Hx)[1]
w = rep(1/m, m)
yDat = tail( x@uforecast@forecast[[1]]@model$dates, nac )
yforDat = rownames( as.data.frame(x@uforecast@forecast[[1]], rollframe = 0)["sigma"] )
nf = length(yforDat)
cclass = is(yDat)[1]
yforDat = eval(parse(text = paste("as.",cclass,"(yforDat)", sep = "")))
yDat = c(yDat, yforDat)
dm = switch(x@mforecast$model$distribution,
mvnorm = "norm",
mvlaplace = "ged",
mvt = "std")
xx = x@mforecast$model$fitted
dportx = wmargin(distribution = x@mforecast$model$distribution, weights = w, cov = Hx, mu = xx,
shape = rshape(x), skew = rskew(x))
q025x = apply(dportx, 1, FUN = function(x)
qdist(distribution = dm, p = 0.025, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
q975x = apply(dportx, 1, FUN = function(x)
qdist(distribution = dm, p = 0.975, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
Hf = rcov(x)[[1]]
muf = fitted(x)
dportf = wmargin(distribution = x@mforecast$model$distribution, weights = w, cov = Hf, mu = muf,
shape = rshape(x), skew = rskew(x))
q025f = apply(dportf, 1, FUN = function(x)
qdist(distribution = dm, p = 0.025, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
q975f = apply(dportf, 1, FUN = function(x)
qdist(distribution = dm, p = 0.975, mu = x[1], sigma = x[2], lambda = -0.5,
skew = x[3], shape = x[4]))
xDat = sapply( x@uforecast@forecast, FUN = function(x) x@model$origdata[(N - nac + 1):(N + n.ahead)] )
m = dim(xDat)[2]
w = rep(1/m , m)
port = as.numeric( apply(xDat, 1, "mean") )
plot(yDat, port, type = "l", col = "steelblue", ylab = "", xlab = "",
main = "EW Forecast Portfolio with Unconditional 2.5% VaR Limits \n(based on Conditional Weighted Density)",
cex.main = 0.8)
lines(yDat, c(rep(NA, nac), tail(port, nf)), col = 1)
lines(yDat, c(q025x, q025f), col = colors()[55])
lines(yDat, c(q975x, q975f), col = colors()[11])
lines(yDat, c(rep(NA, nac), q025f), col = colors()[553], lwd = 2)
lines(yDat, c(rep(NA, nac), q975f), col = colors()[578], lwd = 2)
mtext(paste("rgarch : DCC model forecast"), side = 4, adj = 0, padj=0, col = "gray", cex = 0.4)
abline( v = yDat[nac + 1], lty = 3, col = colors()[442])
grid()
} else if( n.ahead > 1 && n.roll > 0 ){
cat("\nNo plot available for mixed unconditional and rolling forecasts.")
}
}
.plotdccroll = function(x, which = "ask", series = c(1, 2), roll = 1, ...)
{
n.roll = length( x@forecast )
roll = as.integer(roll)
if( roll > n.roll | roll < 1 ) stop("\nrgarch-->error roll out of bounds in plot function!")
plot( x@forecast[[roll]], which = which, series = series, ... )
invisible(x)
}
.lowertri.index = function(n, diag = FALSE)
{
x = matrix(1, n, n)
indx = which(x == lower.tri(x, diag = diag), arr.ind = TRUE)
return( indx )
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.