[Uwgarp-commits] r129 - in pkg/GARPFRM: . R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Mar 23 18:10:23 CET 2014
Author: rossbennett34
Date: 2014-03-23 18:10:23 +0100 (Sun, 23 Mar 2014)
New Revision: 129
Added:
pkg/GARPFRM/man/bootCor.Rd
pkg/GARPFRM/man/bootCov.Rd
pkg/GARPFRM/man/bootES.Rd
pkg/GARPFRM/man/bootFUN.Rd
pkg/GARPFRM/man/bootMean.Rd
pkg/GARPFRM/man/bootSD.Rd
pkg/GARPFRM/man/bootSimpleVolatility.Rd
pkg/GARPFRM/man/bootStdDev.Rd
pkg/GARPFRM/man/bootVaR.Rd
Modified:
pkg/GARPFRM/NAMESPACE
pkg/GARPFRM/R/boot.R
pkg/GARPFRM/man/rollCor.Rd
pkg/GARPFRM/man/rollCov.Rd
pkg/GARPFRM/sandbox/test_boot.R
Log:
Adding documentation and minor changes to code for bootstrap functions
Modified: pkg/GARPFRM/NAMESPACE
===================================================================
--- pkg/GARPFRM/NAMESPACE 2014-03-23 16:26:12 UTC (rev 128)
+++ pkg/GARPFRM/NAMESPACE 2014-03-23 17:10:23 UTC (rev 129)
@@ -1,4 +1,13 @@
export(backTestVaR)
+export(bootCor)
+export(bootCov)
+export(bootES)
+export(bootFUN)
+export(bootMean)
+export(bootSD)
+export(bootSimpleVolatility)
+export(bootStdDev)
+export(bootVaR)
export(CAPM)
export(chartSML)
export(countViolations)
Modified: pkg/GARPFRM/R/boot.R
===================================================================
--- pkg/GARPFRM/R/boot.R 2014-03-23 16:26:12 UTC (rev 128)
+++ pkg/GARPFRM/R/boot.R 2014-03-23 17:10:23 UTC (rev 129)
@@ -1,4 +1,34 @@
-.bootFUN <- function(R, FUN="mean", ..., replications=1000, parallel=FALSE){
+
+#' Bootstrap
+#'
+#' Bootstrap a function
+#'
+#' @details
+#' \code{R} is the data passed to \code{FUN}. \code{FUN} must have \code{x} or
+#' \code{R} as arguments for the data. For example, see the functions linked to
+#' in the 'See Also' section.
+#'
+#' To run the bootstrap in parallael, this function uses the \code{foreach}
+#' pacakge. From the \code{\link[foreach]{foreach}} documentation, the
+#' Parallel computation depends upon a parallel backend that must be
+#' registered before performing the computation. The parallel backends
+#' available will be system-specific, but include \code{doParallel}, which uses
+#' R's built-in parallel package, \code{doMC}, which uses the multicore
+#' package, and \code{doSNOW}. Each parallel backend has a specific
+#' registration function, such as \code{registerDoParallel} or
+#' \code{registerDoSNOW}.
+#'
+#' @param R xts object or matrix of data passed to \code{FUN}.
+#' @param FUN the function to be applied.
+#' @param \dots optional arguments to \code{FUN}.
+#' @param replications number of bootstrap replications.
+#' @param parallel (default FALSE) to compute the bootstrap in parallel.
+#' @author Ross Bennett
+#' @seealso \code{\link{bootMean}}, \code{\link{bootSD}}, \code{\link{bootStdDev}},
+#' \code{\link{bootSimpleVolatility}}, \code{\link{bootCor}}, \code{\link{bootCov}},
+#' \code{\link{bootVaR}}, \code{\link{bootES}}
+#' @export
+bootFUN <- function(R, FUN="mean", ..., replications=1000, parallel=FALSE){
# R should be a univariate xts object
fun <- match.fun(FUN)
@@ -19,7 +49,7 @@
if(parallel){
stopifnot("package:foreach" %in% search() || require("foreach",quietly = TRUE))
out <- foreach(i=1:replications, .inorder=FALSE, .combine=c, .errorhandling='remove') %dopar% {
- tmpR <- R[sample.int(n, replace=TRUE)]
+ tmpR <- R[sample.int(n, replace=TRUE),]
# match the resampled data to R or x in .formals
if("R" %in% names(.formals)){
.formals <- modify.args(formals=.formals, arglist=NULL, R=tmpR, dots=TRUE)
@@ -56,9 +86,19 @@
.bootMean <- function(R, ..., replications=1000, parallel=FALSE){
# R should be a univariate xts object
- .bootFUN(R=R, FUN="mean", ...=..., replications=replications, parallel=parallel)
+ bootFUN(R=R, FUN="mean", ...=..., replications=replications, parallel=parallel)
}
+#' Bootstrap Mean
+#'
+#' Bootstrap the mean of an xts object of asset returns
+#'
+#' @param R xts object or matrix of asset returns
+#' @param \dots passthrough parameters to \code{\link[base]{mean}}
+#' @param replications number of bootstrap replications.
+#' @param parallel TRUE/FALSE (default FALSE) to compute the bootstrap in parallel.
+#' @author Ross Bennett
+#' @export
bootMean <- function(R, ..., replications=1000, parallel=FALSE){
if(ncol(R) == 1){
tmp <- .bootMean(R=R, ...=..., replications=replications, parallel=parallel)
@@ -76,9 +116,19 @@
.bootSD <- function(R, ..., replications=1000, parallel=FALSE){
# R should be a univariate xts object
- .bootFUN(R=R, FUN="sd", ...=..., replications=replications, parallel=parallel)
+ bootFUN(R=R, FUN="sd", ...=..., replications=replications, parallel=parallel)
}
+#' Bootstrap Standard Deviation
+#'
+#' Bootstrap the standard deviation of an xts object of asset returns
+#'
+#' @param R xts object or matrix of asset returns
+#' @param \dots passthrough parameters to \code{\link[stats]{sd}}
+#' @param replications number of bootstrap replications.
+#' @param parallel TRUE/FALSE (default FALSE) to compute the bootstrap in parallel.
+#' @author Ross Bennett
+#' @export
bootSD <- function(R, ..., replications=1000, parallel=FALSE){
if(ncol(R) == 1){
tmp <- .bootSD(R=R, ...=..., replications=replications, parallel=parallel)
@@ -96,9 +146,19 @@
.bootStdDev <- function(R, ..., replications=1000, parallel=FALSE){
# R should be a univariate xts object
- .bootFUN(R=R, FUN="StdDev", ...=..., replications=replications, parallel=parallel)
+ bootFUN(R=R, FUN="StdDev", ...=..., replications=replications, parallel=parallel)
}
+#' Bootstrap StdDev
+#'
+#' Bootstrap the StdDev of an xts object of asset returns
+#'
+#' @param R xts object or matrix of asset returns
+#' @param \dots passthrough parameters to \code{\link[PerformanceAnalytics]{StdDev}}
+#' @param replications number of bootstrap replications.
+#' @param parallel TRUE/FALSE (default FALSE) to compute the bootstrap in parallel.
+#' @author Ross Bennett
+#' @export
bootStdDev <- function(R, ..., replications=1000, parallel=FALSE){
if(ncol(R) == 1){
tmp <- .bootStdDev(R=R, ...=..., replications=replications, parallel=parallel)
@@ -114,17 +174,58 @@
return(out)
}
-tmpCor <- function(R){
+.bootSimpleVolatility <- function(R, ..., replications=1000, parallel=FALSE){
+ # R should be a univariate xts object
+ bootFUN(R=R, FUN="simpleVolatility", ...=..., replications=replications, parallel=parallel)
+}
+
+#' Bootstrap Simple Volatility
+#'
+#' Bootstrap the simple volatility 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{SimpleVolatility}}
+#' @param replications number of bootstrap replications.
+#' @param parallel TRUE/FALSE (default FALSE) to compute the bootstrap in parallel.
+#' @author Ross Bennett
+#' @export
+bootSimpleVolatility <- function(R, ..., replications=1000, parallel=FALSE){
+ if(ncol(R) == 1){
+ tmp <- .bootSimpleVolatility(R=R, ...=..., replications=replications, parallel=parallel)
+ } else {
+ tmp <- vector("numeric", ncol(R))
+ for(i in 1:ncol(R)){
+ tmp[i] <- .bootSimpleVolatility(R=R[,i], ...=..., replications=replications, parallel=parallel)
+ }
+ }
+ out <- matrix(tmp, nrow=1, ncol=ncol(R))
+ rownames(out) <- "SimpleVolatility"
+ colnames(out) <- colnames(R)
+ return(out)
+}
+
+tmpCor <- function(R, ...){
# R should be a bivariate xts object
- cor(x=R[,1], y=R[,2])
+ cor(x=R[,1], y=R[,2], ...=...)
}
.bootCor <- function(R, ..., replications=1000, parallel=FALSE){
# R should be a bivariate xts object
- .bootFUN(R=R[,1:2], FUN="tmpCor", ...=..., replications=replications, parallel=parallel)
+ bootFUN(R=R[,1:2], FUN="tmpCor", ...=..., replications=replications, parallel=parallel)
}
+#' Bootstrap Correlation
+#'
+#' Bootstrap the correlation of an xts object of asset returns
+#'
+#' @param R xts object or matrix of asset returns
+#' @param \dots passthrough parameters to \code{\link[stats]{cor}}
+#' @param replications number of bootstrap replications.
+#' @param parallel TRUE/FALSE (default FALSE) to compute the bootstrap in parallel.
+#' @author Ross Bennett
+#' @export
bootCor <- function(R, ..., replications=1000, parallel=FALSE){
+ if(ncol(R) < 2) stop("R must have 2 or more columns of asset returns")
cnames <- colnames(R)
if(ncol(R) == 2){
tmp <- .bootCor(R=R, ...=..., replications=replications, parallel=parallel)
@@ -150,16 +251,26 @@
return(out)
}
-tmpCov <- function(R){
+tmpCov <- function(R, ...){
# R should be a bivariate xts object
- cov(x=R[,1], y=R[,2])
+ cov(x=R[,1], y=R[,2], ...=...)
}
.bootCov <- function(R, ..., replications=1000, parallel=FALSE){
# R should be a bivariate xts object
- .bootFUN(R=R[,1:2], FUN="tmpCov", ...=..., replications=replications, parallel=parallel)
+ bootFUN(R=R[,1:2], FUN="tmpCov", ...=..., replications=replications, parallel=parallel)
}
+#' Bootstrap Covariance
+#'
+#' Bootstrap the covariance of an xts object of asset returns
+#'
+#' @param R xts object or matrix of asset returns
+#' @param \dots passthrough parameters to \code{\link[stats]{cov}}
+#' @param replications number of bootstrap replications.
+#' @param parallel TRUE/FALSE (default FALSE) to compute the bootstrap in parallel.
+#' @author Ross Bennett
+#' @export
bootCov <- function(R, ..., replications=1000, parallel=FALSE){
cnames <- colnames(R)
if(ncol(R) == 2){
@@ -188,9 +299,19 @@
.bootVaR <- function(R, ..., replications=1000, parallel=FALSE){
# R should be a univariate xts object
- .bootFUN(R=R[,1], FUN="VaR", ...=..., replications=replications, parallel=parallel)
+ bootFUN(R=R[,1], FUN="VaR", ...=..., replications=replications, parallel=parallel)
}
+#' Bootstrap Value at Risk
+#'
+#' Bootstrap the Value at Risk (VaR) of an xts object of asset returns
+#'
+#' @param R xts object or matrix of asset returns
+#' @param \dots passthrough parameters to \code{\link[PerformanceAnalytics]{VaR}}
+#' @param replications number of bootstrap replications.
+#' @param parallel TRUE/FALSE (default FALSE) to compute the bootstrap in parallel.
+#' @author Ross Bennett
+#' @export
bootVaR <- function(R, ..., replications=1000, parallel=FALSE){
if(ncol(R) == 1){
tmp <- .bootVaR(R=R, ...=..., replications=replications, parallel=parallel)
@@ -208,9 +329,19 @@
.bootES <- function(R, ..., replications=1000, parallel=FALSE){
# R should be a univariate xts object
- .bootFUN(R=R, FUN="ES", ...=..., replications=replications, parallel=parallel)
+ bootFUN(R=R, FUN="ES", ...=..., replications=replications, parallel=parallel)
}
+#' Bootstrap Expected Shortfall
+#'
+#' Bootstrap the Expected Shortfall (ES) of an xts object of asset returns
+#'
+#' @param R xts object or matrix of asset returns
+#' @param \dots passthrough parameters to \code{\link[PerformanceAnalytics]{ES}}
+#' @param replications number of bootstrap replications.
+#' @param parallel TRUE/FALSE (default FALSE) to compute the bootstrap in parallel.
+#' @author Ross Bennett
+#' @export
bootES <- function(R, ..., replications=1000, parallel=FALSE){
if(ncol(R) == 1){
tmp <- .bootES(R=R, ...=..., replications=replications, parallel=parallel)
Added: pkg/GARPFRM/man/bootCor.Rd
===================================================================
--- pkg/GARPFRM/man/bootCor.Rd (rev 0)
+++ pkg/GARPFRM/man/bootCor.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -0,0 +1,25 @@
+\name{bootCor}
+\alias{bootCor}
+\title{Bootstrap Correlation}
+\usage{
+ bootCor(R, ..., replications = 1000, parallel = FALSE)
+}
+\arguments{
+ \item{R}{xts object or matrix of asset returns}
+
+ \item{\dots}{passthrough parameters to
+ \code{\link[stats]{cor}}}
+
+ \item{replications}{number of bootstrap replications.}
+
+ \item{parallel}{TRUE/FALSE (default FALSE) to compute the
+ bootstrap in parallel.}
+}
+\description{
+ Bootstrap the correlation of an xts object of asset
+ returns
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/GARPFRM/man/bootCov.Rd
===================================================================
--- pkg/GARPFRM/man/bootCov.Rd (rev 0)
+++ pkg/GARPFRM/man/bootCov.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -0,0 +1,25 @@
+\name{bootCov}
+\alias{bootCov}
+\title{Bootstrap Covariance}
+\usage{
+ bootCov(R, ..., replications = 1000, parallel = FALSE)
+}
+\arguments{
+ \item{R}{xts object or matrix of asset returns}
+
+ \item{\dots}{passthrough parameters to
+ \code{\link[stats]{cov}}}
+
+ \item{replications}{number of bootstrap replications.}
+
+ \item{parallel}{TRUE/FALSE (default FALSE) to compute the
+ bootstrap in parallel.}
+}
+\description{
+ Bootstrap the covariance of an xts object of asset
+ returns
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/GARPFRM/man/bootES.Rd
===================================================================
--- pkg/GARPFRM/man/bootES.Rd (rev 0)
+++ pkg/GARPFRM/man/bootES.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -0,0 +1,25 @@
+\name{bootES}
+\alias{bootES}
+\title{Bootstrap Expected Shortfall}
+\usage{
+ bootES(R, ..., replications = 1000, parallel = FALSE)
+}
+\arguments{
+ \item{R}{xts object or matrix of asset returns}
+
+ \item{\dots}{passthrough parameters to
+ \code{\link[PerformanceAnalytics]{ES}}}
+
+ \item{replications}{number of bootstrap replications.}
+
+ \item{parallel}{TRUE/FALSE (default FALSE) to compute the
+ bootstrap in parallel.}
+}
+\description{
+ Bootstrap the Expected Shortfall (ES) of an xts object of
+ asset returns
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/GARPFRM/man/bootFUN.Rd
===================================================================
--- pkg/GARPFRM/man/bootFUN.Rd (rev 0)
+++ pkg/GARPFRM/man/bootFUN.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -0,0 +1,52 @@
+\name{bootFUN}
+\alias{bootFUN}
+\title{Bootstrap}
+\usage{
+ bootFUN(R, FUN = "mean", ..., replications = 1000,
+ parallel = FALSE)
+}
+\arguments{
+ \item{R}{xts object or matrix of data passed to
+ \code{FUN}.}
+
+ \item{FUN}{the function to be applied.}
+
+ \item{\dots}{optional arguments to \code{FUN}.}
+
+ \item{replications}{number of bootstrap replications.}
+
+ \item{parallel}{(default FALSE) to compute the bootstrap
+ in parallel.}
+}
+\description{
+ Bootstrap a function
+}
+\details{
+ \code{R} is the data passed to \code{FUN}. \code{FUN}
+ must have \code{x} or \code{R} as arguments for the data.
+ For example, see the functions linked to in the 'See
+ Also' section.
+
+ To run the bootstrap in parallael, this function uses the
+ \code{foreach} pacakge. From the
+ \code{\link[foreach]{foreach}} documentation, the
+ Parallel computation depends upon a parallel backend that
+ must be registered before performing the computation. The
+ parallel backends available will be system-specific, but
+ include \code{doParallel}, which uses R's built-in
+ parallel package, \code{doMC}, which uses the multicore
+ package, and \code{doSNOW}. Each parallel backend has a
+ specific registration function, such as
+ \code{registerDoParallel} or \code{registerDoSNOW}.
+}
+\author{
+ Ross Bennett
+}
+\seealso{
+ \code{\link{bootMean}}, \code{\link{bootSD}},
+ \code{\link{bootStdDev}},
+ \code{\link{bootSimpleVolatility}},
+ \code{\link{bootCor}}, \code{\link{bootCov}},
+ \code{\link{bootVaR}}, \code{\link{bootES}}
+}
+
Added: pkg/GARPFRM/man/bootMean.Rd
===================================================================
--- pkg/GARPFRM/man/bootMean.Rd (rev 0)
+++ pkg/GARPFRM/man/bootMean.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -0,0 +1,24 @@
+\name{bootMean}
+\alias{bootMean}
+\title{Bootstrap Mean}
+\usage{
+ bootMean(R, ..., replications = 1000, parallel = FALSE)
+}
+\arguments{
+ \item{R}{xts object or matrix of asset returns}
+
+ \item{\dots}{passthrough parameters to
+ \code{\link[base]{mean}}}
+
+ \item{replications}{number of bootstrap replications.}
+
+ \item{parallel}{TRUE/FALSE (default FALSE) to compute the
+ bootstrap in parallel.}
+}
+\description{
+ Bootstrap the mean of an xts object of asset returns
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/GARPFRM/man/bootSD.Rd
===================================================================
--- pkg/GARPFRM/man/bootSD.Rd (rev 0)
+++ pkg/GARPFRM/man/bootSD.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -0,0 +1,25 @@
+\name{bootSD}
+\alias{bootSD}
+\title{Bootstrap Standard Deviation}
+\usage{
+ bootSD(R, ..., replications = 1000, parallel = FALSE)
+}
+\arguments{
+ \item{R}{xts object or matrix of asset returns}
+
+ \item{\dots}{passthrough parameters to
+ \code{\link[stats]{sd}}}
+
+ \item{replications}{number of bootstrap replications.}
+
+ \item{parallel}{TRUE/FALSE (default FALSE) to compute the
+ bootstrap in parallel.}
+}
+\description{
+ Bootstrap the standard deviation of an xts object of
+ asset returns
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/GARPFRM/man/bootSimpleVolatility.Rd
===================================================================
--- pkg/GARPFRM/man/bootSimpleVolatility.Rd (rev 0)
+++ pkg/GARPFRM/man/bootSimpleVolatility.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -0,0 +1,26 @@
+\name{bootSimpleVolatility}
+\alias{bootSimpleVolatility}
+\title{Bootstrap Simple Volatility}
+\usage{
+ bootSimpleVolatility(R, ..., replications = 1000,
+ parallel = FALSE)
+}
+\arguments{
+ \item{R}{xts object or matrix of asset returns}
+
+ \item{\dots}{passthrough parameters to
+ \code{\link{SimpleVolatility}}}
+
+ \item{replications}{number of bootstrap replications.}
+
+ \item{parallel}{TRUE/FALSE (default FALSE) to compute the
+ bootstrap in parallel.}
+}
+\description{
+ Bootstrap the simple volatility of an xts object or
+ matrix of asset returns
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/GARPFRM/man/bootStdDev.Rd
===================================================================
--- pkg/GARPFRM/man/bootStdDev.Rd (rev 0)
+++ pkg/GARPFRM/man/bootStdDev.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -0,0 +1,24 @@
+\name{bootStdDev}
+\alias{bootStdDev}
+\title{Bootstrap StdDev}
+\usage{
+ bootStdDev(R, ..., replications = 1000, parallel = FALSE)
+}
+\arguments{
+ \item{R}{xts object or matrix of asset returns}
+
+ \item{\dots}{passthrough parameters to
+ \code{\link[PerformanceAnalytics]{StdDev}}}
+
+ \item{replications}{number of bootstrap replications.}
+
+ \item{parallel}{TRUE/FALSE (default FALSE) to compute the
+ bootstrap in parallel.}
+}
+\description{
+ Bootstrap the StdDev of an xts object of asset returns
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/GARPFRM/man/bootVaR.Rd
===================================================================
--- pkg/GARPFRM/man/bootVaR.Rd (rev 0)
+++ pkg/GARPFRM/man/bootVaR.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -0,0 +1,25 @@
+\name{bootVaR}
+\alias{bootVaR}
+\title{Bootstrap Value at Risk}
+\usage{
+ bootVaR(R, ..., replications = 1000, parallel = FALSE)
+}
+\arguments{
+ \item{R}{xts object or matrix of asset returns}
+
+ \item{\dots}{passthrough parameters to
+ \code{\link[PerformanceAnalytics]{VaR}}}
+
+ \item{replications}{number of bootstrap replications.}
+
+ \item{parallel}{TRUE/FALSE (default FALSE) to compute the
+ bootstrap in parallel.}
+}
+\description{
+ Bootstrap the Value at Risk (VaR) of an xts object of
+ asset returns
+}
+\author{
+ Ross Bennett
+}
+
Modified: pkg/GARPFRM/man/rollCor.Rd
===================================================================
--- pkg/GARPFRM/man/rollCor.Rd 2014-03-23 16:26:12 UTC (rev 128)
+++ pkg/GARPFRM/man/rollCor.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -10,12 +10,12 @@
\item{width}{width of rolling window}
}
\description{
- This function calculates the correlation estimate of the
- returns of two assets over a rolling window
+ This function calculates the correlation estimate between
+ the returns of a pair of assets over a rolling window.
}
\examples{
data(crsp_weekly)
-R <- largecap_weekly[,1:2]
+R <- largecap_weekly[,1:4]
tail(rollCor(R, 10))
}
\author{
Modified: pkg/GARPFRM/man/rollCov.Rd
===================================================================
--- pkg/GARPFRM/man/rollCov.Rd 2014-03-23 16:26:12 UTC (rev 128)
+++ pkg/GARPFRM/man/rollCov.Rd 2014-03-23 17:10:23 UTC (rev 129)
@@ -10,12 +10,12 @@
\item{width}{width of rolling window}
}
\description{
- This function calculates the covariance estimate of the
- returns of two assets over a rolling window
+ This function calculates the covariance estimate between
+ the returns of a pair of assets over a rolling window.
}
\examples{
data(crsp_weekly)
-R <- largecap_weekly[,1:2]
+R <- largecap_weekly[,1:4]
tail(rollCov(R, 10))
}
\author{
Modified: pkg/GARPFRM/sandbox/test_boot.R
===================================================================
--- pkg/GARPFRM/sandbox/test_boot.R 2014-03-23 16:26:12 UTC (rev 128)
+++ pkg/GARPFRM/sandbox/test_boot.R 2014-03-23 17:10:23 UTC (rev 129)
@@ -5,9 +5,9 @@
R1 <- R[1:100,1]
set.seed(123)
-.bootFUN(R1, FUN="mean", replications=10000, parallel=FALSE)
+bootFUN(R1, FUN="mean", replications=10000, parallel=FALSE)
set.seed(123)
-.bootFUN(R1, FUN="mean", replications=10000, parallel=TRUE)
+bootFUN(R1, FUN="mean", replications=10000, parallel=TRUE)
# bootstrap various statistics
# mean
@@ -23,8 +23,9 @@
bootStdDev(R)
# simpleVolatility
+bootSimpleVolatility(R[,1])
+bootSimpleVolatility(R)
-
# cor
bootCor(R[,1:2])
bootCor(R)
More information about the Uwgarp-commits
mailing list