[Uwgarp-commits] r130 - in pkg/GARPFRM: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Mar 23 18:38:40 CET 2014
Author: rossbennett34
Date: 2014-03-23 18:38:40 +0100 (Sun, 23 Mar 2014)
New Revision: 130
Modified:
pkg/GARPFRM/R/boot.R
pkg/GARPFRM/sandbox/test_boot.R
Log:
Adding checks for the boot* functions and adding an example of an arbitrary function to test_boot
Modified: pkg/GARPFRM/R/boot.R
===================================================================
--- pkg/GARPFRM/R/boot.R 2014-03-23 17:10:23 UTC (rev 129)
+++ pkg/GARPFRM/R/boot.R 2014-03-23 17:38:40 UTC (rev 130)
@@ -30,6 +30,7 @@
#' @export
bootFUN <- function(R, FUN="mean", ..., replications=1000, parallel=FALSE){
# R should be a univariate xts object
+ if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
fun <- match.fun(FUN)
if(!is.function(fun)) stop("FUN could not be matched")
@@ -38,6 +39,9 @@
.formals <- formals(fun)
# add the dots
.formals <- modify.args(formals=.formals, ...=..., dots=TRUE)
+ if("portfolio_method" %in% names(.formals)){
+ .formals$portfolio_method <- "single"
+ }
.formals$... <- NULL
}
# print(.formals)
@@ -91,7 +95,7 @@
#' Bootstrap Mean
#'
-#' Bootstrap the mean of an xts object of asset returns
+#' Bootstrap the mean of an xts object or matrix of asset returns
#'
#' @param R xts object or matrix of asset returns
#' @param \dots passthrough parameters to \code{\link[base]{mean}}
@@ -100,6 +104,8 @@
#' @author Ross Bennett
#' @export
bootMean <- function(R, ..., replications=1000, parallel=FALSE){
+ if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
+
if(ncol(R) == 1){
tmp <- .bootMean(R=R, ...=..., replications=replications, parallel=parallel)
} else {
@@ -121,7 +127,7 @@
#' Bootstrap Standard Deviation
#'
-#' Bootstrap the standard deviation of an xts object of asset returns
+#' Bootstrap the standard deviation of an xts object or matrix of asset returns
#'
#' @param R xts object or matrix of asset returns
#' @param \dots passthrough parameters to \code{\link[stats]{sd}}
@@ -130,6 +136,8 @@
#' @author Ross Bennett
#' @export
bootSD <- function(R, ..., replications=1000, parallel=FALSE){
+ if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
+
if(ncol(R) == 1){
tmp <- .bootSD(R=R, ...=..., replications=replications, parallel=parallel)
} else {
@@ -151,7 +159,7 @@
#' Bootstrap StdDev
#'
-#' Bootstrap the StdDev of an xts object of asset returns
+#' Bootstrap the StdDev of an xts object or matrix of asset returns
#'
#' @param R xts object or matrix of asset returns
#' @param \dots passthrough parameters to \code{\link[PerformanceAnalytics]{StdDev}}
@@ -160,6 +168,8 @@
#' @author Ross Bennett
#' @export
bootStdDev <- function(R, ..., replications=1000, parallel=FALSE){
+ if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
+
if(ncol(R) == 1){
tmp <- .bootStdDev(R=R, ...=..., replications=replications, parallel=parallel)
} else {
@@ -190,6 +200,8 @@
#' @author Ross Bennett
#' @export
bootSimpleVolatility <- function(R, ..., replications=1000, parallel=FALSE){
+ if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
+
if(ncol(R) == 1){
tmp <- .bootSimpleVolatility(R=R, ...=..., replications=replications, parallel=parallel)
} else {
@@ -216,7 +228,7 @@
#' Bootstrap Correlation
#'
-#' Bootstrap the correlation of an xts object of asset returns
+#' Bootstrap the correlation of an xts object or matrix of asset returns
#'
#' @param R xts object or matrix of asset returns
#' @param \dots passthrough parameters to \code{\link[stats]{cor}}
@@ -225,6 +237,8 @@
#' @author Ross Bennett
#' @export
bootCor <- function(R, ..., replications=1000, parallel=FALSE){
+ if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
+
if(ncol(R) < 2) stop("R must have 2 or more columns of asset returns")
cnames <- colnames(R)
if(ncol(R) == 2){
@@ -263,7 +277,7 @@
#' Bootstrap Covariance
#'
-#' Bootstrap the covariance of an xts object of asset returns
+#' Bootstrap the covariance of an xts object or matrix of asset returns
#'
#' @param R xts object or matrix of asset returns
#' @param \dots passthrough parameters to \code{\link[stats]{cov}}
@@ -272,6 +286,8 @@
#' @author Ross Bennett
#' @export
bootCov <- function(R, ..., replications=1000, parallel=FALSE){
+ if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
+
cnames <- colnames(R)
if(ncol(R) == 2){
tmp <- .bootCov(R=R, ...=..., replications=replications, parallel=parallel)
@@ -304,7 +320,7 @@
#' Bootstrap Value at Risk
#'
-#' Bootstrap the Value at Risk (VaR) of an xts object of asset returns
+#' Bootstrap the Value at Risk (VaR) of an xts object or matrix of asset returns
#'
#' @param R xts object or matrix of asset returns
#' @param \dots passthrough parameters to \code{\link[PerformanceAnalytics]{VaR}}
@@ -313,6 +329,8 @@
#' @author Ross Bennett
#' @export
bootVaR <- function(R, ..., replications=1000, parallel=FALSE){
+ if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
+
if(ncol(R) == 1){
tmp <- .bootVaR(R=R, ...=..., replications=replications, parallel=parallel)
} else {
@@ -334,7 +352,7 @@
#' Bootstrap Expected Shortfall
#'
-#' Bootstrap the Expected Shortfall (ES) of an xts object of asset returns
+#' Bootstrap the Expected Shortfall (ES) of an xts object or matrix of asset returns
#'
#' @param R xts object or matrix of asset returns
#' @param \dots passthrough parameters to \code{\link[PerformanceAnalytics]{ES}}
@@ -343,6 +361,8 @@
#' @author Ross Bennett
#' @export
bootES <- function(R, ..., replications=1000, parallel=FALSE){
+ if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
+
if(ncol(R) == 1){
tmp <- .bootES(R=R, ...=..., replications=replications, parallel=parallel)
} else {
@@ -357,12 +377,3 @@
return(out)
}
-# .bootMean <- function(R, replications=1000){
-# replications <- as.integer(replications)
-# n <- length(R)
-# out <- vector("numeric", replications)
-# for(i in 1:replications){
-# out[i] <- mean(R[sample.int(n, replace=TRUE)])
-# }
-# mean(out)
-# }
Modified: pkg/GARPFRM/sandbox/test_boot.R
===================================================================
--- pkg/GARPFRM/sandbox/test_boot.R 2014-03-23 17:10:23 UTC (rev 129)
+++ pkg/GARPFRM/sandbox/test_boot.R 2014-03-23 17:38:40 UTC (rev 130)
@@ -9,6 +9,14 @@
set.seed(123)
bootFUN(R1, FUN="mean", replications=10000, parallel=TRUE)
+# arbitrary function
+foo <- function(R, n){
+ R <- tail(R, n)
+ Return.annualized(R, geometric=TRUE)
+}
+
+bootFUN(R1, FUN="foo", n=100, replications=100)
+
# bootstrap various statistics
# mean
bootMean(R[,1])
@@ -28,6 +36,7 @@
# cor
bootCor(R[,1:2])
+bootCor(R[,1:2], method="kendall")
bootCor(R)
# cov
@@ -37,16 +46,14 @@
# VaR
bootVaR(R[,1], p=0.9, method="historical")
bootVaR(R[,1], p=0.9, method="gaussian")
-bootVaR(R, p=0.9, method="historical")
+bootVaR(R, p=0.9, method="historical", invert=FALSE)
# ES
-bootES(R[,1], p=0.9, method="historical")
+bootES(R[,1], p=0.9, method="gaussian")
+bootES(R[,1], p=0.92, method="historical", invert=FALSE)
bootES(R, p=0.9, method="historical")
-# maybe...
-# use bootstrapped returns to imply the prices
-
# foo1 <- function(x){
# # Use sample.int and subset
# x[sample.int(length(x), replace=TRUE)]
More information about the Uwgarp-commits
mailing list