[Uwgarp-commits] r137 - in pkg/GARPFRM: R demo man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Mar 27 01:02:23 CET 2014
Author: rossbennett34
Date: 2014-03-27 01:02:18 +0100 (Thu, 27 Mar 2014)
New Revision: 137
Added:
pkg/GARPFRM/man/plot.capm_mlm.Rd
Modified:
pkg/GARPFRM/R/EWMA.R
pkg/GARPFRM/R/boot.R
pkg/GARPFRM/R/capm.R
pkg/GARPFRM/R/efficient_frontier.R
pkg/GARPFRM/R/garch11.R
pkg/GARPFRM/R/monte_carlo.R
pkg/GARPFRM/demo/monte_carlo.R
pkg/GARPFRM/man/CAPM.Rd
pkg/GARPFRM/man/EWMA.Rd
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
pkg/GARPFRM/man/chartSML.Rd
pkg/GARPFRM/man/efficientFrontier.Rd
pkg/GARPFRM/man/endingPrices.Rd
pkg/GARPFRM/man/estimateLambdaCor.Rd
pkg/GARPFRM/man/estimateLambdaCov.Rd
pkg/GARPFRM/man/estimateLambdaVol.Rd
pkg/GARPFRM/man/getAlphas.Rd
pkg/GARPFRM/man/getBetas.Rd
pkg/GARPFRM/man/getCor.Rd
pkg/GARPFRM/man/getCov.Rd
pkg/GARPFRM/man/getFit.Rd
pkg/GARPFRM/man/getSpec.Rd
pkg/GARPFRM/man/getStatistics.Rd
pkg/GARPFRM/man/hypTest.Rd
pkg/GARPFRM/man/minVarPortfolio.Rd
pkg/GARPFRM/man/monteCarlo.Rd
pkg/GARPFRM/man/plot.EWMA.Rd
pkg/GARPFRM/man/plot.capm_uv.Rd
pkg/GARPFRM/man/plot.efTwoAsset.Rd
pkg/GARPFRM/man/plot.efficient.frontier.Rd
pkg/GARPFRM/man/plot.uvGARCH.Rd
pkg/GARPFRM/man/realizedCor.Rd
pkg/GARPFRM/man/realizedCov.Rd
pkg/GARPFRM/man/realizedVol.Rd
pkg/GARPFRM/man/tangentPortfolio.Rd
pkg/GARPFRM/man/uvGARCH.Rd
Log:
Scrubbing documentation
Modified: pkg/GARPFRM/R/EWMA.R
===================================================================
--- pkg/GARPFRM/R/EWMA.R 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/R/EWMA.R 2014-03-27 00:02:18 UTC (rev 137)
@@ -4,18 +4,23 @@
#' EWMA model to estimate volatility, covariance, and correlation
#'
#' If lambda=NULL, the lambda value can be estimated for univariate estimates
-#' of volatility, covariance, and correlation by minimizing the sum of
-#' squared differences between the estimated value and realized value.
+#' of volatility, covariance, and correlation by minimizing the mean
+#' squared error between the estimated value and realized value.
#'
#' @param R xts object of asset returns
#' @param lambda smoothing parameter, must be greater than 0 or less than 1. If
-#' NULL, lambda will be estimated by minimizing the sum of squared difference
+#' NULL, lambda will be estimated by minimizing the mean squared error
#' between the estimated value and the realized value.
#' @param initialWindow initial window of observations used in estimating the
#' initial conditions
#' @param n number of periods used to calculate realized volatility, covariance, or correlation.
#' @param type estimate volatility, covariance, or correlation.
-#'
+#' @return an EWMA object with the following elements
+#' \itemize{
+#' \item \code{estimate} EWMA model estimated statistic
+#' \item \code{model} list with model parameters
+#' \item \code{data} list with original returns data and realized statistic if applicable
+#' }
#' @examples
#' # data and parameters for EWMA estimate
#' data(crsp_weekly)
@@ -53,8 +58,11 @@
#' # Multivariate EWMA estimate of correlation
#' cor_mv <- EWMA(mvR, lambda, initialWindow, type="correlation")
#' cor_mv
+#' @author Ross Bennett and Thomas Fillebeen
#' @export
EWMA <- function(R, lambda=0.94, initialWindow=10, n=10, type=c("volatility", "covariance", "correlation")){
+ if(!is.xts(R)) stop("R must be an xts object")
+
type <- match.arg(type)
# Check for lambda between 0 and 1 & initialWindow must be greater than ncol(R)
@@ -356,13 +364,14 @@
#'
#' @param R xts object of asset returns
#' @param n number of periods used to calculate realized volatility
-#'
+#' @return xts object of realized volatility
#' @examples
#' data(crsp_weekly)
#' R <- largecap_weekly[, 1]
#' # Calculate realized volatility
#' realizedVolatility <- realizedVol(R[,1], 10)
#' head(realizedVolatility)
+#' @author Ross Bennett
#' @export
realizedVol <- function(R, n){
n <- as.integer(n)[1]
@@ -377,13 +386,14 @@
#'
#' @param R xts object of asset returns
#' @param n number of periods used to calculate realized volatility
-#'
+#' @return xts object of realized covariance
#' @examples
#' data(crsp_weekly)
#' R <- largecap_weekly[, 1:2]
#' # Calculate realized covariance
#' realizedCovariance <- realizedCov(R, 10)
#' head(realizedCovariance)
+#' @author Ross Bennett
#' @export
realizedCov <- function(R, n){
n <- as.integer(n)[1]
@@ -398,12 +408,14 @@
#'
#' @param R xts object of asset returns
#' @param n number of periods used to calculate realized volatility
+#' @return xts object of realized correlation
#' @examples
#' data(crsp_weekly)
#' R <- largecap_weekly[, 1:2]
#' # Calculate realized correlation
#' realizedCorrelation <- realizedCor(R, 10)
#' head(realizedCorrelation)
+#' @author Ross Bennett
#' @export
realizedCor <- function(R, n){
n <- as.integer(n)[1]
@@ -414,6 +426,7 @@
# objective is the mean squared error between estimated volatility and
# realized volatility
objLambdaVol <- function(lambda, R, initialWindow, n){
+ R <- R[,1]
realized <- realizedVol(R, n)
est <- uvEWMAvol(R, lambda, initialWindow)
tmpDat <- na.omit(cbind(est, realized))
@@ -460,9 +473,13 @@
#' R <- largecap_weekly[, 1]
#' initialWindow <- 150
#' lambda <- estimateLambdaVol(R, initialWindow, n=10)
+#' @author Ross Bennett
#' @export
estimateLambdaVol <- function(R, initialWindow=10, n=10){
- opt <- optimize(objLambdaVol, interval=c(0,1), R=R,
+ if(!is.xts(R)) stop("R must be an xts object")
+ if(ncol(R) > 1) warning("lambda to estimate volatility only supported for univariate data (i.e. ncol(R) == 1)")
+
+ opt <- optimize(objLambdaVol, interval=c(0,1), R=R[,1],
initialWindow=initialWindow, n=n,
tol=.Machine$double.eps)
lambda <- opt$minimum
@@ -486,9 +503,13 @@
#' R <- largecap_weekly[, 1:2]
#' initialWindow <- 150
#' lambda <- estimateLambdaCov(R, initialWindow, n=10)
+#' @author Ross Bennett
#' @export
estimateLambdaCov <- function(R, initialWindow=10, n=10){
- opt <- optimize(objLambdaCov, interval=c(0,1), R=R,
+ if(!is.xts(R)) stop("R must be an xts object")
+ if(ncol(R) > 2) warning("lambda to estimate covariance only supported for bivariate data (i.e. ncol(R) == 2)")
+
+ opt <- optimize(objLambdaCov, interval=c(0,1), R=R[,1:2],
initialWindow=initialWindow, n=n,
tol=.Machine$double.eps)
lambda <- opt$minimum
@@ -511,9 +532,13 @@
#' R <- largecap_weekly[, 1:2]
#' initialWindow <- 150
#' lambda <- estimateLambdaCor(R, initialWindow, n=10)
+#' @author Ross Bennett
#' @export
estimateLambdaCor <- function(R, initialWindow=10, n=10){
- opt <- optimize(objLambdaCor, interval=c(0,1), R=R,
+ if(!is.xts(R)) stop("R must be an xts object")
+ if(ncol(R) > 2) warning("lambda to estimate covariance only supported for bivariate data (i.e. ncol(R) == 2)")
+
+ opt <- optimize(objLambdaCor, interval=c(0,1), R=R[,1:2],
initialWindow=initialWindow, n=n,
tol=.Machine$double.eps)
lambda <- opt$minimum
@@ -544,7 +569,7 @@
#'
#' Extract the covariance of two assets from an \code{mvEWMAcov} object
#'
-#' @param object an EWMA object created by \code{EWMA}
+#' @param object an EWMA object created by \code{\link{EWMA}}
#' @param assets character vector or numeric vector. The assets can be
#' specified by name or index.
#' @examples
@@ -555,6 +580,7 @@
#' cov_mv <- EWMA(mvR, lambda, initialWindow, type="covariance")
#' # Extract the estimated covariance between ORCL and MSFT
#' tail(getCov(cov_mv, assets=c("ORCL", "MSFT")))
+#' @author Ross Bennett and Thomas Fillebeen
#' @export
getCov <- function(EWMA, assets){
UseMethod("getCov")
@@ -629,7 +655,7 @@
#'
#' Extract the correlation of two assets from an \code{mvEWMAcor} object
#'
-#' @param object an EWMA object created by \code{EWMA}
+#' @param object an EWMA object created by \code{\link{EWMA}}
#' @param assets character vector or numeric vector. The assets can be
#' specified by name or index.
#' @examples
@@ -640,6 +666,7 @@
#' cor_mv <- EWMA(mvR, lambda, initialWindow, type="correlation")
#' # Extract the estimated correlation between ORCL and MSFT
#' tail(getCor(cor_mv, assets=c("ORCL", "MSFT")))
+#' @author Ross Bennett and Thomas Fillebeen
#' @export
getCor <- function(EWMA, assets){
UseMethod("getCor")
@@ -682,7 +709,7 @@
#'
#' @param x an EWMA object created via \code{\link{EWMA}}
#' @param y not used
-#' @param \dots additional arguments passed to \code{plot.xts}
+#' @param \dots passthrough parameters 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
#' index. This argument is only usd for multivariate EWMA estimates of
@@ -721,6 +748,7 @@
#' # These two are equivalent
#' plot(cor_mv, assets=c("ORCL", "EMC"))
#' plot(cor_mv, assets=c(1, 4))
+#' @author Ross Bennett
#' @method plot EWMA
#' @S3method plot EWMA
plot.EWMA <- function(x, y=NULL, ..., assets=c(1,2), legendLoc=NULL, main="EWMA Estimate", cexLegend=0.8){
Modified: pkg/GARPFRM/R/boot.R
===================================================================
--- pkg/GARPFRM/R/boot.R 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/R/boot.R 2014-03-27 00:02:18 UTC (rev 137)
@@ -13,8 +13,8 @@
#' should be written to apply the bootstrap function to each column of data.
#'
#' 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
+#' pacakge. According to 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
@@ -30,7 +30,7 @@
#' @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}}
+#' \code{\link{bootVaR}}, \code{\link{bootES}}, \code{\link[foreach]{foreach}}
#' @export
bootFUN <- function(R, FUN="mean", ..., replications=1000, parallel=FALSE){
# R should be a univariate xts object
@@ -114,6 +114,7 @@
#' R <- largecap_weekly[,1:4]
#' bootMean(R[,1])
#' bootMean(R)
+#' @seealso \code{\link[base]{mean}}
#' @export
bootMean <- function(R, ..., replications=1000, parallel=FALSE){
if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
@@ -154,6 +155,7 @@
#' R <- largecap_weekly[,1:4]
#' bootSD(R[,1])
#' bootSD(R)
+#' @seealso \code{\link[stats]{sd}}
#' @export
bootSD <- function(R, ..., replications=1000, parallel=FALSE){
if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
@@ -193,6 +195,7 @@
#' R <- largecap_weekly[,1:4]
#' bootStdDev(R[,1])
#' bootStdDev(R)
+#' @seealso \code{\link[PerformanceAnalytics]{StdDev}}
#' @export
bootStdDev <- function(R, ..., replications=1000, parallel=FALSE){
if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
@@ -223,7 +226,7 @@
#' 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 \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
@@ -232,6 +235,7 @@
#' R <- largecap_weekly[,1:4]
#' bootSimpleVolatility(R[,1])
#' bootSimpleVolatility(R)
+#' @seealso \code{\link{simpleVolatility}}
#' @export
bootSimpleVolatility <- function(R, ..., replications=1000, parallel=FALSE){
if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
@@ -278,6 +282,7 @@
#' bootCor(R[,1:2])
#' bootCor(R[,1:2], method="kendall")
#' bootCor(R)
+#' @seealso \code{\link[stats]{cor}}
#' @export
bootCor <- function(R, ..., replications=1000, parallel=FALSE){
if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
@@ -333,6 +338,7 @@
#' R <- largecap_weekly[,1:4]
#' bootCov(R[,1:2])
#' bootCov(R)
+#' @seealso \code{\link[stats]{cov}}
#' @export
bootCov <- function(R, ..., replications=1000, parallel=FALSE){
if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
@@ -383,6 +389,7 @@
#' bootVaR(R[,1], p=0.9, method="historical")
#' bootVaR(R[,1], p=0.9, method="gaussian")
#' bootVaR(R, p=0.9, method="historical", invert=FALSE)
+#' @seealso \code{\link[PerformanceAnalytics]{VaR}}
#' @export
bootVaR <- function(R, ..., replications=1000, parallel=FALSE){
if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
@@ -423,6 +430,7 @@
#' bootVaR(R[,1], p=0.9, method="historical")
#' bootVaR(R[,1], p=0.9, method="gaussian")
#' bootVaR(R, p=0.9, method="historical", invert=FALSE)
+#' @seealso \code{\link[PerformanceAnalytics]{ES}}
#' @export
bootES <- function(R, ..., replications=1000, parallel=FALSE){
if(!is.matrix(R) | !is.xts(R)) stop("R must be an xts or matrix")
Modified: pkg/GARPFRM/R/capm.R
===================================================================
--- pkg/GARPFRM/R/capm.R 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/R/capm.R 2014-03-27 00:02:18 UTC (rev 137)
@@ -22,10 +22,11 @@
#' Capital Asset Pricing Model
#'
-#' Description of CAPM
+#' TODO: Need a better description of the CAPM
+#'
#' Retrieves alphas, betas, as well as pvalue and tstats.
-#' The Model is used to determine a theoretically appropriate rate of return
-#' of an asset's non-diversifiable risk.
+#' The CAPM is used to determine a theoretically appropriate rate of return
+#' of the non-diversifiable risk of an asset.
#'
#' @param R asset returns
#' @param Rmkt market returns
@@ -58,7 +59,7 @@
#' CAPM alphas
#'
-#' Description of CAPM alphas: retrieves alpha (intercept) from CAPM object.
+#' Extract the computed alphas (intercept) from the fitted CAPM object.
#'
#' @param object a capm object created by \code{\link{CAPM}}
#' @export
@@ -85,7 +86,7 @@
#' CAPM betas
#'
-#' Description of CAPM betas: retrieves beta (slope) from CAPM object.
+#' Extract the computed alpha (intercept) from the CAPM object.
#'
#' @param object a capm object created by \code{\link{CAPM}}
#' @export
@@ -112,9 +113,9 @@
#' CAPM statistics
#'
-#' Description of CAPM statistics: retrieves standard error, t-values, and p-values
+#' Extract the standard error, t-values, and p-values from the CAPM object.
#'
-#' @param object a capm object created by \code{\link{CAPM}}
+#' @param object a capm object created by \code{\link{CAPM}}.
#' @export
getStatistics <- function(object){
UseMethod("getStatistics")
@@ -157,58 +158,78 @@
return(tmp_sm)
}
-# CAPM plotting for UV
+#' Plotting method for CAPM
+#'
+#' Plot a fitted CAPM object
+#'
+#' @param x a capm object created by \code{\link{CAPM}}.
+#' @param y not used
+#' @param \dots passthrough parameters to \code{\link{plot}}.
+#' @param main a main title for the plot
#' @export
-plot.capm_uv <- function(object){
- xlab <- colnames(object$x_data)
- ylab <- colnames(object$y_data)
- plot(x=coredata(object$x_data), y=(object$y_data), xlab=xlab, ylab=ylab, main="CAPM")
- abline(object)
+plot.capm_uv <- function(x, y, ..., main="CAPM"){
+ xlab <- colnames(x$x_data)
+ ylab <- colnames(x$y_data)
+ plot(x=coredata(x$x_data), y=(x$y_data), ...=..., xlab=xlab, ylab=ylab, main=main)
+ abline(x)
abline(h=0,v=0,lty=3)
- alpha = coef(summary(object))[1,1]
- a_tstat = coef(summary(object))[1,2]
- beta = coef(summary(object))[2,1]
- b_tstat = coef(summary(object))[2,2]
+ alpha = coef(summary(x))[1,1]
+ a_tstat = coef(summary(x))[1,2]
+ beta = coef(summary(x))[2,1]
+ b_tstat = coef(summary(x))[2,2]
legend("topleft", legend=c(paste("alpha =", round(alpha,dig=2),"(", round(a_tstat,dig=2),")"),
paste("beta =", round(beta,dig=2),"(", round(b_tstat,dig=2),")")), cex=.8, bty="n")
}
-# CAPM plotting for mlm
+#' Plotting method for CAPM
+#'
+#' Plot a fitted CAPM object
+#'
+#' @param x a capm object created by \code{\link{CAPM}}.
+#' @param y not used
+#' @param \dots passthrough parameters to \code{\link{plot}}.
+#' @param main a main title for the plot
#' @export
-plot.capm_mlm <- function(object){
- if(ncol(object$y_data) > 4) warning("Only first 4 assets will be graphically displayed")
- par(mfrow=c(2,round(ncol(coef(object))/2)))
- Rmkt = object$x_data
- nbPlot = min(ncol(coef(object)),4)
+plot.capm_mlm <- function(x, y, ..., main="CAPM"){
+ if(ncol(x$y_data) > 4) warning("Only first 4 assets will be graphically displayed")
+ par(mfrow=c(2,round(ncol(coef(x))/2)))
+ Rmkt = x$x_data
+ nbPlot = min(ncol(coef(x)),4)
for (i in 1:nbPlot){
- tmp = CAPM(object$y_data[,i],Rmkt)
- plot(tmp)
+ tmp = CAPM(x$y_data[,i], Rmkt)
+ plot(tmp, ...=..., main=main)
}
}
+
#' CAPM SML
#'
-#' Description of CAPM Security Market Line (SML)
-#' SML is the represesentation of the CAPM. It illustrates the expected rate of return
-#' of an individual secuirty as a function of systematic, non-diversified risk (known as beta).
+#' Security Market Line (SML) of the CAPM.
+#' The SML is a represesentation of the CAPM. It illustrates the expected rate
+#' of return of an individual security as a function of systematic,
+#' non-diversified risk (known as beta).
#'
-#' @param object a capm object created by \code{\link{CAPM}}
+#' @param object a capm object created by \code{\link{CAPM}}.
+#' @param \dots passthrough parameters to \code{\link{plot}}.
+#' @param main a main title for the plot.
#' @export
-chartSML <- function(object){
+chartSML <- function(object, ..., main="Estimated SML"){
if(!inherits(object, "capm_mlm")) stop("object must be of class capm_mlm")
#' Plot expected return versus beta
- mu.hat = colMeans(object$y_data,na.rm=TRUE)
+ mu.hat = colMeans(object$y_data, na.rm=TRUE)
betas = getBetas(object)
sml.fit = lm(mu.hat~betas)
# Plot Fitted SML
- plot(betas,mu.hat,main="Estimated SML")
+ plot(betas,mu.hat,main=main, ...=...)
abline(sml.fit)
legend("topleft",1, "Estimated SML",1)
}
-#' CAPM hypTest
+#' CAPM Hypothesis Test
#'
#' Description of CAPM beta/alpha hypothesis test
+#' TODO: We need to clearly define the null hypothesis here
+#'
#' Generalization is termed a two-sided or two-tailed test.
#' Returns a true (reject) or false (fail to reject).
#'
@@ -244,4 +265,4 @@
tmp_B = tmp_sm[seq(2,nrow(tmp_sm),2),4] < CI
result = list(alpha = tmp_A, beta = tmp_B)
return(result)
-}
\ No newline at end of file
+}
Modified: pkg/GARPFRM/R/efficient_frontier.R
===================================================================
--- pkg/GARPFRM/R/efficient_frontier.R 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/R/efficient_frontier.R 2014-03-27 00:02:18 UTC (rev 137)
@@ -26,7 +26,6 @@
#' portfolio of two assets following the equations presented in
#' Chapter 3: Delineating Efficient Portfolios.
#'
-#'
#' @param R1 expected return for asset 1
#' @param R2 expected return for asset 2
#' @param X1 fraction of portfolio invested in asset 1
@@ -108,7 +107,8 @@
#' Note that the values for the minimum variance portfolio are an approximation
#' and depend on the number of portfolios used to create the efficient frontier.
#'
-#' @param ef efficient frontier object created via \code{efficientFrontierTwoAsset}
+#' @param ef efficient frontier object created via \code{\link{efficientFrontierTwoAsset}}
+#' @seealso \code{\link{efficientFrontierTwoAsset}}
#' @export
minVarPortfolio <- function(ef){
if(!inherits(ef, "efTwoAsset")) stop("ef must be of class 'efTwoAsset'")
@@ -118,13 +118,14 @@
#' Tangent Portfolio
#'
-#' Extract the tangent portfolio from an efficient frontier. The tangent portfolio
-#' is the portfolio which maximizes risk adjusted return.
+#' Extract the tangent portfolio from an efficient frontier. The tangent
+#' portfolio is the portfolio which maximizes risk adjusted return.
#'
#' Note that the values for the tangent portfolios are an approximation and
#' depend on the number of portfolios used to create the efficient frontier.
#'
-#' @param ef efficient frontier object created via \code{efficientFrontierTwoAsset}
+#' @param ef efficient frontier object created via \code{\link{efficientFrontierTwoAsset}}
+#' @seealso \code{\link{efficientFrontierTwoAsset}}
#' @export
tangentPortfolio <- function(ef){
if(!inherits(ef, "efTwoAsset")) stop("ef must be of class 'efTwoAsset'")
@@ -138,7 +139,7 @@
#'
#' Plot the efficient frontier in return - standard deviation space
#'
-#' @param x object of class \code{efficient.frontier}
+#' @param x object of class \code{efTwoAsset} created via \code{\link{efficientFrontierTwoAsset}}
#' @param y not used
#' @param \dots passthrough parameters
#' @param chartAssets TRUE/FALSE to include the assets in the plot
@@ -208,10 +209,6 @@
pch=c(NA, NA, 15, 17), bty="n", cex=0.75)
}
-
-
-
-
#' Efficient Frontier
#'
#' Generate portfolios along an efficient frontier.
@@ -219,7 +216,7 @@
#' This is a wrapper function for code in PortfolioAnalytics to initialize a
#' portfolio and create an efficint frontier in mean - standard deviation space.
#' Box constraints and group constraints are supported for constrained
-#' optimation to generate portfolios along the efficient frontier.
+#' optimization to generate portfolios along the efficient frontier.
#'
#' @param R xts object of asset returns
#' @param nPortfolios number of portfolios to generate along efficient frontier
@@ -254,19 +251,20 @@
#'
#' Plot the efficient frontier in return - standard deviation space
#'
-#' @param x object of class \code{efficient.frontier}
+#' @param x object of class \code{efficient.frontier} created via \code{\link{efficientFrontier}}
#' @param y not used
#' @param \dots passthrough parameters
#' @param rf risk free rate
#' @param chartAssets TRUE/FALSE to include the assets in the plot
#' @param labelAssets TRUE/FALSE to include the labels of the assets in the plot
#' @param main a main title for the plot
-#' @param xlim set the x-axis limit, same as in \code{plot}
-#' @param ylim set the x-axis limit, same as in \code{plot}
-#' @param type what type of plot should be drawn, same as in \code{plot}
+#' @param xlim set the x-axis limit, same as in \code{\link{plot}}
+#' @param ylim set the x-axis limit, same as in \code{\link{plot}}
+#' @param type what type of plot should be drawn, same as in \code{\link{plot}}
#' @param pchAssets plotting character of the assets
#' @param cexAssets numerical value giving the amount by which the asset points
#' and labels should be magnified relative to the default.
+#' @seealso \code{\link{efficientFrontier}}
#' @method plot efficient.frontier
#' @S3method plot efficient.frontier
plot.efficient.frontier <- function(x, y, ..., rf=0, chartAssets=TRUE,
Modified: pkg/GARPFRM/R/garch11.R
===================================================================
--- pkg/GARPFRM/R/garch11.R 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/R/garch11.R 2014-03-27 00:02:18 UTC (rev 137)
@@ -8,6 +8,10 @@
# we need to support GARCH models for both univariate and multivariate data
+## The GARP text does not have any discussion on multivariate GARCH models.
+## I think we should omit this for phase 1 and maybe reconsider in phase 2
+## or beyond.
+
#' GARCH Models
#'
#' This function is a basic wrapper of functions in the rugarch and rmgarch
@@ -79,6 +83,13 @@
#'
#' Specify and fit a univariate GARCH model
#'
+#' @details
+#' This function is a basic wrapper of functions in the rugarch package
+#' to specify and fit GARCH models. The rugarch package
+#' provides functions to specify and fit a rich set of GARCH models.
+#' The purpose of this function is to specify and fit a GARCH model while
+#' abstracting away some complexities.
+#'
#' @param R xts object of asset returns.
#' @param model GARCH Model to specify and fit. Valid GARCH models are
#' “sGARCH”, “fGARCH”, “eGARCH”, “gjrGARCH”, “apARCH”, “iGARCH” and “csGARCH”.
@@ -100,6 +111,8 @@
#' @param fitControl named list of arguments for the fitting routine
#' @param solverControl named list of arguments for the solver
#' @return a list of length two containing GARCH specification and GARCH fit objects
+#' @author Ross Bennett
+#' @seealso \code{\link[rugarch]{ugarchspec}}, \code{\link[rugarch]{ugarchfit}}
#' @export
uvGARCH <- function(R, model="sGARCH",
garchOrder=c(1, 1),
@@ -144,9 +157,9 @@
class="uvGARCH"))
}
-#' Get GARCH Specification
+#' Get GARCH Model Specification
#'
-#' Function to extract the GARCH specification object
+#' Function to extract the GARCH model specification object
#'
#' @param garch a GARCH model specification and fit created with \code{uvGARCH}
#' @return an object of class uGARCHspec
@@ -161,9 +174,9 @@
garch$spec
}
-#' Get GARCH Model Fit
+#' Get Fitted GARCH Model
#'
-#' Function to extract the GARCH fit object
+#' Function to extract the fitted GARCH model object
#'
#' @param garch a GARCH model specification and fit created with \code{uvGARCH}
#' @return an object of class uGARCHfit
@@ -183,7 +196,7 @@
#' Plots for fitted GARCH Models
#'
#' @param x uvGARCH object create via \code{uvGARCH}
-#' @param y
+#' @param y not used
#' @param \dots additional parameters passed to plot method for uGARCHfit objects
#' @param which plot selection
plot.uvGARCH <- function(x, y, ..., which){
Modified: pkg/GARPFRM/R/monte_carlo.R
===================================================================
--- pkg/GARPFRM/R/monte_carlo.R 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/R/monte_carlo.R 2014-03-27 00:02:18 UTC (rev 137)
@@ -32,16 +32,34 @@
#' Monte Carlo Price Path Simulation
#'
#' Run \code{N} monte carlo simulations to generate asset price paths following
-#' a geometric brownian motion process.
+#' a geometric brownian motion process with constrant drift rate and constant
+#' volatility.
#'
-#' TODO: add equations for GBM
+#' The Geometric Brownian Motion process to describe small movements in prices
+#' is given by
+#' \deqn{
+#' d S_t = \mu S_t dt + \sigma dz_t
+#' }
#'
-#' @note This function returns a m x N matrix of simulated price paths where
+#' ln S is simulated rather than simulating S directly such that
+#' \deqn{
+#' S_t = S_{t-1} exp((\mu - 0.5 \sigma^2) dt + \sigma \sqrt{dt} \epsilon)
+#' }
+#'
+#' where:
+#' \itemize{
+#' \item S_t is the asset price at time t
+#' \item S_{t-1} is the asset price at time t-1
+#' \item mu is the constant drift rate
+#' \item sigma is the constant volatility rate
+#' \item epsilon is a standard normal random variable
+#' }
+#'
+#' @note This function returns an m x N matrix of simulated price paths where
#' m is the number of steps + 1 and N is the number of simulations. This can be
-#' very memory and compute intensive with a large number of steps and/or a
-#' large number of simulations.
-#' More efficient methods in terms of speed and memory should be used, for
-#' example, to price options.
+#' very memory and computatitonally intensive with a large number of steps
+#' and/or a large number of simulations. More efficient methods in terms of
+#' speed and memory should be used, for example, to price options.
#'
#' @param mu annualized expected return
#' @param sigma annualized standard deviation
@@ -78,6 +96,7 @@
#' Get the ending prices, i.e. terminal values, of a monte carlo simulation
#' @param mc monte carlo object created with \code{monteCarlo}
#' @return vector ending prices
+#' @examples
#' library(GARPFRM)
#'
#' mc <- monteCarlo(0.05, 0.25, 500, 1, 52, 10)
Modified: pkg/GARPFRM/demo/monte_carlo.R
===================================================================
--- pkg/GARPFRM/demo/monte_carlo.R 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/demo/monte_carlo.R 2014-03-27 00:02:18 UTC (rev 137)
@@ -2,6 +2,7 @@
library(GARPFRM)
+# Simulate 500 asset price paths
mc <- monteCarlo(0.05, 0.25, 500, 1, 52, 10)
# plot the simulated asset paths from the monte carlo simulation
@@ -13,6 +14,9 @@
# plot the ending prices
plotEndingPrices(mc)
+summary(ending_prices)
+quantile(ending_prices, c(0.05, 0.95))
+
# Add examples of pricing options
# european
# path-dependent like Asian or barrier options
Modified: pkg/GARPFRM/man/CAPM.Rd
===================================================================
--- pkg/GARPFRM/man/CAPM.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/CAPM.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -10,11 +10,13 @@
\item{Rmkt}{market returns}
}
\description{
- Description of CAPM Retrieves alphas, betas, as well as
- pvalue and tstats. The Model is used to determine a
- theoretically appropriate rate of return of an asset's
- non-diversifiable risk.
+ TODO: Need a better description of the CAPM
}
+\details{
+ Retrieves alphas, betas, as well as pvalue and tstats.
+ The CAPM is used to determine a theoretically appropriate
+ rate of return of the non-diversifiable risk of an asset.
+}
\examples{
data(crsp.short)
Modified: pkg/GARPFRM/man/EWMA.Rd
===================================================================
--- pkg/GARPFRM/man/EWMA.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/EWMA.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -10,8 +10,8 @@
\item{lambda}{smoothing parameter, must be greater than 0
or less than 1. If NULL, lambda will be estimated by
- minimizing the sum of squared difference between the
- estimated value and the realized value.}
+ minimizing the mean squared error between the estimated
+ value and the realized value.}
\item{initialWindow}{initial window of observations used
in estimating the initial conditions}
@@ -22,6 +22,13 @@
\item{type}{estimate volatility, covariance, or
correlation.}
}
+\value{
+ an EWMA object with the following elements \itemize{
+ \item \code{estimate} EWMA model estimated statistic
+ \item \code{model} list with model parameters \item
+ \code{data} list with original returns data and realized
+ statistic if applicable }
+}
\description{
EWMA model to estimate volatility, covariance, and
correlation
@@ -29,8 +36,8 @@
\details{
If lambda=NULL, the lambda value can be estimated for
univariate estimates of volatility, covariance, and
- correlation by minimizing the sum of squared differences
- between the estimated value and realized value.
+ correlation by minimizing the mean squared error between
+ the estimated value and realized value.
}
\examples{
# data and parameters for EWMA estimate
@@ -70,4 +77,7 @@
cor_mv <- EWMA(mvR, lambda, initialWindow, type="correlation")
cor_mv
}
+\author{
+ Ross Bennett and Thomas Fillebeen
+}
Modified: pkg/GARPFRM/man/bootCor.Rd
===================================================================
--- pkg/GARPFRM/man/bootCor.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/bootCor.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -29,4 +29,7 @@
\author{
Ross Bennett
}
+\seealso{
+ \code{\link[stats]{cor}}
+}
Modified: pkg/GARPFRM/man/bootCov.Rd
===================================================================
--- pkg/GARPFRM/man/bootCov.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/bootCov.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -28,4 +28,7 @@
\author{
Ross Bennett
}
+\seealso{
+ \code{\link[stats]{cov}}
+}
Modified: pkg/GARPFRM/man/bootES.Rd
===================================================================
--- pkg/GARPFRM/man/bootES.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/bootES.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -29,4 +29,7 @@
\author{
Ross Bennett
}
+\seealso{
+ \code{\link[PerformanceAnalytics]{ES}}
+}
Modified: pkg/GARPFRM/man/bootFUN.Rd
===================================================================
--- pkg/GARPFRM/man/bootFUN.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/bootFUN.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -34,9 +34,9 @@
bootstrap function to each column of data.
To run the bootstrap in parallael, this function uses the
- \code{foreach} pacakge. From the
+ \code{foreach} pacakge. According to the
\code{\link[foreach]{foreach}} documentation, the
- Parallel computation depends upon a parallel backend that
+ 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
@@ -53,6 +53,7 @@
\code{\link{bootStdDev}},
\code{\link{bootSimpleVolatility}},
\code{\link{bootCor}}, \code{\link{bootCov}},
- \code{\link{bootVaR}}, \code{\link{bootES}}
+ \code{\link{bootVaR}}, \code{\link{bootES}},
+ \code{\link[foreach]{foreach}}
}
Modified: pkg/GARPFRM/man/bootMean.Rd
===================================================================
--- pkg/GARPFRM/man/bootMean.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/bootMean.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -28,4 +28,7 @@
\author{
Ross Bennett
}
+\seealso{
+ \code{\link[base]{mean}}
+}
Modified: pkg/GARPFRM/man/bootSD.Rd
===================================================================
--- pkg/GARPFRM/man/bootSD.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/bootSD.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -28,4 +28,7 @@
\author{
Ross Bennett
}
+\seealso{
+ \code{\link[stats]{sd}}
+}
Modified: pkg/GARPFRM/man/bootSimpleVolatility.Rd
===================================================================
--- pkg/GARPFRM/man/bootSimpleVolatility.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/bootSimpleVolatility.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -9,7 +9,7 @@
\item{R}{xts object or matrix of asset returns}
\item{\dots}{passthrough parameters to
- \code{\link{SimpleVolatility}}}
+ \code{\link{simpleVolatility}}}
\item{replications}{number of bootstrap replications.}
@@ -29,4 +29,7 @@
\author{
Ross Bennett
}
+\seealso{
+ \code{\link{simpleVolatility}}
+}
Modified: pkg/GARPFRM/man/bootStdDev.Rd
===================================================================
--- pkg/GARPFRM/man/bootStdDev.Rd 2014-03-26 18:28:58 UTC (rev 136)
+++ pkg/GARPFRM/man/bootStdDev.Rd 2014-03-27 00:02:18 UTC (rev 137)
@@ -28,4 +28,7 @@
\author{
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/uwgarp -r 137
More information about the Uwgarp-commits
mailing list