[Uwgarp-commits] r132 - in pkg/GARPFRM: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Mar 26 04:16:38 CET 2014


Author: rossbennett34
Date: 2014-03-26 04:16:35 +0100 (Wed, 26 Mar 2014)
New Revision: 132

Added:
   pkg/GARPFRM/man/getVaREstimates.Rd
   pkg/GARPFRM/man/getVaRViolations.Rd
   pkg/GARPFRM/man/plot.backtestVaR.Rd
Modified:
   pkg/GARPFRM/NAMESPACE
   pkg/GARPFRM/R/EWMA.R
   pkg/GARPFRM/R/backTestVaR.R
   pkg/GARPFRM/man/backTestVaR.Rd
   pkg/GARPFRM/man/plot.EWMA.Rd
Log:
Adding VaR backtesting functions

Modified: pkg/GARPFRM/NAMESPACE
===================================================================
--- pkg/GARPFRM/NAMESPACE	2014-03-24 05:11:14 UTC (rev 131)
+++ pkg/GARPFRM/NAMESPACE	2014-03-26 03:16:35 UTC (rev 132)
@@ -1,4 +1,4 @@
-export(backTestVaR)
+export(backtestVaR)
 export(bootCor)
 export(bootCov)
 export(bootES)
@@ -10,7 +10,6 @@
 export(bootVaR)
 export(CAPM)
 export(chartSML)
-export(countViolations)
 export(efficientFrontier)
 export(efficientFrontierTwoAsset)
 export(endingPrices)
@@ -28,6 +27,8 @@
 export(getFit)
 export(getSpec)
 export(getStatistics)
+export(getVaREstimates)
+export(getVaRViolations)
 export(hypTest)
 export(minVarPortfolio)
 export(monteCarlo)
@@ -46,7 +47,6 @@
 export(simpleVolatility)
 export(tangentPortfolio)
 export(uvGARCH)
-S3method(countViolations,xts)
 S3method(fcstGarch11,DCCfit)
 S3method(getAlphas,capm_mlm)
 S3method(getAlphas,capm_uv)
@@ -60,8 +60,10 @@
 S3method(getStatistics,capm_uv)
 S3method(hypTest,capm_mlm)
 S3method(hypTest,capm_uv)
+S3method(plot,backtestVaR)
 S3method(plot,efficient.frontier)
 S3method(plot,efTwoAsset)
 S3method(plot,EWMA)
 S3method(plot,MonteCarlo)
+S3method(print,backtestVaR)
 S3method(print,EWMA)

Modified: pkg/GARPFRM/R/EWMA.R
===================================================================
--- pkg/GARPFRM/R/EWMA.R	2014-03-24 05:11:14 UTC (rev 131)
+++ pkg/GARPFRM/R/EWMA.R	2014-03-26 03:16:35 UTC (rev 132)
@@ -680,8 +680,8 @@
 #' 
 #' Plot method for EWMA objects.
 #' 
-#' @param x an EWMA object
-#' @param y NULL
+#' @param x an EWMA object created via \code{\link{EWMA}}
+#' @param y not used
 #' @param \dots additional arguments passed to \code{plot.xts}
 #' @param assets character vector or numeric vector of assets to extract from 
 #' the covariance or correlation matrix. The assets can be specified by name or 

Modified: pkg/GARPFRM/R/backTestVaR.R
===================================================================
--- pkg/GARPFRM/R/backTestVaR.R	2014-03-24 05:11:14 UTC (rev 131)
+++ pkg/GARPFRM/R/backTestVaR.R	2014-03-26 03:16:35 UTC (rev 132)
@@ -1,49 +1,246 @@
-#' Backtesting VaR (backTestVaR)
+
+
+# # Backtesting VaR (backTestVaR)
+# # 
+# # Description of backTestVaR. The function should handle UV and MLM.
+# # 
+# # @param R returns
+# # @param CI confidence level
+# # @export
+# backTestVaR <- function(R, CI = 0.95) {
+#   if (ncol(R)>1){stop("One Asset at a time")}
+#   normalVaR = as.numeric(VaR(R, p=CI, method="gaussian")) 
+#   historicalVaR = as.numeric(VaR(R, p=CI, method="historical")) 
+#   modifiedVaR = as.numeric(VaR(R, p=CI, method="modified"))
+#   result = c(normalVaR, historicalVaR, modifiedVaR)
+#   names(result) = c("Normal", "HS", "Modified")  
+#   
+#   return(result)
+# }
+# 
+# # Count backtesting VaR
+# # 
+# # Description of countBacktesting VaR
+# # 
+# # @param backTestVaR object created by \code{\link{backTestVaR}}
+# # @param initialWindow
+# # @param CI
+# # @param temp 
+# # @export
+# countViolations <- function(object, temp, initialWindow, CI){
+#   UseMethod("countViolations")
+# }
+# 
+# # @method countViolations xts
+# # @S3method countViolations xts
+# countViolations.xts <- function(object, temp, initialWindow=10, CI=0.95){
+#   violations = matrix(0, 3, 5)
+#   testWindow = nrow(temp) -initialWindow
+#   rownames(violations) = c("Normal", "HS", "Modified")
+#   colnames(violations) = c("En1", "n1", "1-CI", "Percent", "VaR")
+#   violations[, "En1"] = (1-CI)*initialWindow
+#   violations[, "1-CI"] = 1 - CI
+#   
+#   for(i in colnames(object)) {
+#     violationVaR = temp[index(object), ] < object[, i]
+#     violations[i, "n1"] = sum(violationVaR, na.rm= TRUE)
+#     violations[i, "Percent"] = sum(violationVaR, na.rm=TRUE)/testWindow
+#     violations[i, "VaR"] = violations[i, "n1"]/violations[i, "En1"]
+#   }
+#   return(violations)
+# }
+
+# The backTestVaR and countViolations.xts functions are more or less copied from
+# http://faculty.washington.edu/ezivot/econ589/econ589backtestingRiskModels.r
+# We either need to give credit here or write our own code and structure the
+# way we want for plotting and output.
+
+#' Backtest Value-at-Risk (VaR)
 #' 
-#' Description of backTestVaR. The function should handle UV and MLM.
+#' Backtesting Value-at-Risk estimate over a moving window.
 #' 
-#' @param R returns
-#' @param CI confidence level
+#' @details
+#' The size of the moving window is set with the \code{window} argument. For 
+#' example, if the window size is 100, periods 1:100 are used to estimate the
+#' VaR level for period 101.
+#' 
+#' @param R xts or zoo object of asset returns
+#' @param window size of the moving window in the rolling VaR estimate.
+#' @param p confidence level for the VaR estimate.
+#' @param method method for the VaR calculation. Valid choices are "modified", "guassian", "historical", and "kernel"
+#' @param bootstrap TRUE/FALSE use the bootstrap estimate for the VaR calculation, (default FALSE).
+#' @param bootParallel TRUE/FALSE run the bootstrap in parallel, (default FALSE).
+#' @author Ross Bennett
+#' @seealso \code{\link[PerformanceAnalytics]{VaR}}, \code{\link{bootVaR}}
+#' @examples
+#' data(crsp_weekly)
+#' R <- largecap_weekly[, 1]
+#' backtest <- backtestVaR(R, window=100, p=0.95, method=c("gaussian", "historical", "modified"))
+#' backtest
+#' 
+#' head(getVaREstimates(backtest))
+#' head(getVaRViolations(backtest))
 #' @export
-backTestVaR <- function(R, CI = 0.95) {
-  if (ncol(R)>1){stop("One Asset at a time")}
-  normalVaR = as.numeric(VaR(R, p=CI, method="gaussian")) 
-  historicalVaR = as.numeric(VaR(R, p=CI, method="historical")) 
-  modifiedVaR = as.numeric(VaR(R, p=CI, method="modified"))
-  result = c(normalVaR, historicalVaR, modifiedVaR)
-  names(result) = c("Normal", "HS", "Modified")  
+backtestVaR <- function(R, window=100, p=0.95, method="historical", bootstrap=FALSE, replications=1000, bootParallel=FALSE){
+  if(!is.xts(R)) stop("R must be an xts or zoo object")
+  if(ncol(R) > 1) {
+    warning("VaR backtest only supported for univariate series. Using R[,1]")
+    R <- R[,1]
+  }
+  # number of observations
+  n <- nrow(R)
+  # vector to store the VaR estimates
+  # est <- vector("numeric", (n-window+1))
+  est <- matrix(0, nrow=(n-window+1), ncol=length(method))
+  if(bootstrap){
+    for(j in 1:length(method)){
+      for(i in window:n){
+        tmpR <- R[(i-window+1):i,]
+        # compute VaR estimate
+        est[(i-window+1), j] <- bootVaR(R=tmpR, p=p, method=method[j], portfolio_method="single", replications=replications, parallel=bootParallel)
+      }
+    }
+  } else {
+    for(j in 1:length(method)){
+      for(i in window:n){
+        tmpR <- R[(i-window+1):i,]
+        # compute VaR estimate
+        est[(i-window+1), j] <- VaR(R=tmpR, p=p, method=method[j], portfolio_method="single")
+      }
+    }
+  }
+  # convert to xts and lag by k=1 for 1-step ahead VaR forecast
+  est <- na.omit(lag(xts(est, index(R)[seq.int(from=window, to=n, by=1L)]), k=1))
+  colnames(est) <- paste(method, "VaR", sep=".")
   
-  return(result)
+  # subset the actual returns to the same period as the VaR forecast estimates
+  backtestR <- R[seq.int(from=(window+1), to=n, by=1L)]
+  violation <- matrix(0, nrow=nrow(est), ncol=ncol(est))
+  colnames(violation) <- colnames(est)
+  for(i in 1:ncol(est)){
+    violation[,i] <- backtestR < est[,i]
+  }
+  violation <- xts(violation, index(est))
+  
+  # put the VaR estimate and violation into a list
+  dataVaR <- list(estimate=est, violation=violation)
+  
+  # put the model parameters into a list
+  parameters <- list(p=p, window=window)
+  
+  # structure and return
+  structure(list(VaR=dataVaR, R=R, parameters=parameters), class="backtestVaR")
 }
 
-#' Count backtesting VaR
+#' VaR Estimates
+#' Extract VaR Estimates from a VaR Backtest
 #' 
-#' Description of countBacktesting VaR
+#' @param object an object created by \code{\link{backtestVaR}}.
+#' @param \dots not currently used
+#' @return xts object of unconditional VaR estimates
+#' @author Ross Bennett
+#' @seealso \code{\link{backtestVaR}}
+#' @export
+getVaREstimates <- function(object, ...){
+  if(!inherits(object, "backtestVaR")) stop("object must be of class 'backtestVaR'")
+  object$VaR$estimate
+}
+
+#' VaR Violations
+#' Extract VaR Violations from a VaR Backtest
 #' 
-#' @param backTestVaR object created by \code{\link{backTestVaR}}
-#' @param initialWindow
-#' @param CI
-#' @param temp 
+#' @param object an object created by \code{\link{backtestVaR}}.
+#' @param \dots not currently used
+#' #' @return xts object of VaR violations
+#' @author Ross Bennett
+#' @seealso \code{\link{backtestVaR}}
 #' @export
-countViolations <- function(object, temp, initialWindow, CI){
-  UseMethod("countViolations")
+getVaRViolations <- function(object, ...){
+  if(!inherits(object, "backtestVaR")) stop("object must be of class 'backtestVaR'")
+  object$VaR$violation
 }
 
-#' @method countViolations xts
-#' @S3method countViolations xts
-countViolations.xts <- function(object, temp, initialWindow=10, CI=0.95){
-  violations = matrix(0, 3, 5)
-  testWindow = nrow(temp) -initialWindow
-  rownames(violations) = c("Normal", "HS", "Modified")
-  colnames(violations) = c("En1", "n1", "1-CI", "Percent", "VaR")
-  violations[, "En1"] = (1-CI)*initialWindow
-  violations[, "1-CI"] = 1 - CI
+#' @method print backtestVaR
+#' @S3method print backtestVaR
+print.backtestVaR <- function(x, ...){
+  cat("Value-at-Risk Backtest\n\n")
   
-  for(i in colnames(object)) {
-    violationVaR = temp[index(object), ] < object[, i]
-    violations[i, "n1"] = sum(violationVaR, na.rm= TRUE)
-    violations[i, "Percent"] = sum(violationVaR, na.rm=TRUE)/testWindow
-    violations[i, "VaR"] = violations[i, "n1"]/violations[i, "En1"]
+  cat("Returns Data:\n")
+  print(colnames(x$R))
+  cat("\n")
+  
+  cat("1 - p tail quantile:\n")
+  print(1 - x$parameters$p)
+  cat("\n")
+  
+  cat("Number of Violations:\n")
+  nViolations <- colSums(x$VaR$violation)
+  print(nViolations)
+  cat("\n")
+  
+  cat("Violations (%):\n")
+  print(nViolations / nrow(x$VaR$violation) * 100)
+  cat("\n")
+  
+  #cat("VaR Estimate Data Summary:\n")
+  #print(head(x$VaR$estimate))
+  #print(tail(x$VaR$estimate))
+  #cat("\n")
+}
+
+#' Plotting for VaR Backtest
+#' 
+#' Plotting method for VaR Backtest
+#' 
+#' @param x backtestVaR object created with \code{\link{backtestVaR}}.
+#' @param y not used.
+#' @param \dots passthrough parameters to \code{\link{plot}}.
+#' @param pch plotting 'character' for the violation points, same as in 
+#' \code{\link{plot}}. If NULL, violation points will not be plotted.
+#' @param main the main title
+#' @param ylim limits for the y-axis, same as in \code{\link{plot}}.
+#' @param colorset colorset for plotting the VaR forecasts. The length of 
+#' colorset should be equal to the number of VaR methods.
+#' @param legendLoc legend location. If NULL, no legend is plotted.
+#' @param legendCex numerical value giving the amount by which the legend.
+#' text should be magnified relative to the default. 
+#' @examples
+#' data(crsp_weekly)
+#' R <- largecap_weekly[, 1]
+#' backtest <- backtestVaR(R, window=100, p=0.95, method=c("gaussian", "historical", "modified"))
+#' plot(backtest, pch=18, legendLoc="topright")
+#' @method plot backtestVaR
+#' @S3method plot backtestVaR
+plot.backtestVaR <- function(x, y, ..., pch=NULL, main="VaR Backtest", ylim=NULL, colorset=NULL, legendLoc=NULL, legendCex=0.8){
+  if(!inherits(x, "backtestVaR")) stop("x must be of class 'backtestVaR'")
+  
+  # get the VaR estimates
+  tmpVaR <- x$VaR$estimate
+  tmpViolation <- x$VaR$violation
+  
+  # get the actual retun data
+  R <- x$R
+  
+  # set an appropriate ylim
+  ranges <- c(range(tmpVaR), range(R))
+  if(is.null(ylim)) ylim <- c(min(ranges), max(ranges))
+  
+  # set the colorset
+  if(is.null(colorset)) colorset <- seq.int(from=2, to=(ncol(tmpVaR)+1), by=1)
+  
+  # plot the returns and VaR estimates
+  plot(R, ...=..., main=main, type="n", ylim=ylim)
+  lines(R)
+  for(i in 1:ncol(tmpVaR)){
+    lines(tmpVaR[, i], col=colorset[i])
+    if(!is.null(pch)) points(tmpVaR[,i][which(tmpViolation[,i] == 1)], col=colorset[i], pch=pch)
   }
-  return(violations)
-}
\ No newline at end of file
+  
+  # add the legend to the plot
+  if(!is.null(legendLoc)){
+    legendNames <- c("observed returns", paste(colnames(tmpVaR), " (", 1-x$parameters$p, ")", sep=""))
+    legend(legendLoc, legend=legendNames, col=c(1, colorset), 
+    lty=rep(1, ncol(tmpVaR)+1), cex=legendCex, bty="n")
+  }
+}
+

Modified: pkg/GARPFRM/man/backTestVaR.Rd
===================================================================
--- pkg/GARPFRM/man/backTestVaR.Rd	2014-03-24 05:11:14 UTC (rev 131)
+++ pkg/GARPFRM/man/backTestVaR.Rd	2014-03-26 03:16:35 UTC (rev 132)
@@ -1,16 +1,52 @@
-\name{backTestVaR}
-\alias{backTestVaR}
-\title{Backtesting VaR (backTestVaR)}
+\name{backtestVaR}
+\alias{backtestVaR}
+\title{Backtest Value-at-Risk (VaR)}
 \usage{
-  backTestVaR(R, CI = 0.95)
+  backtestVaR(R, window = 100, p = 0.95,
+    method = "historical", bootstrap = FALSE,
+    replications = 1000, bootParallel = FALSE)
 }
 \arguments{
-  \item{R}{returns}
+  \item{R}{xts or zoo object of asset returns}
 
-  \item{CI}{confidence level}
+  \item{window}{size of the moving window in the rolling
+  VaR estimate.}
+
+  \item{p}{confidence level for the VaR estimate.}
+
+  \item{method}{method for the VaR calculation. Valid
+  choices are "modified", "guassian", "historical", and
+  "kernel"}
+
+  \item{bootstrap}{TRUE/FALSE use the bootstrap estimate
+  for the VaR calculation, (default FALSE).}
+
+  \item{bootParallel}{TRUE/FALSE run the bootstrap in
+  parallel, (default FALSE).}
 }
 \description{
-  Description of backTestVaR. The function should handle UV
-  and MLM.
+  Backtesting Value-at-Risk estimate over a moving window.
 }
+\details{
+  The size of the moving window is set with the
+  \code{window} argument. For example, if the window size
+  is 100, periods 1:100 are used to estimate the VaR level
+  for period 101.
+}
+\examples{
+data(crsp_weekly)
+R <- largecap_weekly[, 1]
+backtest <- backtestVaR(R, window=100, p=0.95, method=c("gaussian", "historical", "modified"))
+backtest
 
+head(getVaREstimates(backtest))
+head(getVaRViolations(backtest))
+}
+\author{
+  Ross Bennett
+}
+\seealso{
+  \code{\link[PerformanceAnalytics]{VaR}},
+  \code{\link{bootVaR}}
+}
+

Added: pkg/GARPFRM/man/getVaREstimates.Rd
===================================================================
--- pkg/GARPFRM/man/getVaREstimates.Rd	                        (rev 0)
+++ pkg/GARPFRM/man/getVaREstimates.Rd	2014-03-26 03:16:35 UTC (rev 132)
@@ -0,0 +1,26 @@
+\name{getVaREstimates}
+\alias{getVaREstimates}
+\title{VaR Estimates
+Extract VaR Estimates from a VaR Backtest}
+\usage{
+  getVaREstimates(object, ...)
+}
+\arguments{
+  \item{object}{an object created by
+  \code{\link{backtestVaR}}.}
+
+  \item{\dots}{not currently used}
+}
+\value{
+  xts object of unconditional VaR estimates
+}
+\description{
+  VaR Estimates Extract VaR Estimates from a VaR Backtest
+}
+\author{
+  Ross Bennett
+}
+\seealso{
+  \code{\link{backtestVaR}}
+}
+

Added: pkg/GARPFRM/man/getVaRViolations.Rd
===================================================================
--- pkg/GARPFRM/man/getVaRViolations.Rd	                        (rev 0)
+++ pkg/GARPFRM/man/getVaRViolations.Rd	2014-03-26 03:16:35 UTC (rev 132)
@@ -0,0 +1,26 @@
+\name{getVaRViolations}
+\alias{getVaRViolations}
+\title{VaR Violations
+Extract VaR Violations from a VaR Backtest}
+\usage{
+  getVaRViolations(object, ...)
+}
+\arguments{
+  \item{object}{an object created by
+  \code{\link{backtestVaR}}.}
+
+  \item{\dots}{not currently used #'}
+}
+\value{
+  xts object of VaR violations
+}
+\description{
+  VaR Violations Extract VaR Violations from a VaR Backtest
+}
+\author{
+  Ross Bennett
+}
+\seealso{
+  \code{\link{backtestVaR}}
+}
+

Modified: pkg/GARPFRM/man/plot.EWMA.Rd
===================================================================
--- pkg/GARPFRM/man/plot.EWMA.Rd	2014-03-24 05:11:14 UTC (rev 131)
+++ pkg/GARPFRM/man/plot.EWMA.Rd	2014-03-26 03:16:35 UTC (rev 132)
@@ -7,9 +7,9 @@
     cexLegend = 0.8)
 }
 \arguments{
-  \item{x}{an EWMA object}
+  \item{x}{an EWMA object created via \code{\link{EWMA}}}
 
-  \item{y}{NULL}
+  \item{y}{not used}
 
   \item{\dots}{additional arguments passed to
   \code{plot.xts}}

Added: pkg/GARPFRM/man/plot.backtestVaR.Rd
===================================================================
--- pkg/GARPFRM/man/plot.backtestVaR.Rd	                        (rev 0)
+++ pkg/GARPFRM/man/plot.backtestVaR.Rd	2014-03-26 03:16:35 UTC (rev 132)
@@ -0,0 +1,47 @@
+\name{plot.backtestVaR}
+\alias{plot.backtestVaR}
+\title{Plotting for VaR Backtest}
+\usage{
+  \method{plot}{backtestVaR} (x, y, ..., pch = NULL,
+    main = "VaR Backtest", ylim = NULL, colorset = NULL,
+    legendLoc = NULL, legendCex = 0.8)
+}
+\arguments{
+  \item{x}{backtestVaR object created with
+  \code{\link{backtestVaR}}.}
+
+  \item{y}{not used.}
+
+  \item{\dots}{passthrough parameters to
+  \code{\link{plot}}.}
+
+  \item{pch}{plotting 'character' for the violation points,
+  same as in \code{\link{plot}}. If NULL, violation points
+  will not be plotted.}
+
+  \item{main}{the main title}
+
+  \item{ylim}{limits for the y-axis, same as in
+  \code{\link{plot}}.}
+
+  \item{colorset}{colorset for plotting the VaR forecasts.
+  The length of colorset should be equal to the number of
+  VaR methods.}
+
+  \item{legendLoc}{legend location. If NULL, no legend is
+  plotted.}
+
+  \item{legendCex}{numerical value giving the amount by
+  which the legend. text should be magnified relative to
+  the default.}
+}
+\description{
+  Plotting method for VaR Backtest
+}
+\examples{
+data(crsp_weekly)
+R <- largecap_weekly[, 1]
+backtest <- backtestVaR(R, window=100, p=0.95, method=c("gaussian", "historical", "modified"))
+plot(backtest, pch=18, legendLoc="topright")
+}
+



More information about the Uwgarp-commits mailing list