From noreply at r-forge.r-project.org Sun May 3 23:41:48 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 3 May 2015 23:41:48 +0200 (CEST) Subject: [Returnanalytics-commits] r3642 - in pkg/PerformanceAnalytics: R man Message-ID: <20150503214148.E0B59186B39@r-forge.r-project.org> Author: rossbennett34 Date: 2015-05-03 23:41:48 +0200 (Sun, 03 May 2015) New Revision: 3642 Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R pkg/PerformanceAnalytics/man/Return.portfolio.Rd Log: Revise help file for Return.portfolio Revising help file for Return.portfolio to explain that rebalance_on is ignored if weights is an xts object that specifies the rebalancing dates. Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.portfolio.R 2015-04-26 05:56:44 UTC (rev 3641) +++ pkg/PerformanceAnalytics/R/Return.portfolio.R 2015-05-03 21:41:48 UTC (rev 3642) @@ -31,8 +31,13 @@ #' of the asset columns may be specified. In either case, if no rebalancing period is #' specified, the weights will be applied at the beginning of the asset time series #' and no further rebalancing will take place. If a rebalancing period is specified, -#' the portfolio will be rebalanced to the starting weights at the interval specified. +#' the portfolio will be rebalanced to the starting weights at the interval specified. #' +#' Note that if \code{weights} is an xts object, then any value passed to +#' \code{rebalance_on} is ignored. The \code{weights} object specifies the +#' rebalancing dates, therefore a regular rebalancing frequency provided via +#' \code{rebalance_on} is not needed and ignored. +#' #' \code{Return.portfolio} will work only on daily or lower frequencies. If you are #' rebalancing intraday, you should be using a trades/prices framework like #' the \code{blotter} package, not a weights/returns framework. @@ -102,7 +107,10 @@ #' contributed by the asset in a given period. Default FALSE #' @param geometric utilize geometric chaining (TRUE) or simple/arithmetic (FALSE) #' to aggregate returns. Default TRUE. -#' @param rebalance_on Default "none"; alternatively "daily" "weekly" "monthly" "annual" to specify calendar-period rebalancing supported by \code{\link[xts]{endpoints}}. +#' @param rebalance_on Default "none"; alternatively "daily" "weekly" "monthly" +#' "annual" to specify calendar-period rebalancing supported by +#' \code{\link[xts]{endpoints}}. Ignored if \code{weights} is an xts object +#' that specifies the rebalancing dates. #' @param value The beginning of period total portfolio value. This is used for calculating position value. #' @param verbose If verbose is TRUE, return a list of intermediary calculations. #' See Details below. Modified: pkg/PerformanceAnalytics/man/Return.portfolio.Rd =================================================================== --- pkg/PerformanceAnalytics/man/Return.portfolio.Rd 2015-04-26 05:56:44 UTC (rev 3641) +++ pkg/PerformanceAnalytics/man/Return.portfolio.Rd 2015-05-03 21:41:48 UTC (rev 3642) @@ -25,7 +25,10 @@ \item{geometric}{utilize geometric chaining (TRUE) or simple/arithmetic (FALSE) to aggregate returns. Default TRUE.} -\item{rebalance_on}{Default "none"; alternatively "daily" "weekly" "monthly" "annual" to specify calendar-period rebalancing supported by \code{\link[xts]{endpoints}}.} +\item{rebalance_on}{Default "none"; alternatively "daily" "weekly" "monthly" +"annual" to specify calendar-period rebalancing supported by +\code{\link[xts]{endpoints}}. Ignored if \code{weights} is an xts object +that specifies the rebalancing dates.} \item{value}{The beginning of period total portfolio value. This is used for calculating position value.} @@ -73,6 +76,11 @@ and no further rebalancing will take place. If a rebalancing period is specified, the portfolio will be rebalanced to the starting weights at the interval specified. +Note that if \code{weights} is an xts object, then any value passed to +\code{rebalance_on} is ignored. The \code{weights} object specifies the +rebalancing dates, therefore a regular rebalancing frequency provided via +\code{rebalance_on} is not needed and ignored. + \code{Return.portfolio} will work only on daily or lower frequencies. If you are rebalancing intraday, you should be using a trades/prices framework like the \code{blotter} package, not a weights/returns framework. From noreply at r-forge.r-project.org Mon May 4 12:05:21 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 4 May 2015 12:05:21 +0200 (CEST) Subject: [Returnanalytics-commits] r3643 - in pkg/PortfolioAnalytics: R man Message-ID: <20150504100521.D6DE818676F@r-forge.r-project.org> Author: rossbennett34 Date: 2015-05-04 12:05:21 +0200 (Mon, 04 May 2015) New Revision: 3643 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd Log: Improve default behavior and help file for optimize.portfolio.rebalancing - Improving documentation for optimize.portfolio.rebalancing to better explain the default behavior and how the optimization is done if training_period != rolling_window - Set training_period equal to rolling_window if training_period is null and rolling_window is specified Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2015-05-03 21:41:48 UTC (rev 3642) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2015-05-04 10:05:21 UTC (rev 3643) @@ -686,6 +686,7 @@ DEcformals <- formals(DEoptim::DEoptim.control) DEcargs <- names(DEcformals) + print(names(dotargs)) if( is.list(dotargs) ){ pm <- pmatch(names(dotargs), DEcargs, nomatch = 0L) names(dotargs[pm > 0L]) <- DEcargs[pm] @@ -732,7 +733,7 @@ } if(hasArg(traceDE)) traceDE=match.call(expand.dots=TRUE)$traceDE else traceDE=TRUE DEcformals$trace <- traceDE - + print(DEcformals) if(isTRUE(trace)) { #we can't pass trace=TRUE into constrained objective with DEoptim, because it expects a single numeric return tmptrace <- trace @@ -1402,8 +1403,42 @@ #' Run portfolio optimization with periodic rebalancing at specified time periods. #' Running the portfolio optimization with periodic rebalancing can help #' refine the constraints and objectives by evaluating the out of sample -#' performance of the portfolio based on historical data +#' performance of the portfolio based on historical data. #' +#' If both \code{training_period} and \code{rolling_window} are \code{NULL}, +#' then \code{training_period} is set to a default value of 36. +#' +#' If \code{training_period} is \code{NULL} and a \code{rolling_window} is +#' specified, then \code{training_period} is set to the value of +#' \code{rolling_window}. +#' +#' The user should be aware of the following behavior when both +#' \code{training_period} and \code{rolling_window} are specified and have +#' different values +#' \itemize{ +#' \item{\code{training_period < rolling_window}: }{For example, if you have +#' \code{rolling_window=60}, \code{training_period=50}, and the periodicity +#' of the data is the same as the rebalance frequency (i.e. monthly data with +#' \code{rebalance_on="months")} then the returns data used in the optimization +#' at each iteration are as follows: +#' \itemize{ +#' \item{1: R[1:50,]} +#' \item{2: R[1:51,]} +#' \item{...} +#' \item{11: R[1:60,]} +#' \item{12: R[1:61,]} +#' \item{13: R[2:62,]} +#' \item{...} +#' } +#' This results in a growing window for several optimizations initially while +#' the endpoint iterator (i.e. \code{[50, 51, ...]}) is less than the +#' rolling window width.} +#' \item{\code{training_period > rolling_window}: }{The data used in the initial +#' optimization is \code{R[(training_period - rolling_window):training_period,]}. +#' This results in some of the data being "thrown away", i.e. periods 1 to +#' \code{(training_period - rolling_window - 1)} are not used in the optimization.} +#' } +#' #' This function is a essentially a wrapper around \code{optimize.portfolio} #' and thus the discussion in the Details section of the #' \code{\link{optimize.portfolio}} help file is valid here as well. @@ -1577,6 +1612,10 @@ } else { rp = NULL } + # set training_period equal to rolling_window if training_period is null + # and rolling_window is not null + if(is.null(training_period) & !is.null(rolling_window)) + training_period <- rolling_window if(is.null(training_period)) {if(nrow(R)<36) training_period=nrow(R) else training_period=36} if (is.null(rolling_window)){ Modified: pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd 2015-05-03 21:41:48 UTC (rev 3642) +++ pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd 2015-05-04 10:05:21 UTC (rev 3643) @@ -1,4 +1,5 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/optimize.portfolio.R \name{optimize.portfolio.rebalancing} \alias{optimize.portfolio.rebalancing} \alias{optimize.portfolio.rebalancing_v1} @@ -17,13 +18,8 @@ \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns} -\item{portfolio}{an object of type "portfolio" specifying the constraints -and objectives for the optimization} - \item{constraints}{default NULL, a list of constraint objects} -\item{objectives}{default NULL, a list of objective objects} - \item{optimize_method}{one of "DEoptim", "random", "pso", "GenSA", or "ROI"} \item{search_size}{integer, how many portfolios to test, default 20,000} @@ -31,8 +27,6 @@ \item{trace}{TRUE/FALSE if TRUE will attempt to return additional information on the path or portfolios searched} -\item{\dots}{any other passthru parameters to \code{\link{optimize.portfolio}}} - \item{rp}{a set of random portfolios passed into the function to prevent recalculation} \item{rebalance_on}{character string of period to rebalance on. See @@ -44,6 +38,13 @@ \item{rolling_window}{an integer of the width (i.e. number of periods) of the rolling window, the default of NULL will run the optimization using the data from inception.} + +\item{portfolio}{an object of type "portfolio" specifying the constraints +and objectives for the optimization} + +\item{objectives}{default NULL, a list of objective objects} + +\item{\dots}{any other passthru parameters to \code{\link{optimize.portfolio}}} } \value{ a list containing the following elements @@ -65,8 +66,42 @@ Run portfolio optimization with periodic rebalancing at specified time periods. Running the portfolio optimization with periodic rebalancing can help refine the constraints and objectives by evaluating the out of sample -performance of the portfolio based on historical data +performance of the portfolio based on historical data. +If both \code{training_period} and \code{rolling_window} are \code{NULL}, +then \code{training_period} is set to a default value of 36. + +If \code{training_period} is \code{NULL} and a \code{rolling_window} is +specified, then \code{training_period} is set to the value of +\code{rolling_window}. + +The user should be aware of the following behavior when both +\code{training_period} and \code{rolling_window} are specified and have +different values +\itemize{ + \item{\code{training_period < rolling_window}: }{For example, if you have + \code{rolling_window=60}, \code{training_period=50}, and the periodicity + of the data is the same as the rebalance frequency (i.e. monthly data with + \code{rebalance_on="months")} then the returns data used in the optimization + at each iteration are as follows: + \itemize{ + \item{1: R[1:50,]} + \item{2: R[1:51,]} + \item{...} + \item{11: R[1:60,]} + \item{12: R[1:61,]} + \item{13: R[2:62,]} + \item{...} + } + This results in a growing window for several optimizations initially while + the endpoint iterator (i.e. \code{[50, 51, ...]}) is less than the + rolling window width.} + \item{\code{training_period > rolling_window}: }{The data used in the initial + optimization is \code{R[(training_period - rolling_window):training_period,]}. + This results in some of the data being "thrown away", i.e. periods 1 to + \code{(training_period - rolling_window - 1)} are not used in the optimization.} +} + This function is a essentially a wrapper around \code{optimize.portfolio} and thus the discussion in the Details section of the \code{\link{optimize.portfolio}} help file is valid here as well. From noreply at r-forge.r-project.org Mon May 4 12:18:53 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 4 May 2015 12:18:53 +0200 (CEST) Subject: [Returnanalytics-commits] r3644 - pkg/PortfolioAnalytics/R Message-ID: <20150504101853.875191874AD@r-forge.r-project.org> Author: rossbennett34 Date: 2015-05-04 12:18:53 +0200 (Mon, 04 May 2015) New Revision: 3644 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: removing print statements that made it into the last commit by mistake Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2015-05-04 10:05:21 UTC (rev 3643) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2015-05-04 10:18:53 UTC (rev 3644) @@ -686,7 +686,6 @@ DEcformals <- formals(DEoptim::DEoptim.control) DEcargs <- names(DEcformals) - print(names(dotargs)) if( is.list(dotargs) ){ pm <- pmatch(names(dotargs), DEcargs, nomatch = 0L) names(dotargs[pm > 0L]) <- DEcargs[pm] @@ -733,7 +732,6 @@ } if(hasArg(traceDE)) traceDE=match.call(expand.dots=TRUE)$traceDE else traceDE=TRUE DEcformals$trace <- traceDE - print(DEcformals) if(isTRUE(trace)) { #we can't pass trace=TRUE into constrained objective with DEoptim, because it expects a single numeric return tmptrace <- trace From noreply at r-forge.r-project.org Tue May 19 22:16:17 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 19 May 2015 22:16:17 +0200 (CEST) Subject: [Returnanalytics-commits] r3645 - in pkg/FactorAnalytics: . R inst/tests Message-ID: <20150519201617.A16BB187879@r-forge.r-project.org> Author: pragnya Date: 2015-05-19 22:16:17 +0200 (Tue, 19 May 2015) New Revision: 3645 Added: pkg/FactorAnalytics/R/zzz.R Removed: pkg/FactorAnalytics/R/Misc.R Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fitSfm.R pkg/FactorAnalytics/R/fitTsfm.R pkg/FactorAnalytics/R/fitTsfmLagBeta.r pkg/FactorAnalytics/R/fitTsfmMT.r pkg/FactorAnalytics/R/fitTsfmUpDn.r pkg/FactorAnalytics/R/fmEsDecomp.R pkg/FactorAnalytics/R/fmVaRDecomp.R pkg/FactorAnalytics/R/fmmc.R pkg/FactorAnalytics/R/paFm.r pkg/FactorAnalytics/R/plot.pafm.r pkg/FactorAnalytics/R/plot.sfm.r pkg/FactorAnalytics/R/plot.tsfm.r pkg/FactorAnalytics/R/predict.sfm.r pkg/FactorAnalytics/R/predict.tsfm.r pkg/FactorAnalytics/R/predict.tsfmUpDn.r pkg/FactorAnalytics/R/summary.sfm.r pkg/FactorAnalytics/R/summary.tsfm.r pkg/FactorAnalytics/R/summary.tsfmUpDn.r pkg/FactorAnalytics/inst/tests/test-fitTsfm.r Log: Edits to address R CMD check issues Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/DESCRIPTION 2015-05-19 20:16:17 UTC (rev 3645) @@ -1,8 +1,8 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version:2.0.19 -Date:2015-04-25 +Version:2.0.20 +Date:2015-05-19 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Description: An R package for the estimation and risk analysis of linear factor @@ -21,6 +21,7 @@ foreach (>= 1.4) Imports: PerformanceAnalytics(>= 1.4), + zoo, corrplot, robust, leaps, @@ -37,7 +38,7 @@ RCurl, bestglm Suggests: - testthat, quantmod, knitr + testthat LazyLoad: yes LazyDataCompression: xz -URL: http://r-forge.r-project.org/R/?group_id=579 +URL: http://r-forge.r-project.org/projects/returnanalytics/ Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/NAMESPACE 2015-05-19 20:16:17 UTC (rev 3645) @@ -48,6 +48,9 @@ export(paFm) export(qCornishFisher) export(rCornishFisher) +import(foreach) +import(xts) +import(zoo) importFrom(MASS,ginv) importFrom(PerformanceAnalytics,Return.cumulative) importFrom(PerformanceAnalytics,VaR) @@ -62,7 +65,6 @@ importFrom(boot,boot) importFrom(corrplot,corrplot.mixed) importFrom(doSNOW,registerDoSNOW) -importFrom(foreach,foreach) importFrom(lars,cv.lars) importFrom(lars,lars) importFrom(lattice,barchart) Deleted: pkg/FactorAnalytics/R/Misc.R =================================================================== --- pkg/FactorAnalytics/R/Misc.R 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/R/Misc.R 2015-05-19 20:16:17 UTC (rev 3645) @@ -1,18 +0,0 @@ -#' @title Miscellaneous Imported functions -#' -#' @details Only unique directives are saved to the ?NAMESPACE? file, so one -#' can repeat them as needed to maintain a close link between the functions -#' where they are needed and the namespace file. -#' -#' @importFrom PerformanceAnalytics checkData VaR chart.TimeSeries chart.ACFplus -#' chart.Histogram chart.QQPlot Return.cumulative chart.Correlation -#' @importFrom robust lmRob step.lmRob -#' @importFrom leaps regsubsets -#' @importFrom lars lars cv.lars -#' @importFrom lmtest coeftest.default -#' @importFrom sandwich vcovHC.default vcovHAC.default -#' @importFrom lattice barchart panel.barchart panel.grid -#' @importFrom corrplot corrplot.mixed -#' @importFrom strucchange efp -#' @importFrom MASS ginv -#' @importFrom sn dst st.mple \ No newline at end of file Modified: pkg/FactorAnalytics/R/fitSfm.R =================================================================== --- pkg/FactorAnalytics/R/fitSfm.R 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/R/fitSfm.R 2015-05-19 20:16:17 UTC (rev 3645) @@ -149,9 +149,6 @@ #' # APCA with the Connor-Korajczyk method #' fit.apca.ck <- fitSfm(r.W, k="ck") #' -#' @importFrom PerformanceAnalytics checkData -#' @importFrom MASS ginv -#' #' @export fitSfm <- function(data, k=1, max.k=NULL, refine=TRUE, sig=0.05, check=FALSE, Modified: pkg/FactorAnalytics/R/fitTsfm.R =================================================================== --- pkg/FactorAnalytics/R/fitTsfm.R 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/R/fitTsfm.R 2015-05-19 20:16:17 UTC (rev 3645) @@ -149,11 +149,6 @@ #' rf.name="US.3m.TR", data=managers, #' variable.selection="lars", lars.criterion="cv") #' -#' @importFrom PerformanceAnalytics checkData -#' @importFrom robust lmRob step.lmRob -#' @importFrom leaps regsubsets -#' @importFrom lars lars cv.lars -#' #' @export fitTsfm <- function(asset.names, factor.names, mkt.name=NULL, rf.name=NULL, Modified: pkg/FactorAnalytics/R/fitTsfmLagBeta.r =================================================================== --- pkg/FactorAnalytics/R/fitTsfmLagBeta.r 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/R/fitTsfmLagBeta.r 2015-05-19 20:16:17 UTC (rev 3645) @@ -73,11 +73,6 @@ #' mkt.name="SP500.TR",rf.name="US.3m.TR",data=managers) #' summary(fit) #' fitted(fit) -#' -#' @importFrom PerformanceAnalytics checkData -#' @importFrom robust lmRob step.lmRob -#' @importFrom leaps regsubsets -#' @importFrom lars lars cv.lars #' #' @export Modified: pkg/FactorAnalytics/R/fitTsfmMT.r =================================================================== --- pkg/FactorAnalytics/R/fitTsfmMT.r 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/R/fitTsfmMT.r 2015-05-19 20:16:17 UTC (rev 3645) @@ -78,8 +78,6 @@ #' fit <- fitTsfmMT(asset.names=colnames(managers[,(1:6)]), mkt.name="SP500.TR", #' rf.name="US.3m.TR", data=managers) #' summary(fit) -#' -#' @importFrom PerformanceAnalytics checkData #' #' @export Modified: pkg/FactorAnalytics/R/fitTsfmUpDn.r =================================================================== --- pkg/FactorAnalytics/R/fitTsfmUpDn.r 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/R/fitTsfmUpDn.r 2015-05-19 20:16:17 UTC (rev 3645) @@ -91,11 +91,6 @@ #' fitUpDn #' summary(fitUpDn$Up) #' summary(fitUpDn$Dn) -#' -#' @importFrom PerformanceAnalytics checkData -#' @importFrom robust lmRob step.lmRob -#' @importFrom leaps regsubsets -#' @importFrom lars lars cv.lars #' #' @export Modified: pkg/FactorAnalytics/R/fmEsDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmEsDecomp.R 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/R/fmEsDecomp.R 2015-05-19 20:16:17 UTC (rev 3645) @@ -82,8 +82,6 @@ #' ES.decomp <- fmEsDecomp(sfm.pca.fit) #' ES.decomp$cES #' -#' @importFrom PerformanceAnalytics VaR -#' #' @export fmEsDecomp <- function(object, ...){ Modified: pkg/FactorAnalytics/R/fmVaRDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmVaRDecomp.R 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/R/fmVaRDecomp.R 2015-05-19 20:16:17 UTC (rev 3645) @@ -79,8 +79,6 @@ #' VaR.decomp <- fmVaRDecomp(sfm.pca.fit) #' VaR.decomp$cVaR #' -#' @importFrom PerformanceAnalytics VaR -#' #' @export fmVaRDecomp <- function(object, ...){ Modified: pkg/FactorAnalytics/R/fmmc.R =================================================================== --- pkg/FactorAnalytics/R/fmmc.R 2015-05-04 10:18:53 UTC (rev 3644) +++ pkg/FactorAnalytics/R/fmmc.R 2015-05-19 20:16:17 UTC (rev 3645) @@ -1,393 +1,385 @@ -#' @title Functions to compute estimates and thier standard errors using fmmc -#' -#' Control default arguments. Usually for factorAnalytics. -#' -#' @details -#' This method takes in the additional arguments list and checks if parameters -#' are set. Then it defaults values if they are unset. Currently it controls the -#' fit.method(default: OLS) and variable.selection(default: subsets). If -#' variable.selection is set to values other than subsets/none then it will -#' default to subsets. -#' arguments for factorAnalytics -#' -#' @param ... Arguments that must be passed to fitTsfm -#' -#' -.fmmc.default.args <- function(...) { - add.args <- list(...) - if(!"fit.method" %in% names(add.args)) add.args[["fit.method"]] <- "LS" - - if(!"variable.selection" %in% names(add.args)) - add.args[["variable.selection"]] <- "subsets" - else { - if(!add.args[["variable.selection"]] %in% c("none", "subsets")) - add.args[["variable.selection"]] <- "subsets" - } - - if (add.args[["variable.selection"]] == "subsets") { - if(!"nvmax" %in% names(add.args)) - add.args[["nvmax"]] <- NA - } - - add.args -} - -#' Select factors based on BIC criteria -#' -#' @details -#' This method selects the best factors and based on the BIC criteria. It uses -#' the user supplied max count for max factors or defaults to half the total -#' number of factors -#' -#' @param data Data to use for selecting relevant factors. First column is the -#' response. The remaining columns is an exhaustive list of factors. -#' @param maxfactors An upper limit on the number of factors. -#' -#' -.fmmc.select.factors <- function(data, maxfactors) { - # default the max number of factors to half the number of factors - - maxfactors <- ifelse(is.na(maxfactors), floor((ncol(data) - 1)/2), - maxfactors) - if(maxfactors > 18) - warning("Max model size greater than 18. Consider reducing the size.") - - .data <- na.omit(cbind(data[,-1],data[,1])) - - fit <- c() - val <- tryCatch({ - fit <- bestglm(data.frame(na.omit(coredata(.data))), - IC="BIC",method="exhaustive", nvmax=maxfactors) - }, - error = function(e) NA, - warning = function(w) NA) - - if(inherits(val, "error")) { - warning(paste(colnames(data[1])," will be skipped. Model fitting failed")) - return(NA) - } - - fact.cols <- colnames(fit$BestModel$model)[-1] - fact.cols -} - - -#' This is the main implementation of the Factor Model Monte Carlo method. It returns -#' a fmmc object that contains the joint empirical density of factors and returns. This -#' fmmc object can be reused to for calucluting risk and performance estimates along -#' with standard errors for the estimates -#' -#' @details -#' This method takes in data, factors and residual type. It then does the following -#' 1. Fit a time series factor model to the data using user supplied selection and -#' fit variables or it defaults them to stepwise and OLS respectively. If any -#' of the betas are NA then the corresponding factors are dropped -#' 2. If the residual type beisdes empirical is specified then it fits the -#' corresponding distribution to the residuals and simulates from the fitted -#' distribution. The number of NA's in the simulated sample are the same as -#' original residuals. -#' 3. It then merges factors and non-NA residuals for each asset to create a full -#' outer join of the factors and residuals. We use this joined data to create new -#' simulated returns. Returns together with factors define a joint emperical density. -#' -#' @param R single vector of returns -#' @param factors matrix of factor returns -#' @param ... allows passing paramters to factorAnalytics. -#' @author Rohit Arora -#' -#' -.fmmc.proc <- function(R, factors ,... ) { - - # Check if the classes of Returns and factors are correct - if(is.null(nrow(R)) || is.null(nrow(factors))) { - warning("Inputs are not matrix") - return(NA) - } - - factors.data <- na.omit(factors) - T <- nrow(factors.data); T1 <- nrow(R) - if (T < T1) { - warning("Length of factors cannot be less than assets") - return(NA) - } - - # Start getting ready to fit a time-series factor model to the data. - .data <- as.matrix(merge(R,factors.data)) - - #default args if not set - add.args <- .fmmc.default.args(...) - fit.method <- add.args[["fit.method"]] - variable.selection <- add.args[["variable.selection"]] - - #short term hack till factorAnalytics fixes handling of "all subsets" - if(variable.selection == "subsets") { - - fact.cols <- .fmmc.select.factors(.data, add.args[["nvmax"]]) - if (0 == length(fact.cols)) { - warning(paste(colnames(R)," will be skipped. No suitable factor - exposures found")) - return(NA) - } - - factors.data <- factors.data[,fact.cols] - .data <- as.matrix(merge(R,factors.data)) - variable.selection <- add.args[["variable.selection"]] <- "none" - add.args[["nvmax"]] <- NULL - } - - # Lets fit the time-series model - args <- list(asset.names=colnames(R), - factor.names=colnames(factors.data), data=.data) - - args <- merge.list(args,add.args) - - # We do not need to remove NA's. Beta's do no change if NA's are not removed - possibleError <- tryCatch( - fit <- do.call(fitTsfm, args), - error=function(e) - e) - - if(inherits(possibleError, "error")) { - warning(paste("Timeseries model fitting failed for ", colnames(R))) - return(NA) - } - - resid <- do.call(merge,lapply(lapply(fit$asset.fit,residuals),as.xts)) - beta <- t(fit$beta) - - if(any(is.na(beta))) { - warning("some of the betas where NA in .fmmc.proc. Dropping those") - beta <- beta[!is.na(c(beta)), 1, drop=FALSE] - names.factors <- colnames(factors.data) - names.beta <- colnames(fit$beta) - factors.data <- as.matrix(factors.data[,names.factors %in% names.beta]) - } - - # define a joint empirical density for the factors and residuals and use - # that to calculate the returns. - .data <- as.matrix(merge(as.matrix(factors.data), resid)) - alpha <- matrix(as.numeric(fit$alpha), nrow=nrow(.data), ncol=1, byrow=TRUE) - - returns <- alpha + .data[,-ncol(.data),drop=FALSE] %*% beta + - .data[,ncol(.data),drop=FALSE] - - result <- list(bootdist = list(returns = returns, - factors = .data[,-ncol(.data),drop=FALSE]), - data = list(R = R, factors = factors.data), args = add.args) - result -} - -#' Statistic function for the boot call. It calculates the risk or performnace -#' meeasure by using the estimatation function in its argument list. -#' -#' @details -#' This method works as follows. -#' 1. Get data with factors and returns. -#' 2. Subset T rows from the data. -#' 3. Discard first TR-TR1 of the asset returns by setting them to NA -#' 4. calls .fmmc.proc method over the new data set to get a new joint empirical -#' distribution of returns and factors -#' 5. We use the new returns with the estimation function to calculate the -#' risk or performance measure. -#' -#' @param data matrix of (all factors + returns of just 1 asset) -#' @param indices row numbers generated by boot -#' @param args additinal paramters needed for subsetting the data and calulating -#' the perfomance/risk measure. -#' @author Rohit Arora -#' -#' -.fmmc.boot <- function(data, indices, args) { - - TR <- args$TR - TR1 <- args$TR1 - estimate.func <- args$estimate.func - fit.method <- args$fit.method - var.sel <- args$var.sel - - fun <- match.fun(estimate.func) - - # we just need TR rows of data - ind <- sample(indices, TR , replace = TRUE) - data <- data[ind,] - - # discard the first (TR-TR1) portion of returns if using fmmc. For - # complete data TR = TR1 - .data <- data - .data[1:(TR-TR1),ncol(.data)] <- NA - - # If the data does not have dates then it cannot be transformed to xts. - # So lets fake dates to make xts happy - .data <- as.xts(.data , order.by=seq(as.Date("1980/1/1"), by = "day", - length.out = nrow(.data))) - - # lets get a new empirical distribution of factors and returns for a new subset - fmmcObj <- .fmmc.proc(R=.data[,ncol(.data),drop=FALSE], - factors=.data[,-ncol(.data)], - fit.method = fit.method, variable.selection = var.sel) - - # lets calculate the performance or risk estimate - measure <- fun(fmmcObj$bootdist$returns) - measure -} - -#' Main function to calculate the risk/performance estimate and calculate the -#' standard error of the estimate using bootstrapping. -#' -#' @details -#' bootstrapping in our case can be painfully slow, so we exploit the parallel -#' capabilities of boot function. All cores on your machine are used. -#' We use the boot call from the boot library for calculating the estimate and -#' its standard error. -#' -#' @param fmmcObj object returned by fmmc proc. This is a comprehensive object -#' with all data for factors and returns. -#' @param nboot number of bootstap samples. Not sure how many repetations are -#' reuired but remember bias-variance tradeoff. Increasing nboot will only -#' reduce variance and not have a significant effect on bias(estimate) -#' @param estimate.func this is a handle to the function used for calulating -#' the perfomance/risk measure. -#' @param cl A cluster for running across multiple cores -#' @author Rohit Arora -#' -#' -.fmmc.se <- function(fmmcObj, nboot = 50, estimate.func, cl = NULL) { - - parallel <- if(is.null(cl)) "no" else "snow" - ncpus <- if(is.null(cl)) 1 else detectCores() - - # length of factors - TR <- nrow(fmmcObj$data$factors) - - # length of the asset returns - len <- nrow(fmmcObj$data$R) - - apply(fmmcObj$data$R, 2, function(col) which.min(is.na(col))) + 1 - - returns <- fmmcObj$bootdist$returns - factors <- fmmcObj$bootdist$factors - - # no need to do variable selection again. So lets turn it off - args <- list(TR = TR, TR1 = len, estimate.func = estimate.func, - fit.method = fmmcObj$args[["fit.method"]], var.sel = "none") - - result <- boot(data=cbind(factors, returns), statistic = .fmmc.boot, - R = nboot, parallel = parallel, ncpus = ncpus, cl = cl, args=args) - - se <- apply(result$t,2,sd) - se -} - -#' Worker function that acts between the fmmc procedure and calling method. -#' -#' @details -#' This method takes in data as single time series and factors as xts objects -#' It then calls the actual estimation procedure. -#' -#' @param R single vector of returns -#' @param factors matrix of factor returns -#' @param ... allows passing paramters to factorAnalytics. -#' @author Rohit Arora -#' -#' -#' -.fmmc.worker <- function(R, factors, ...) { - fmmc.obj <- .fmmc.proc(R=R, factors=factors, ...) - fmmc.obj -} - -#' Compute fmmc objects that can be used for calcuation of estimates and their -#' standard errors -#' -#' @details -#' This method takes in data and factors as xts objects where multiple -#' time series with different starting dates are merged together. It then -#' computes FMMC objects as described in Jiang and Martin (2013) -#' -#' @param R matrix of returns in xts format -#' @param factors matrix of factor returns in xts format -#' @param parallel flag to utilize multiplecores on the cpu. All cores are used. -#' @param ... Arguments that must be passed to fitTsfm -#' -#' @importFrom parallel makeCluster detectCores clusterEvalQ clusterExport -#' stopCluster -#' @importFrom boot boot -#' @importFrom foreach foreach -#' @importFrom doSNOW registerDoSNOW -#' @importFrom RCurl merge.list -#' @importFrom bestglm bestglm -#' -#' @return returns an list of fmmc objects -#' -#' @references -#' Yindeng Jiang and Richard Doug Martin. Better Risk and Performance -#' Estimates with Factor Model Monte Carlo. SSRN Electronic Journal, July 2013. -#' -#' @author Rohit Arora -#' @export -#' -#' -fmmc <- function(R, factors, parallel=FALSE, ...) { - - ret <- NA - assets.count <- ncol(R) - - if (parallel) { - cl <- makeCluster(detectCores()) - registerDoSNOW(cl) - ret <- foreach (i = 1:assets.count) %dopar% .fmmc.worker(R[,i], factors, ...) - stopCluster(cl) - } else - ret <- foreach (i = 1:assets.count) %do% .fmmc.worker(R[,i], factors, ...) - - result <- ret[lapply(ret,length) > 1] - result -} - -#' Main function to calculate the standard errror of the estimate -#' -#' @details -#' This method takes in a list of fmmc objects and a callback function to compute -#' an estimate. The first argument of the callback function must be the data -#' bootstrapped using fmmc procedure. The remaining arguments can be suitably -#' bound to the parameters as needed. This function can also be used to calculate -#' the standard error using the se flag. -#' -#' @param fmmcObjs A list of fmmc objects computed using .fmmc.proc and containing -#' bootstrapped returns -#' @param fun A callback function where the first argument is returns and all the -#' other arguments are bounded to values -#' @param se A flag to indicate if standard error for the estimate must be calculated -#' @param parallel A flag to indicate if multiple cpu cores must be used -#' @param nboot Number of bootstrap samples -#' -#' @return returns the estimates and thier standard errors given fmmc objects -#' -#' @author Rohit Arora -#' @export -#' -fmmc.estimate.se <- function(fmmcObjs, fun=NULL, se=FALSE, nboot=100, - parallel = FALSE) { - - result <- as.matrix(rep(NA, length(fmmcObjs))); colnames(result) <- "estimate" - rownames(result) <- unlist(lapply(fmmcObjs, function(obj) colnames(obj$data$R))) - - if(is.null(fun)) return(result) - - cl <- NULL - if(parallel) { - cl <- makeCluster(detectCores()) - clusterEvalQ(cl, library(xts)) - } - - result[,1] <- unlist(lapply(fmmcObjs, function(obj) fun(obj$bootdist$returns))) - if(se) { - serr <- unlist( - lapply(fmmcObjs, function(obj) .fmmc.se(obj, nboot, fun, cl))) - result <- cbind(result, serr) - colnames(result) <- c("estimate", "se") - } - - if(parallel) stopCluster(cl) - - result +#' @title Functions to compute estimates and thier standard errors using fmmc +#' +#' Control default arguments. Usually for factorAnalytics. +#' +#' @details +#' This method takes in the additional arguments list and checks if parameters +#' are set. Then it defaults values if they are unset. Currently it controls the +#' fit.method(default: OLS) and variable.selection(default: subsets). If +#' variable.selection is set to values other than subsets/none then it will +#' default to subsets. +#' arguments for factorAnalytics +#' +#' @param ... Arguments that must be passed to fitTsfm +#' +#' +.fmmc.default.args <- function(...) { + add.args <- list(...) + if(!"fit.method" %in% names(add.args)) add.args[["fit.method"]] <- "LS" + + if(!"variable.selection" %in% names(add.args)) + add.args[["variable.selection"]] <- "subsets" + else { + if(!add.args[["variable.selection"]] %in% c("none", "subsets")) + add.args[["variable.selection"]] <- "subsets" + } + + if (add.args[["variable.selection"]] == "subsets") { + if(!"nvmax" %in% names(add.args)) + add.args[["nvmax"]] <- NA + } + + add.args +} + +#' Select factors based on BIC criteria +#' +#' @details +#' This method selects the best factors and based on the BIC criteria. It uses +#' the user supplied max count for max factors or defaults to half the total +#' number of factors +#' +#' @param data Data to use for selecting relevant factors. First column is the +#' response. The remaining columns is an exhaustive list of factors. +#' @param maxfactors An upper limit on the number of factors. +#' +#' +.fmmc.select.factors <- function(data, maxfactors) { + # default the max number of factors to half the number of factors + + maxfactors <- ifelse(is.na(maxfactors), floor((ncol(data) - 1)/2), + maxfactors) + if(maxfactors > 18) + warning("Max model size greater than 18. Consider reducing the size.") + + .data <- na.omit(cbind(data[,-1],data[,1])) + + fit <- c() + val <- tryCatch({ + fit <- bestglm(data.frame(na.omit(coredata(.data))), + IC="BIC",method="exhaustive", nvmax=maxfactors) + }, + error = function(e) NA, + warning = function(w) NA) + + if(inherits(val, "error")) { + warning(paste(colnames(data[1])," will be skipped. Model fitting failed")) + return(NA) + } + + fact.cols <- colnames(fit$BestModel$model)[-1] + fact.cols +} + + +#' This is the main implementation of the Factor Model Monte Carlo method. It returns +#' a fmmc object that contains the joint empirical density of factors and returns. This +#' fmmc object can be reused to for calucluting risk and performance estimates along +#' with standard errors for the estimates +#' +#' @details +#' This method takes in data, factors and residual type. It then does the following +#' 1. Fit a time series factor model to the data using user supplied selection and +#' fit variables or it defaults them to stepwise and OLS respectively. If any +#' of the betas are NA then the corresponding factors are dropped +#' 2. If the residual type beisdes empirical is specified then it fits the +#' corresponding distribution to the residuals and simulates from the fitted +#' distribution. The number of NA's in the simulated sample are the same as +#' original residuals. +#' 3. It then merges factors and non-NA residuals for each asset to create a full +#' outer join of the factors and residuals. We use this joined data to create new +#' simulated returns. Returns together with factors define a joint emperical density. +#' +#' @param R single vector of returns +#' @param factors matrix of factor returns +#' @param ... allows passing paramters to factorAnalytics. +#' @author Rohit Arora +#' +#' +.fmmc.proc <- function(R, factors ,... ) { + + # Check if the classes of Returns and factors are correct + if(is.null(nrow(R)) || is.null(nrow(factors))) { + warning("Inputs are not matrix") + return(NA) + } + + factors.data <- na.omit(factors) + T <- nrow(factors.data); T1 <- nrow(R) + if (T < T1) { + warning("Length of factors cannot be less than assets") + return(NA) + } + + # Start getting ready to fit a time-series factor model to the data. + .data <- as.matrix(merge(R,factors.data)) + + #default args if not set + add.args <- .fmmc.default.args(...) + fit.method <- add.args[["fit.method"]] + variable.selection <- add.args[["variable.selection"]] + + #short term hack till factorAnalytics fixes handling of "all subsets" + if(variable.selection == "subsets") { + + fact.cols <- .fmmc.select.factors(.data, add.args[["nvmax"]]) + if (0 == length(fact.cols)) { + warning(paste(colnames(R)," will be skipped. No suitable factor + exposures found")) + return(NA) + } + + factors.data <- factors.data[,fact.cols] + .data <- as.matrix(merge(R,factors.data)) + variable.selection <- add.args[["variable.selection"]] <- "none" + add.args[["nvmax"]] <- NULL + } + + # Lets fit the time-series model + args <- list(asset.names=colnames(R), + factor.names=colnames(factors.data), data=.data) + + args <- merge.list(args,add.args) + + # We do not need to remove NA's. Beta's do no change if NA's are not removed + possibleError <- tryCatch( + fit <- do.call(fitTsfm, args), + error=function(e) + e) + + if(inherits(possibleError, "error")) { + warning(paste("Timeseries model fitting failed for ", colnames(R))) + return(NA) + } + + resid <- do.call(merge,lapply(lapply(fit$asset.fit,residuals),as.xts)) + beta <- t(fit$beta) + + if(any(is.na(beta))) { + warning("some of the betas where NA in .fmmc.proc. Dropping those") + beta <- beta[!is.na(c(beta)), 1, drop=FALSE] + names.factors <- colnames(factors.data) + names.beta <- colnames(fit$beta) + factors.data <- as.matrix(factors.data[,names.factors %in% names.beta]) + } + + # define a joint empirical density for the factors and residuals and use + # that to calculate the returns. + .data <- as.matrix(merge(as.matrix(factors.data), resid)) + alpha <- matrix(as.numeric(fit$alpha), nrow=nrow(.data), ncol=1, byrow=TRUE) + + returns <- alpha + .data[,-ncol(.data),drop=FALSE] %*% beta + + .data[,ncol(.data),drop=FALSE] + + result <- list(bootdist = list(returns = returns, + factors = .data[,-ncol(.data),drop=FALSE]), + data = list(R = R, factors = factors.data), args = add.args) + result +} + +#' Statistic function for the boot call. It calculates the risk or performnace +#' meeasure by using the estimatation function in its argument list. +#' +#' @details +#' This method works as follows. +#' 1. Get data with factors and returns. +#' 2. Subset T rows from the data. +#' 3. Discard first TR-TR1 of the asset returns by setting them to NA +#' 4. calls .fmmc.proc method over the new data set to get a new joint empirical +#' distribution of returns and factors +#' 5. We use the new returns with the estimation function to calculate the +#' risk or performance measure. +#' +#' @param data matrix of (all factors + returns of just 1 asset) +#' @param indices row numbers generated by boot +#' @param args additinal paramters needed for subsetting the data and calulating +#' the perfomance/risk measure. +#' @author Rohit Arora +#' +#' +.fmmc.boot <- function(data, indices, args) { + + TR <- args$TR + TR1 <- args$TR1 + estimate.func <- args$estimate.func + fit.method <- args$fit.method + var.sel <- args$var.sel + + fun <- match.fun(estimate.func) + + # we just need TR rows of data + ind <- sample(indices, TR , replace = TRUE) + data <- data[ind,] + + # discard the first (TR-TR1) portion of returns if using fmmc. For + # complete data TR = TR1 + .data <- data + .data[1:(TR-TR1),ncol(.data)] <- NA + + # If the data does not have dates then it cannot be transformed to xts. + # So lets fake dates to make xts happy + .data <- as.xts(.data , order.by=seq(as.Date("1980/1/1"), by = "day", + length.out = nrow(.data))) + + # lets get a new empirical distribution of factors and returns for a new subset + fmmcObj <- .fmmc.proc(R=.data[,ncol(.data),drop=FALSE], + factors=.data[,-ncol(.data)], + fit.method = fit.method, variable.selection = var.sel) + + # lets calculate the performance or risk estimate + measure <- fun(fmmcObj$bootdist$returns) + measure +} + +#' Main function to calculate the risk/performance estimate and calculate the +#' standard error of the estimate using bootstrapping. +#' +#' @details +#' bootstrapping in our case can be painfully slow, so we exploit the parallel +#' capabilities of boot function. All cores on your machine are used. +#' We use the boot call from the boot library for calculating the estimate and +#' its standard error. +#' +#' @param fmmcObj object returned by fmmc proc. This is a comprehensive object +#' with all data for factors and returns. +#' @param nboot number of bootstap samples. Not sure how many repetations are +#' reuired but remember bias-variance tradeoff. Increasing nboot will only +#' reduce variance and not have a significant effect on bias(estimate) +#' @param estimate.func this is a handle to the function used for calulating +#' the perfomance/risk measure. +#' @param cl A cluster for running across multiple cores +#' @author Rohit Arora +#' +#' +.fmmc.se <- function(fmmcObj, nboot = 50, estimate.func, cl = NULL) { + + parallel <- if(is.null(cl)) "no" else "snow" + ncpus <- if(is.null(cl)) 1 else detectCores() + + # length of factors + TR <- nrow(fmmcObj$data$factors) + + # length of the asset returns + len <- nrow(fmmcObj$data$R) - + apply(fmmcObj$data$R, 2, function(col) which.min(is.na(col))) + 1 + + returns <- fmmcObj$bootdist$returns + factors <- fmmcObj$bootdist$factors + + # no need to do variable selection again. So lets turn it off + args <- list(TR = TR, TR1 = len, estimate.func = estimate.func, + fit.method = fmmcObj$args[["fit.method"]], var.sel = "none") + + result <- boot(data=cbind(factors, returns), statistic = .fmmc.boot, + R = nboot, parallel = parallel, ncpus = ncpus, cl = cl, args=args) + + se <- apply(result$t,2,sd) + se +} + +#' Worker function that acts between the fmmc procedure and calling method. +#' +#' @details +#' This method takes in data as single time series and factors as xts objects +#' It then calls the actual estimation procedure. +#' +#' @param R single vector of returns +#' @param factors matrix of factor returns +#' @param ... allows passing paramters to factorAnalytics. +#' @author Rohit Arora +#' +#' +#' +.fmmc.worker <- function(R, factors, ...) { + fmmc.obj <- .fmmc.proc(R=R, factors=factors, ...) + fmmc.obj +} + +#' Compute fmmc objects that can be used for calcuation of estimates and their +#' standard errors +#' +#' @details +#' This method takes in data and factors as xts objects where multiple +#' time series with different starting dates are merged together. It then +#' computes FMMC objects as described in Jiang and Martin (2013) +#' +#' @param R matrix of returns in xts format +#' @param factors matrix of factor returns in xts format +#' @param parallel flag to utilize multiplecores on the cpu. All cores are used. +#' @param ... Arguments that must be passed to fitTsfm +#' +#' @return returns an list of fmmc objects +#' +#' @references [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3645 From noreply at r-forge.r-project.org Fri May 22 03:54:36 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 22 May 2015 03:54:36 +0200 (CEST) Subject: [Returnanalytics-commits] r3646 - pkg/PApages/R Message-ID: <20150522015436.8A5931875AE@r-forge.r-project.org> Author: peter_carl Date: 2015-05-22 03:54:35 +0200 (Fri, 22 May 2015) New Revision: 3646 Added: pkg/PApages/R/xlsx.CAPM.R pkg/PApages/R/xlsx.Calendar.R pkg/PApages/R/xlsx.RiskStats.R pkg/PApages/R/xlsx.tables.R Log: - this is probably where these should be Added: pkg/PApages/R/xlsx.CAPM.R =================================================================== --- pkg/PApages/R/xlsx.CAPM.R (rev 0) +++ pkg/PApages/R/xlsx.CAPM.R 2015-05-22 01:54:35 UTC (rev 3646) @@ -0,0 +1,60 @@ +# Add the formatted output of table.CAPM to an Excel workbook + +xlsx.CAPM <- function(Ra, Rb, p=(1-(1/12)), Rf=.03/12, wb, sheetname="SFM", title="Regression Statistics", subtitle="Since inception") { + # Peter Carl + require(xlsx) + + # Calculate the table + # @TODO: Do this from manager inception instead + # @TODO: Get rid of leading 'X' in column names + x.capm = t(table.CAPM(R, as.perc=FALSE, digits=4)) + x.dim = dim(x.capm) + + ## Set style attributes for the spreadsheet + # Create a named cell style to be used for columns of ratios or percentages + csSheetTitle <- CellStyle(wb) + Font(wb, heightInPoints=14, isBold=TRUE) + csSheetSubTitle <- CellStyle(wb) + Font(wb, heightInPoints=12, isItalic=TRUE, isBold=FALSE) + csTableRowNames <- CellStyle(wb) + Font(wb, isBold=TRUE) + csTableColNames <- CellStyle(wb) + Font(wb, isBold=TRUE) + Alignment(wrapText=TRUE, h="ALIGN_CENTER") + Border(color="black", position=c("TOP", "BOTTOM"), pen=c("BORDER_THIN", "BORDER_THICK")) + csRatioColumn <- CellStyle(wb, dataFormat=DataFormat("0.0")) # ... for ratio results + csPercColumn <- CellStyle(wb, dataFormat=DataFormat("0.0%")) # ... for percentage results + + CAPM.colRatio = list( + '3'=csRatioColumn, + '5'=csRatioColumn, + '8'=csRatioColumn, + '15'=csRatioColumn) + CAPM.colPerc =list( + '1'=csPercColumn, + '2'=csPercColumn, + '4'=csPercColumn, + '6'=csPercColumn, + '7'=csPercColumn, + '9'=csPercColumn, + '10'=csPercColumn, + '13'=csPercColumn, + '14'=csPercColumn) + + # Create a sheet in the workbook, add the table, and format it + sheet <- createSheet(wb, sheetName = sheetname) + addDataFrame(x.RiskStats, sheet, startRow=3, startColumn=1, + colStyle=c(CAPM.colPerc,CAPM.colRatio), + colnamesStyle = csTableColNames, rownamesStyle=csTableRowNames) + + setColumnWidth(sheet,colIndex=c(2:x.dim[1]),colWidth=8) + setColumnWidth(sheet,colIndex=1,colWidth=max(nchar(rownames(x.calendar)))) + + # Create the Sheet title ... + rows <- createRow(sheet,rowIndex=1) + sheetTitle <- createCell(rows, colIndex=1) + setCellValue(sheetTitle[[1,1]], title) + setCellStyle(sheetTitle[[1,1]], csSheetTitle) + # ... and subtitle + rows <- createRow(sheet,rowIndex=2) + sheetSubTitle <- createCell(rows,colIndex=1) + setCellValue(sheetSubTitle[[1,1]], subtitle) + setCellStyle(sheetSubTitle[[1,1]], csSheetSubTitle) + + # Return the whole (now modified) workbook object + return(wb) +} \ No newline at end of file Added: pkg/PApages/R/xlsx.Calendar.R =================================================================== --- pkg/PApages/R/xlsx.Calendar.R (rev 0) +++ pkg/PApages/R/xlsx.Calendar.R 2015-05-22 01:54:35 UTC (rev 3646) @@ -0,0 +1,45 @@ +# Add the formatted output of table.CalendarReturns to an Excel workbook + +xlsx.Calendar <- function(R, p=(1-(1/12)), Rf=.03/12, wb, sheetname="Risk Stats", title="Risk Statistics", subtitle="Since inception") { + # Peter Carl + require(xlsx) + + # Calculate the table + # @TODO: Do this from manager inception instead + # @TODO: Get rid of leading 'X' in column names + x.calendar = t(table.CalendarReturns(R, as.perc=FALSE, digits=4)) + x.dim = dim(x.calendar) + + ## Set style attributes for the spreadsheet + # Create a named cell style to be used for columns of ratios or percentages + csSheetTitle <- CellStyle(wb) + Font(wb, heightInPoints=14, isBold=TRUE) + csSheetSubTitle <- CellStyle(wb) + Font(wb, heightInPoints=12, isItalic=TRUE, isBold=FALSE) + csTableRowNames <- CellStyle(wb) + Font(wb, isBold=TRUE) + csTableColNames <- CellStyle(wb) + Font(wb, isBold=TRUE) + Alignment(wrapText=TRUE, h="ALIGN_CENTER") + Border(color="black", position=c("TOP", "BOTTOM"), pen=c("BORDER_THIN", "BORDER_THICK")) + csPercColumn <- CellStyle(wb, dataFormat=DataFormat("0.0%")) # ... for percentage results + + # Create a sheet in the workbook, add the table, and format it + # @TODO: Fix table cell formatting + sheet <- createSheet(wb, sheetName = sheetname) + addDataFrame(x.calendar, sheet, startRow=3, startColumn=1, + colStyle=list(csPercColumn), + colnamesStyle = csTableColNames, + rownamesStyle=csTableRowNames) + + setColumnWidth(sheet,colIndex=c(2:x.dim[1]),colWidth=8) + setColumnWidth(sheet,colIndex=1,colWidth=max(nchar(rownames(x.calendar)))) + + # Create the Sheet title ... + rows <- createRow(sheet,rowIndex=1) + sheetTitle <- createCell(rows, colIndex=1) + setCellValue(sheetTitle[[1,1]], title) + setCellStyle(sheetTitle[[1,1]], csSheetTitle) + # ... and subtitle + rows <- createRow(sheet,rowIndex=2) + sheetSubTitle <- createCell(rows,colIndex=1) + setCellValue(sheetSubTitle[[1,1]], subtitle) + setCellStyle(sheetSubTitle[[1,1]], csSheetSubTitle) + + # Return the whole (now modified) workbook object + return(wb) +} \ No newline at end of file Added: pkg/PApages/R/xlsx.RiskStats.R =================================================================== --- pkg/PApages/R/xlsx.RiskStats.R (rev 0) +++ pkg/PApages/R/xlsx.RiskStats.R 2015-05-22 01:54:35 UTC (rev 3646) @@ -0,0 +1,65 @@ +# Add the formatted output of table.RiskStats to an Excel workbook +# +# wb = xlsx.RiskStats.R(R=last(x.R,60), wb=wb) + +# @TODO: Wrap each table in a similar function: Calendar, etc. + +xlsx.RiskStats <- function(R, p=(1-(1/12)), Rf=.03/12, wb, sheetname="Risk Stats", title="Risk Statistics", subtitle="Since inception") { + # Peter Carl + require(xlsx) + + # Calculate the table + x.RiskStats = as.data.frame(t(table.RiskStats(R=R, p=p, Rf=Rf))) + + ## Set style attributes for the spreadsheet + # Create a named cell style to be used for columns of ratios or percentages + csSheetTitle <- CellStyle(wb) + Font(wb, heightInPoints=14, isBold=TRUE) + csSheetSubTitle <- CellStyle(wb) + Font(wb, heightInPoints=12, isItalic=TRUE, isBold=FALSE) + csTableRowNames <- CellStyle(wb) + Font(wb, isBold=TRUE) + csTableColNames <- CellStyle(wb) + Font(wb, isBold=TRUE) + Alignment(wrapText=TRUE, h="ALIGN_CENTER") + Border(color="black", position=c("TOP", "BOTTOM"), pen=c("BORDER_THIN", "BORDER_THICK")) + csRatioColumn <- CellStyle(wb, dataFormat=DataFormat("0.0")) # ... for ratio results + csPercColumn <- CellStyle(wb, dataFormat=DataFormat("0.0%")) # ... for percentage results + + # Which columns in the table should be formatted which way? + RiskStats.colRatio = list( + '3'=csRatioColumn, + '5'=csRatioColumn, + '8'=csRatioColumn, + '15'=csRatioColumn) + RiskStats.colPerc =list( + '1'=csPercColumn, + '2'=csPercColumn, + '4'=csPercColumn, + '6'=csPercColumn, + '7'=csPercColumn, + '9'=csPercColumn, + '10'=csPercColumn, + '13'=csPercColumn, + '14'=csPercColumn) + + # Create a sheet in the workbook, add the table, and format it +# wb = set.xlsxWBStyles(wb) # Establish formats in the wb in case it hasn't happened before + sheet <- createSheet(wb, sheetName = sheetname) + addDataFrame(x.RiskStats, sheet, startRow=3, startColumn=1, + colStyle=c(RiskStats.colPerc,RiskStats.colRatio), + colnamesStyle = csTableColNames, rownamesStyle=csTableRowNames) + setColumnWidth(sheet,colIndex=c(2:15),colWidth=11) + setColumnWidth(sheet,colIndex=16,colWidth=13) + setColumnWidth(sheet,colIndex=17,colWidth=6) + setColumnWidth(sheet,colIndex=1,colWidth=max(nchar(rownames(x.RiskStats)))) + + # Create the Sheet title ... + rows <- createRow(sheet,rowIndex=1) + sheetTitle <- createCell(rows, colIndex=1) + setCellValue(sheetTitle[[1,1]], title) + setCellStyle(sheetTitle[[1,1]], csSheetTitle) + # ... and subtitle + rows <- createRow(sheet,rowIndex=2) + sheetSubTitle <- createCell(rows,colIndex=1) + setCellValue(sheetSubTitle[[1,1]], subtitle) + setCellStyle(sheetSubTitle[[1,1]], csSheetSubTitle) + + # Return the whole (now modified) workbook object + return(wb) +} + Added: pkg/PApages/R/xlsx.tables.R =================================================================== --- pkg/PApages/R/xlsx.tables.R (rev 0) +++ pkg/PApages/R/xlsx.tables.R 2015-05-22 01:54:35 UTC (rev 3646) @@ -0,0 +1,57 @@ +xlsx.Performance <- function (R, title, outputdir, timestamp) { + # Create a spreadsheet with performance and risk metrics + try(rm(wb)) # delete old or outdated objects in the workspace + + # @TODO: code after this could be functionalized as xlsx.Performance() + + # Create an Excel workbook using xlsx + wb <- createWorkbook() # Create a workbook object + + # Get attributes of the data used + x.lastDate = tail(index(x.R), n=1) + + ## Calculate Ex Post Risk and Returns Statistics table + # Create a sheet for Since Inception + sheetname = paste(manager," Stats", sep="") + title = paste(manager, "Ex-Post Returns and Risk") + subtitle = paste("Since inception, updated through ", x.lastDate, sep="") + wb = xlsx.RiskStats(R=x.R, wb=wb, sheetname=sheetname, title=title, subtitle=subtitle) + + # Trailing n-month view of the same table + periods = c(60,36,24,12) + for(period in periods){ + sheetname=paste(manager," Stats ", period,"m", sep="") + title = paste(manager, "Ex-Post Returns and Risk") + subtitle = paste("Trailing ", period, "-month period through ", x.lastDate, sep="") + wb = xlsx.RiskStats(R=last(x.R, period), wb=wb, sheetname=sheetname, title=title, subtitle=subtitle) + } + + ## Calculate Calendar Returns table + sheetname = paste(manager," Returns", sep="") + title = paste(manager, "Calendar Returns") + subtitle = paste("Since inception, updated through ", x.lastDate, sep="") + wb = xlsx.Calendar(R=x.R, wb=wb, sheetname=sheetname, title=title, subtitle=subtitle) + + ## Drawdowns table + + ## SFM table + # Create a sheet for Since Inception + sheetname = paste(manager," SFM", sep="") + title = paste(manager, "SFM Regression") + subtitle = paste("Since inception, updated through ", x.lastDate, sep="") + wb = xlsx.CAPM.R(R=x.R, wb=wb, sheetname=sheetname, title=title, subtitle=subtitle) + + # Trailing n-month view of the same table + periods = c(60,36,12) + for(period in periods){ + sheetname=paste(manager," SFM ", period,"m", sep="") + title = paste(manager, "SFM Regression") + subtitle = paste("Trailing ", period, "-month period through ", x.lastDate, sep="") + wb = xlsx.CAPM(R=last(x.R, period), wb=wb, sheetname=sheetname, title=title, subtitle=subtitle) + } + + ## AC table + + ## + saveWorkbook(wb, file=paste(outputdir,"/",manager," Performance ",timestamp,".xlsx", sep="")) +} \ No newline at end of file From noreply at r-forge.r-project.org Fri May 22 22:47:26 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 22 May 2015 22:47:26 +0200 (CEST) Subject: [Returnanalytics-commits] r3647 - pkg/FactorAnalytics/R Message-ID: <20150522204726.7A5371862BE@r-forge.r-project.org> Author: arorar Date: 2015-05-22 22:47:26 +0200 (Fri, 22 May 2015) New Revision: 3647 Modified: pkg/FactorAnalytics/R/fmmc.R Log: Removed bestglm code of factorSelection Modified: pkg/FactorAnalytics/R/fmmc.R =================================================================== --- pkg/FactorAnalytics/R/fmmc.R 2015-05-22 01:54:35 UTC (rev 3646) +++ pkg/FactorAnalytics/R/fmmc.R 2015-05-22 20:47:26 UTC (rev 3647) @@ -1,385 +1,332 @@ -#' @title Functions to compute estimates and thier standard errors using fmmc -#' -#' Control default arguments. Usually for factorAnalytics. -#' -#' @details -#' This method takes in the additional arguments list and checks if parameters -#' are set. Then it defaults values if they are unset. Currently it controls the -#' fit.method(default: OLS) and variable.selection(default: subsets). If -#' variable.selection is set to values other than subsets/none then it will -#' default to subsets. -#' arguments for factorAnalytics -#' -#' @param ... Arguments that must be passed to fitTsfm -#' -#' -.fmmc.default.args <- function(...) { - add.args <- list(...) - if(!"fit.method" %in% names(add.args)) add.args[["fit.method"]] <- "LS" - - if(!"variable.selection" %in% names(add.args)) - add.args[["variable.selection"]] <- "subsets" - else { - if(!add.args[["variable.selection"]] %in% c("none", "subsets")) - add.args[["variable.selection"]] <- "subsets" - } - - if (add.args[["variable.selection"]] == "subsets") { - if(!"nvmax" %in% names(add.args)) - add.args[["nvmax"]] <- NA - } - - add.args -} - -#' Select factors based on BIC criteria -#' -#' @details -#' This method selects the best factors and based on the BIC criteria. It uses -#' the user supplied max count for max factors or defaults to half the total -#' number of factors -#' -#' @param data Data to use for selecting relevant factors. First column is the -#' response. The remaining columns is an exhaustive list of factors. -#' @param maxfactors An upper limit on the number of factors. -#' -#' -.fmmc.select.factors <- function(data, maxfactors) { - # default the max number of factors to half the number of factors - - maxfactors <- ifelse(is.na(maxfactors), floor((ncol(data) - 1)/2), - maxfactors) - if(maxfactors > 18) - warning("Max model size greater than 18. Consider reducing the size.") - - .data <- na.omit(cbind(data[,-1],data[,1])) - - fit <- c() - val <- tryCatch({ - fit <- bestglm(data.frame(na.omit(coredata(.data))), - IC="BIC",method="exhaustive", nvmax=maxfactors) - }, - error = function(e) NA, - warning = function(w) NA) - - if(inherits(val, "error")) { - warning(paste(colnames(data[1])," will be skipped. Model fitting failed")) - return(NA) - } - - fact.cols <- colnames(fit$BestModel$model)[-1] - fact.cols -} - - -#' This is the main implementation of the Factor Model Monte Carlo method. It returns -#' a fmmc object that contains the joint empirical density of factors and returns. This -#' fmmc object can be reused to for calucluting risk and performance estimates along -#' with standard errors for the estimates -#' -#' @details -#' This method takes in data, factors and residual type. It then does the following -#' 1. Fit a time series factor model to the data using user supplied selection and -#' fit variables or it defaults them to stepwise and OLS respectively. If any -#' of the betas are NA then the corresponding factors are dropped -#' 2. If the residual type beisdes empirical is specified then it fits the -#' corresponding distribution to the residuals and simulates from the fitted -#' distribution. The number of NA's in the simulated sample are the same as -#' original residuals. -#' 3. It then merges factors and non-NA residuals for each asset to create a full -#' outer join of the factors and residuals. We use this joined data to create new -#' simulated returns. Returns together with factors define a joint emperical density. -#' -#' @param R single vector of returns -#' @param factors matrix of factor returns -#' @param ... allows passing paramters to factorAnalytics. -#' @author Rohit Arora -#' -#' -.fmmc.proc <- function(R, factors ,... ) { - - # Check if the classes of Returns and factors are correct - if(is.null(nrow(R)) || is.null(nrow(factors))) { - warning("Inputs are not matrix") - return(NA) - } - - factors.data <- na.omit(factors) - T <- nrow(factors.data); T1 <- nrow(R) - if (T < T1) { - warning("Length of factors cannot be less than assets") - return(NA) - } - - # Start getting ready to fit a time-series factor model to the data. - .data <- as.matrix(merge(R,factors.data)) - - #default args if not set - add.args <- .fmmc.default.args(...) - fit.method <- add.args[["fit.method"]] - variable.selection <- add.args[["variable.selection"]] - - #short term hack till factorAnalytics fixes handling of "all subsets" - if(variable.selection == "subsets") { - - fact.cols <- .fmmc.select.factors(.data, add.args[["nvmax"]]) - if (0 == length(fact.cols)) { - warning(paste(colnames(R)," will be skipped. No suitable factor - exposures found")) - return(NA) - } - - factors.data <- factors.data[,fact.cols] - .data <- as.matrix(merge(R,factors.data)) - variable.selection <- add.args[["variable.selection"]] <- "none" - add.args[["nvmax"]] <- NULL - } - - # Lets fit the time-series model - args <- list(asset.names=colnames(R), - factor.names=colnames(factors.data), data=.data) - - args <- merge.list(args,add.args) - - # We do not need to remove NA's. Beta's do no change if NA's are not removed - possibleError <- tryCatch( - fit <- do.call(fitTsfm, args), - error=function(e) - e) - - if(inherits(possibleError, "error")) { - warning(paste("Timeseries model fitting failed for ", colnames(R))) - return(NA) - } - - resid <- do.call(merge,lapply(lapply(fit$asset.fit,residuals),as.xts)) - beta <- t(fit$beta) - - if(any(is.na(beta))) { - warning("some of the betas where NA in .fmmc.proc. Dropping those") - beta <- beta[!is.na(c(beta)), 1, drop=FALSE] - names.factors <- colnames(factors.data) - names.beta <- colnames(fit$beta) - factors.data <- as.matrix(factors.data[,names.factors %in% names.beta]) - } - - # define a joint empirical density for the factors and residuals and use - # that to calculate the returns. - .data <- as.matrix(merge(as.matrix(factors.data), resid)) - alpha <- matrix(as.numeric(fit$alpha), nrow=nrow(.data), ncol=1, byrow=TRUE) - - returns <- alpha + .data[,-ncol(.data),drop=FALSE] %*% beta + - .data[,ncol(.data),drop=FALSE] - - result <- list(bootdist = list(returns = returns, - factors = .data[,-ncol(.data),drop=FALSE]), - data = list(R = R, factors = factors.data), args = add.args) - result -} - -#' Statistic function for the boot call. It calculates the risk or performnace -#' meeasure by using the estimatation function in its argument list. -#' -#' @details -#' This method works as follows. -#' 1. Get data with factors and returns. -#' 2. Subset T rows from the data. -#' 3. Discard first TR-TR1 of the asset returns by setting them to NA -#' 4. calls .fmmc.proc method over the new data set to get a new joint empirical -#' distribution of returns and factors -#' 5. We use the new returns with the estimation function to calculate the -#' risk or performance measure. -#' -#' @param data matrix of (all factors + returns of just 1 asset) -#' @param indices row numbers generated by boot -#' @param args additinal paramters needed for subsetting the data and calulating -#' the perfomance/risk measure. -#' @author Rohit Arora -#' -#' -.fmmc.boot <- function(data, indices, args) { - - TR <- args$TR - TR1 <- args$TR1 - estimate.func <- args$estimate.func - fit.method <- args$fit.method - var.sel <- args$var.sel - - fun <- match.fun(estimate.func) - - # we just need TR rows of data - ind <- sample(indices, TR , replace = TRUE) - data <- data[ind,] - - # discard the first (TR-TR1) portion of returns if using fmmc. For - # complete data TR = TR1 - .data <- data - .data[1:(TR-TR1),ncol(.data)] <- NA - - # If the data does not have dates then it cannot be transformed to xts. - # So lets fake dates to make xts happy - .data <- as.xts(.data , order.by=seq(as.Date("1980/1/1"), by = "day", - length.out = nrow(.data))) - - # lets get a new empirical distribution of factors and returns for a new subset - fmmcObj <- .fmmc.proc(R=.data[,ncol(.data),drop=FALSE], - factors=.data[,-ncol(.data)], - fit.method = fit.method, variable.selection = var.sel) - - # lets calculate the performance or risk estimate - measure <- fun(fmmcObj$bootdist$returns) - measure -} - -#' Main function to calculate the risk/performance estimate and calculate the -#' standard error of the estimate using bootstrapping. -#' -#' @details -#' bootstrapping in our case can be painfully slow, so we exploit the parallel -#' capabilities of boot function. All cores on your machine are used. -#' We use the boot call from the boot library for calculating the estimate and -#' its standard error. -#' -#' @param fmmcObj object returned by fmmc proc. This is a comprehensive object -#' with all data for factors and returns. -#' @param nboot number of bootstap samples. Not sure how many repetations are -#' reuired but remember bias-variance tradeoff. Increasing nboot will only -#' reduce variance and not have a significant effect on bias(estimate) -#' @param estimate.func this is a handle to the function used for calulating -#' the perfomance/risk measure. -#' @param cl A cluster for running across multiple cores -#' @author Rohit Arora -#' -#' -.fmmc.se <- function(fmmcObj, nboot = 50, estimate.func, cl = NULL) { - - parallel <- if(is.null(cl)) "no" else "snow" - ncpus <- if(is.null(cl)) 1 else detectCores() - - # length of factors - TR <- nrow(fmmcObj$data$factors) - - # length of the asset returns - len <- nrow(fmmcObj$data$R) - - apply(fmmcObj$data$R, 2, function(col) which.min(is.na(col))) + 1 - - returns <- fmmcObj$bootdist$returns - factors <- fmmcObj$bootdist$factors - - # no need to do variable selection again. So lets turn it off - args <- list(TR = TR, TR1 = len, estimate.func = estimate.func, - fit.method = fmmcObj$args[["fit.method"]], var.sel = "none") - - result <- boot(data=cbind(factors, returns), statistic = .fmmc.boot, - R = nboot, parallel = parallel, ncpus = ncpus, cl = cl, args=args) - - se <- apply(result$t,2,sd) - se -} - -#' Worker function that acts between the fmmc procedure and calling method. -#' -#' @details -#' This method takes in data as single time series and factors as xts objects -#' It then calls the actual estimation procedure. -#' -#' @param R single vector of returns -#' @param factors matrix of factor returns -#' @param ... allows passing paramters to factorAnalytics. -#' @author Rohit Arora -#' -#' -#' -.fmmc.worker <- function(R, factors, ...) { - fmmc.obj <- .fmmc.proc(R=R, factors=factors, ...) - fmmc.obj -} - -#' Compute fmmc objects that can be used for calcuation of estimates and their -#' standard errors -#' -#' @details -#' This method takes in data and factors as xts objects where multiple -#' time series with different starting dates are merged together. It then -#' computes FMMC objects as described in Jiang and Martin (2013) -#' -#' @param R matrix of returns in xts format -#' @param factors matrix of factor returns in xts format -#' @param parallel flag to utilize multiplecores on the cpu. All cores are used. -#' @param ... Arguments that must be passed to fitTsfm -#' -#' @return returns an list of fmmc objects -#' -#' @references -#' Yindeng Jiang and Richard Doug Martin. Better Risk and Performance -#' Estimates with Factor Model Monte Carlo. SSRN Electronic Journal, July 2013. -#' -#' @author Rohit Arora -#' @export -#' -#' -fmmc <- function(R, factors, parallel=FALSE, ...) { - - ret <- NA - assets.count <- ncol(R) - - if (parallel) { - cl <- makeCluster(detectCores()) - registerDoSNOW(cl) - ret <- foreach (i = 1:assets.count) %dopar% .fmmc.worker(R[,i], factors, ...) - stopCluster(cl) - } else - ret <- foreach (i = 1:assets.count) %do% .fmmc.worker(R[,i], factors, ...) - - result <- ret[lapply(ret,length) > 1] - result -} - -#' Main function to calculate the standard errror of the estimate -#' -#' @details -#' This method takes in a list of fmmc objects and a callback function to compute -#' an estimate. The first argument of the callback function must be the data -#' bootstrapped using fmmc procedure. The remaining arguments can be suitably -#' bound to the parameters as needed. This function can also be used to calculate -#' the standard error using the se flag. -#' -#' @param fmmcObjs A list of fmmc objects computed using .fmmc.proc and containing -#' bootstrapped returns -#' @param fun A callback function where the first argument is returns and all the -#' other arguments are bounded to values -#' @param se A flag to indicate if standard error for the estimate must be calculated -#' @param parallel A flag to indicate if multiple cpu cores must be used -#' @param nboot Number of bootstrap samples -#' -#' @return returns the estimates and thier standard errors given fmmc objects -#' -#' @author Rohit Arora -#' @export -#' -fmmc.estimate.se <- function(fmmcObjs, fun=NULL, se=FALSE, nboot=100, - parallel = FALSE) { - - result <- as.matrix(rep(NA, length(fmmcObjs))); colnames(result) <- "estimate" - rownames(result) <- unlist(lapply(fmmcObjs, function(obj) colnames(obj$data$R))) - - if(is.null(fun)) return(result) - - cl <- NULL - if(parallel) { - cl <- makeCluster(detectCores()) - clusterEvalQ(cl, library(xts)) - } - - result[,1] <- unlist(lapply(fmmcObjs, function(obj) fun(obj$bootdist$returns))) - if(se) { - serr <- unlist( - lapply(fmmcObjs, function(obj) .fmmc.se(obj, nboot, fun, cl))) - result <- cbind(result, serr) - colnames(result) <- c("estimate", "se") - } - - if(parallel) stopCluster(cl) - - result +#' @title Functions to compute estimates and thier standard errors using fmmc +#' +#' Control default arguments. Usually for factorAnalytics. +#' +#' @details +#' This method takes in the additional arguments list and checks if parameters +#' are set. Then it defaults values if they are unset. Currently it controls the +#' fit.method(default: OLS) and variable.selection(default: subsets). If +#' variable.selection is set to values other than subsets/none then it will +#' default to subsets. +#' arguments for factorAnalytics +#' +#' @param ... Arguments that must be passed to fitTsfm +#' +#' +.fmmc.default.args <- function(...) { + add.args <- list(...) + if(!"fit.method" %in% names(add.args)) add.args[["fit.method"]] <- "LS" + + if(!"variable.selection" %in% names(add.args)) + add.args[["variable.selection"]] <- "subsets" + else { + if(!add.args[["variable.selection"]] %in% c("none", "subsets")) + add.args[["variable.selection"]] <- "subsets" + } + + if (add.args[["variable.selection"]] == "subsets") { + if(!"nvmax" %in% names(add.args)) + add.args[["nvmax"]] <- NA + } + + add.args +} + +#' This is the main implementation of the Factor Model Monte Carlo method. It returns +#' a fmmc object that contains the joint empirical density of factors and returns. This +#' fmmc object can be reused to for calucluting risk and performance estimates along +#' with standard errors for the estimates +#' +#' @details +#' This method takes in data, factors and residual type. It then does the following +#' 1. Fit a time series factor model to the data using user supplied selection and +#' fit variables or it defaults them to stepwise and OLS respectively. If any +#' of the betas are NA then the corresponding factors are dropped +#' 2. If the residual type beisdes empirical is specified then it fits the +#' corresponding distribution to the residuals and simulates from the fitted +#' distribution. The number of NA's in the simulated sample are the same as +#' original residuals. +#' 3. It then merges factors and non-NA residuals for each asset to create a full +#' outer join of the factors and residuals. We use this joined data to create new +#' simulated returns. Returns together with factors define a joint emperical density. +#' +#' @param R single vector of returns +#' @param factors matrix of factor returns +#' @param ... allows passing paramters to factorAnalytics. +#' @author Rohit Arora +#' +#' +.fmmc.proc <- function(R, factors ,... ) { + + # Check if the classes of Returns and factors are correct + if(is.null(nrow(R)) || is.null(nrow(factors))) { + warning("Inputs are not matrix") + return(NA) + } + + factors.data <- na.omit(factors) + T <- nrow(factors.data); T1 <- nrow(R) + if (T < T1) { + warning("Length of factors cannot be less than assets") + return(NA) + } + + # Start getting ready to fit a time-series factor model to the data. + .data <- as.matrix(merge(R,factors.data)) + + #default args if not set + add.args <- .fmmc.default.args(...) + fit.method <- add.args[["fit.method"]] + variable.selection <- add.args[["variable.selection"]] + + if(variable.selection == "subsets" && is.na(add.args[["nvmax"]])) + add.args[["nvmax"]] <- floor((ncol(factors.data) - 1)/2) + + # Lets fit the time-series model + args <- list(asset.names=colnames(R), + factor.names=colnames(factors.data), data=.data) + + args <- merge.list(args,add.args) + + # We do not need to remove NA's. Beta's do no change if NA's are not removed + possibleError <- tryCatch( + fit <- do.call(fitTsfm, args), + error=function(e) + e) + + if(inherits(possibleError, "error")) { + warning(paste("Timeseries model fitting failed for ", colnames(R))) + return(NA) + } + + resid <- do.call(merge,lapply(lapply(fit$asset.fit,residuals),as.xts)) + beta <- t(fit$beta) + + if(any(is.na(beta))) { + warning("some of the betas where NA in .fmmc.proc. Dropping those") + beta <- beta[!is.na(c(beta)), 1, drop=FALSE] + names.factors <- colnames(factors.data) + names.beta <- rownames(beta) + factors.data <- as.matrix(factors.data[,names.factors %in% names.beta]) + } + + # define a joint empirical density for the factors and residuals and use + # that to calculate the returns. + .data <- as.matrix(merge(as.matrix(factors.data), resid)) + alpha <- matrix(as.numeric(fit$alpha), nrow=nrow(.data), ncol=1, byrow=TRUE) + + returns <- alpha + .data[,-ncol(.data),drop=FALSE] %*% beta + + .data[,ncol(.data),drop=FALSE] + + result <- list(bootdist = list(returns = returns, + factors = .data[,-ncol(.data),drop=FALSE]), + data = list(R = R, factors = factors.data), args = add.args) + result +} + +#' Statistic function for the boot call. It calculates the risk or performnace +#' meeasure by using the estimatation function in its argument list. +#' +#' @details +#' This method works as follows. +#' 1. Get data with factors and returns. +#' 2. Subset T rows from the data. +#' 3. Discard first TR-TR1 of the asset returns by setting them to NA +#' 4. calls .fmmc.proc method over the new data set to get a new joint empirical +#' distribution of returns and factors +#' 5. We use the new returns with the estimation function to calculate the +#' risk or performance measure. +#' +#' @param data matrix of (all factors + returns of just 1 asset) +#' @param indices row numbers generated by boot +#' @param args additinal paramters needed for subsetting the data and calulating +#' the perfomance/risk measure. +#' @author Rohit Arora +#' +#' +.fmmc.boot <- function(data, indices, args) { + + TR <- args$TR + TR1 <- args$TR1 + estimate.func <- args$estimate.func + fit.method <- args$fit.method + var.sel <- args$var.sel + + fun <- match.fun(estimate.func) + + # we just need TR rows of data + ind <- sample(indices, TR , replace = TRUE) + data <- data[ind,] + + # discard the first (TR-TR1) portion of returns if using fmmc. For + # complete data TR = TR1 + .data <- data + .data[1:(TR-TR1),ncol(.data)] <- NA + + # If the data does not have dates then it cannot be transformed to xts. + # So lets fake dates to make xts happy + .data <- as.xts(.data , order.by=seq(as.Date("1980/1/1"), by = "day", + length.out = nrow(.data))) + + # lets get a new empirical distribution of factors and returns for a new subset + fmmcObj <- .fmmc.proc(R=.data[,ncol(.data),drop=FALSE], + factors=.data[,-ncol(.data)], + fit.method = fit.method, variable.selection = var.sel) + + # lets calculate the performance or risk estimate + measure <- fun(fmmcObj$bootdist$returns) + measure +} + +#' Main function to calculate the risk/performance estimate and calculate the +#' standard error of the estimate using bootstrapping. +#' +#' @details +#' bootstrapping in our case can be painfully slow, so we exploit the parallel +#' capabilities of boot function. All cores on your machine are used. +#' We use the boot call from the boot library for calculating the estimate and +#' its standard error. +#' +#' @param fmmcObj object returned by fmmc proc. This is a comprehensive object +#' with all data for factors and returns. +#' @param nboot number of bootstap samples. Not sure how many repetations are +#' reuired but remember bias-variance tradeoff. Increasing nboot will only +#' reduce variance and not have a significant effect on bias(estimate) +#' @param estimate.func this is a handle to the function used for calulating +#' the perfomance/risk measure. +#' @param cl A cluster for running across multiple cores +#' @author Rohit Arora +#' +#' +.fmmc.se <- function(fmmcObj, nboot = 50, estimate.func, cl = NULL) { + + parallel <- if(is.null(cl)) "no" else "snow" + ncpus <- if(is.null(cl)) 1 else detectCores() + + # length of factors + TR <- nrow(fmmcObj$data$factors) + + # length of the asset returns + len <- nrow(fmmcObj$data$R) - + apply(fmmcObj$data$R, 2, function(col) which.min(is.na(col))) + 1 + + returns <- fmmcObj$bootdist$returns + factors <- fmmcObj$bootdist$factors + + # no need to do variable selection again. So lets turn it off + args <- list(TR = TR, TR1 = len, estimate.func = estimate.func, + fit.method = fmmcObj$args[["fit.method"]], var.sel = "none") + + result <- boot(data=cbind(factors, returns), statistic = .fmmc.boot, + R = nboot, parallel = parallel, ncpus = ncpus, cl = cl, args=args) + + se <- apply(result$t,2,sd) + se +} + +#' Worker function that acts between the fmmc procedure and calling method. +#' +#' @details +#' This method takes in data as single time series and factors as xts objects +#' It then calls the actual estimation procedure. +#' +#' @param R single vector of returns +#' @param factors matrix of factor returns +#' @param ... allows passing paramters to factorAnalytics. +#' @author Rohit Arora +#' +#' +#' +.fmmc.worker <- function(R, factors, ...) { + fmmc.obj <- .fmmc.proc(R=R, factors=factors, ...) + fmmc.obj +} + +#' Compute fmmc objects that can be used for calcuation of estimates and their +#' standard errors +#' +#' @details +#' This method takes in data and factors as xts objects where multiple +#' time series with different starting dates are merged together. It then +#' computes FMMC objects as described in Jiang and Martin (2013) +#' +#' @param R matrix of returns in xts format +#' @param factors matrix of factor returns in xts format +#' @param parallel flag to utilize multiplecores on the cpu. All cores are used. +#' @param ... Arguments that must be passed to fitTsfm +#' +#' @return returns an list of fmmc objects +#' +#' @references +#' Yindeng Jiang and Richard Doug Martin. Better Risk and Performance +#' Estimates with Factor Model Monte Carlo. SSRN Electronic Journal, July 2013. +#' +#' @author Rohit Arora +#' @export +#' +#' +fmmc <- function(R, factors, parallel=FALSE, ...) { + + ret <- NA + assets.count <- ncol(R) + + if (parallel) { + cl <- makeCluster(detectCores()) + registerDoSNOW(cl) + ret <- foreach (i = 1:assets.count) %dopar% .fmmc.worker(R[,i], factors, ...) + stopCluster(cl) + } else + ret <- foreach (i = 1:assets.count) %do% .fmmc.worker(R[,i], factors, ...) + + result <- ret[lapply(ret,length) > 1] + result +} + +#' Main function to calculate the standard errror of the estimate +#' +#' @details +#' This method takes in a list of fmmc objects and a callback function to compute +#' an estimate. The first argument of the callback function must be the data +#' bootstrapped using fmmc procedure. The remaining arguments can be suitably +#' bound to the parameters as needed. This function can also be used to calculate +#' the standard error using the se flag. +#' +#' @param fmmcObjs A list of fmmc objects computed using .fmmc.proc and containing +#' bootstrapped returns +#' @param fun A callback function where the first argument is returns and all the +#' other arguments are bounded to values +#' @param se A flag to indicate if standard error for the estimate must be calculated +#' @param parallel A flag to indicate if multiple cpu cores must be used +#' @param nboot Number of bootstrap samples +#' +#' @return returns the estimates and thier standard errors given fmmc objects +#' +#' @author Rohit Arora +#' @export +#' +fmmc.estimate.se <- function(fmmcObjs, fun=NULL, se=FALSE, nboot=100, + parallel = FALSE) { + + result <- as.matrix(rep(NA, length(fmmcObjs))); colnames(result) <- "estimate" + rownames(result) <- unlist(lapply(fmmcObjs, function(obj) colnames(obj$data$R))) + + if(is.null(fun)) return(result) + + cl <- NULL + if(parallel) { + cl <- makeCluster(detectCores()) + clusterEvalQ(cl, library(xts)) + } + + result[,1] <- unlist(lapply(fmmcObjs, function(obj) fun(obj$bootdist$returns))) + if(se) { + serr <- unlist( + lapply(fmmcObjs, function(obj) .fmmc.se(obj, nboot, fun, cl))) + result <- cbind(result, serr) + colnames(result) <- c("estimate", "se") + } + + if(parallel) stopCluster(cl) + + result } \ No newline at end of file From noreply at r-forge.r-project.org Mon May 25 14:39:03 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 25 May 2015 14:39:03 +0200 (CEST) Subject: [Returnanalytics-commits] r3648 - in pkg: . Dowd Dowd/R Dowd/man Dowd/tests Dowd/tests/testthat Message-ID: <20150525123903.9CEBA185F6D@r-forge.r-project.org> Author: dacharya Date: 2015-05-25 14:39:03 +0200 (Mon, 25 May 2015) New Revision: 3648 Added: pkg/Dowd/ pkg/Dowd/DESCRIPTION pkg/Dowd/NAMESPACE pkg/Dowd/R/ pkg/Dowd/R/BinomialBacktest.R pkg/Dowd/man/ pkg/Dowd/man/BinomialBacktest.Rd pkg/Dowd/tests/ pkg/Dowd/tests/testthat.R pkg/Dowd/tests/testthat/ pkg/Dowd/tests/testthat/testBinomialBacktest.R Log: code, documentation and tests for BinomialBacktest Added: pkg/Dowd/DESCRIPTION =================================================================== --- pkg/Dowd/DESCRIPTION (rev 0) +++ pkg/Dowd/DESCRIPTION 2015-05-25 12:39:03 UTC (rev 3648) @@ -0,0 +1,12 @@ +Package: Dowd +Type: Package +Title: R-version of Matlab Toolbox offered in Kevin Dowd's book Measuring Market Risk +Version: 0.0.1 +Date: 2015-05-24 +Author: Dinesh Acharya +Maintainer: Dinesh Acharya +Description: +Depends: R (>= 2.14.0) +Suggests: PerformanceAnalytics, + testthat +License: GNU Public License Added: pkg/Dowd/NAMESPACE =================================================================== --- pkg/Dowd/NAMESPACE (rev 0) +++ pkg/Dowd/NAMESPACE 2015-05-25 12:39:03 UTC (rev 3648) @@ -0,0 +1,3 @@ +# Generated by roxygen2 (4.1.1): do not edit by hand + +export(BinomialBacktest) Added: pkg/Dowd/R/BinomialBacktest.R =================================================================== --- pkg/Dowd/R/BinomialBacktest.R (rev 0) +++ pkg/Dowd/R/BinomialBacktest.R 2015-05-25 12:39:03 UTC (rev 3648) @@ -0,0 +1,43 @@ +#' Carries out the binomial backtest for a VaR risk measurement model. +#' +#' The basic idea behind binomial backtest (also called basic frequency +#' test) is to test whether the observed frequency of losses that exceed VaR is +#' consistent with the frequency of tail losses predicted by the mode. Binomial +#' Backtest carries out the binomial backtest for a VaR risk measurement model +#' for specified VaR confidence level and for a one-sided alternative +#' hypothesis (H1). +#' +#' @param x Number of failures +#' @param n Number of observations +#' @param cl Confidence level for VaR +#' @return Probability that the VaR model is correct +#' +#' @references Dowd, Kevin. Measuring Market Risk, Wiley, 2007. +#' +#' Kupiec, Paul. Techniques for verifying the accuracy of risk measurement +#' models, Journal of Derivatives, Winter 1995, p. 79. +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # Probability that the VaR model is correct for 3 failures, 100 number +#' observations and 95% confidence level +#' BinomialBacktest(55, 1000, 0.95) +#' +#' @export +BinomialBacktest <- function (x, n, cl){ + # Give warning if x>n or cl>100% + if(x > n | cl > 1){ + warning ("Incorrect parameter list. Make sure that x>n and cl<=100%") + return (NaN) + } + + p <- 1 - cl # Probability of a failure each observation occurs + + if (x >= n*p){ + probability.model.is.correct <- 1-pbinom(x-1, n, p) + } else { + probability.model.is.correct <- pbinom(x, n, p) + } + return (probability.model.is.correct) +} Added: pkg/Dowd/man/BinomialBacktest.Rd =================================================================== --- pkg/Dowd/man/BinomialBacktest.Rd (rev 0) +++ pkg/Dowd/man/BinomialBacktest.Rd 2015-05-25 12:39:03 UTC (rev 3648) @@ -0,0 +1,41 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/BinomialBacktest.R +\name{BinomialBacktest} +\alias{BinomialBacktest} +\title{Carries out the binomial backtest for a VaR risk measurement model.} +\usage{ +BinomialBacktest(x, n, cl) +} +\arguments{ +\item{x}{Number of failures} + +\item{n}{Number of observations} + +\item{cl}{Confidence level for VaR} +} +\value{ +Probability that the VaR model is correct +} +\description{ +The basic idea behind binomial backtest (also called basic frequency +test) is to test whether the observed frequency of losses that exceed VaR is +consistent with the frequency of tail losses predicted by the mode. Binomial +Backtest carries out the binomial backtest for a VaR risk measurement model +for specified VaR confidence level and for a one-sided alternative +hypothesis (H1). +} +\examples{ +# Probability that the VaR model is correct for 3 failures, 100 number + observations and 95\% confidence level + BinomialBacktest(55, 1000, 0.95) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, Kevin. Measuring Market Risk, Wiley, 2007. + +Kupiec, Paul. Techniques for verifying the accuracy of risk measurement +models, Journal of Derivatives, Winter 1995, p. 79. +} + Added: pkg/Dowd/tests/testthat/testBinomialBacktest.R =================================================================== --- pkg/Dowd/tests/testthat/testBinomialBacktest.R (rev 0) +++ pkg/Dowd/tests/testthat/testBinomialBacktest.R 2015-05-25 12:39:03 UTC (rev 3648) @@ -0,0 +1,11 @@ +test_that("Binomial Backtest Works.",{ + # Success + expect_equal(0.7358, BinomialBacktest(1, 100, 0.99), tolerance=0.001) + expect_equal(0.2529, BinomialBacktest(55, 1000, 0.95), tolerance=0.001) + + # Warnings + expect_warning(val <- BinomialBacktest(35,30,0.95)) + expect_true(is.nan(val)) + expect_warning(val <- BinomialBacktest(5,30,1.5)) + expect_true(is.nan(val)) +}) \ No newline at end of file Added: pkg/Dowd/tests/testthat.R =================================================================== --- pkg/Dowd/tests/testthat.R (rev 0) +++ pkg/Dowd/tests/testthat.R 2015-05-25 12:39:03 UTC (rev 3648) @@ -0,0 +1,4 @@ +library(testthat) +library(Dowd) + +test_check("Dowd") From noreply at r-forge.r-project.org Mon May 25 22:30:10 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 25 May 2015 22:30:10 +0200 (CEST) Subject: [Returnanalytics-commits] r3649 - in pkg/Dowd: . R man Message-ID: <20150525203010.D376918799E@r-forge.r-project.org> Author: dacharya Date: 2015-05-25 22:30:10 +0200 (Mon, 25 May 2015) New Revision: 3649 Added: pkg/Dowd/R/ADTestStat.R pkg/Dowd/man/ADTestStat.Rd Modified: pkg/Dowd/NAMESPACE Log: ADTestStat: code and documentation. Modified: pkg/Dowd/NAMESPACE =================================================================== --- pkg/Dowd/NAMESPACE 2015-05-25 12:39:03 UTC (rev 3648) +++ pkg/Dowd/NAMESPACE 2015-05-25 20:30:10 UTC (rev 3649) @@ -1,3 +1,4 @@ # Generated by roxygen2 (4.1.1): do not edit by hand +export(ADTestStat) export(BinomialBacktest) Added: pkg/Dowd/R/ADTestStat.R =================================================================== --- pkg/Dowd/R/ADTestStat.R (rev 0) +++ pkg/Dowd/R/ADTestStat.R 2015-05-25 20:30:10 UTC (rev 3649) @@ -0,0 +1,72 @@ +#' Plots cumulative density for Anderson-Darling test and computes confidence +#' interval Anderson-Darling test stat. +#' +#' AD test can be used to carry out distribution equality test and is +#' similar to Kolmogorov-Smirnov test. AD test statistic is defined as: +#' \deqn{A^2=n\int_{-\infty}^{\infty}\frac{[\hat{F}(x)-F(x)]^2}{F(x)[1-F(x)]}dF(x)} +#' which can be simplified to +#' \deqn{=-n-\frac{1}{n}\sum_{i=1}^n(2i-1)[\ln F(X_i)+\ln(1-F(X_{n+1-i}))]} +#' +#' @param number.trials +#' @param sample.size +#' @param confidence.interval +#' @return Confidence Interval for AD test statistic +#' @references Dowd, Kevin. Measuring Market Risk, Wiley, 2007. +#' +#' Anderson, T.W. and Darling, D.A. Asymptotic Theory of Certain Goodness of +#' Fit Criteria Based on Stochastic Processes, The Annals of Mathematical +#' Statistics, 23(2), 1952, p. 193-212. +#' +#' Kvam, P.H. and Vidakovic, B. Nonparametric Statistics with Applications to +#' Science and Engineering, Wiley, 2007. +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # Probability that the VaR model is correct for 3 failures, 100 number +#' observations and 95% confidence level +#' ADTestStat(1000, 100, 0.95) +#' +#' @export +ADTestStat <- function(number.trials, sample.size, confidence.interval){ + + if (confidence.interval>1){ + stop("Confidence Interval should be less than 1.") + } + + m <- number.trials + n <- sample.size + + # Random Number Generation + data <- matrix(rnorm(m*n), m, n) + + # Initialize vectors + term <- double(n) + AD.test.stat <- double(m) + + # Compute AD test statistic + for (i in 1:m){ + trial.sample <- data[i, ] + ordered.trial.sample <- sort(trial.sample) + for (j in 1:n){ + term[j] <- (2*j-1)*(log(pnorm(ordered.trial.sample[j],0,1))- + log(1-pnorm(ordered.trial.sample[n+1-j],0,1))); + } + AD.test.stat[i] <- -n-mean(term) + } + AD.test.stat <- sort(AD.test.stat) + + # Obtain confidence interval + lower.bound.index <- round(m*(1-confidence.interval)/2) + upper.bound.index <- round(m* (confidence.interval+(1-confidence.interval)/2)) + confidence.interval.for.KS.test.stat <- c(AD.test.stat[lower.bound.index], + AD.test.stat[upper.bound.index]) + # Plot the graph + cdf <- seq(1/m, 1, 1/m) + plot(AD.test.stat, cdf, col="red", type="l", + main="Cumulative density for AD test statistic", + xlab="AD test statistic", ylab="Cumulative probability") + + return(confidence.interval.for.KS.test.stat) + +} Added: pkg/Dowd/man/ADTestStat.Rd =================================================================== --- pkg/Dowd/man/ADTestStat.Rd (rev 0) +++ pkg/Dowd/man/ADTestStat.Rd 2015-05-25 20:30:10 UTC (rev 3649) @@ -0,0 +1,45 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/ADTestStat.R +\name{ADTestStat} +\alias{ADTestStat} +\title{Plots cumulative density for Anderson-Darling test and computes confidence +interval Anderson-Darling test stat.} +\usage{ +ADTestStat(number.trials, sample.size, confidence.interval) +} +\arguments{ +\item{number.trials}{} + +\item{sample.size}{} + +\item{confidence.interval}{} +} +\value{ +Confidence Interval for AD test statistic +} +\description{ +AD test can be used to carry out distribution equality test and is +similar to Kolmogorov-Smirnov test. AD test statistic is defined as: +\deqn{A^2=n\int_{-\infty}^{\infty}\frac{[\hat{F}(x)-F(x)]^2}{F(x)[1-F(x)]}dF(x)} +which can be simplified to +\deqn{=-n-\frac{1}{n}\sum_{i=1}^n(2i-1)[\ln F(X_i)+\ln(1-F(X_{n+1-i}))]} +} +\examples{ +# Probability that the VaR model is correct for 3 failures, 100 number + observations and 95\% confidence level + ADTestStat(1000, 100, 0.95) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, Kevin. Measuring Market Risk, Wiley, 2007. + +Anderson, T.W. and Darling, D.A. Asymptotic Theory of Certain Goodness of +Fit Criteria Based on Stochastic Processes, The Annals of Mathematical +Statistics, 23(2), 1952, p. 193-212. + +Kvam, P.H. and Vidakovic, B. Nonparametric Statistics with Applications to +Science and Engineering, Wiley, 2007. +} + From noreply at r-forge.r-project.org Tue May 26 21:53:33 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 26 May 2015 21:53:33 +0200 (CEST) Subject: [Returnanalytics-commits] r3650 - in pkg/Dowd: . R man tests/testthat Message-ID: <20150526195333.34F22187979@r-forge.r-project.org> Author: dacharya Date: 2015-05-26 21:53:32 +0200 (Tue, 26 May 2015) New Revision: 3650 Added: pkg/Dowd/R/JarqueBeraBacktest.R pkg/Dowd/R/KSTestStat.R pkg/Dowd/R/KuiperTestStat.R pkg/Dowd/man/Dowd-package.Rd pkg/Dowd/man/JarqueBeraBacktest.Rd pkg/Dowd/man/KSTestStat.Rd pkg/Dowd/man/KuiperTestStat.Rd pkg/Dowd/tests/testthat/testJarqueBeraBacktest.R Modified: pkg/Dowd/DESCRIPTION pkg/Dowd/NAMESPACE pkg/Dowd/R/ADTestStat.R pkg/Dowd/man/ADTestStat.Rd Log: KSTestStat: source and documentation. KuiperTestStat: source and documentation. JarqueBeraBacktest: source, documentation and test. Modified: pkg/Dowd/DESCRIPTION =================================================================== --- pkg/Dowd/DESCRIPTION 2015-05-25 20:30:10 UTC (rev 3649) +++ pkg/Dowd/DESCRIPTION 2015-05-26 19:53:32 UTC (rev 3650) @@ -1,7 +1,7 @@ Package: Dowd Type: Package Title: R-version of Matlab Toolbox offered in Kevin Dowd's book Measuring Market Risk -Version: 0.0.1 +Version: 0.1 Date: 2015-05-24 Author: Dinesh Acharya Maintainer: Dinesh Acharya Modified: pkg/Dowd/NAMESPACE =================================================================== --- pkg/Dowd/NAMESPACE 2015-05-25 20:30:10 UTC (rev 3649) +++ pkg/Dowd/NAMESPACE 2015-05-26 19:53:32 UTC (rev 3650) @@ -2,3 +2,6 @@ export(ADTestStat) export(BinomialBacktest) +export(JarqueBeraBacktest) +export(KSTestStat) +export(KuiperTestStat) Modified: pkg/Dowd/R/ADTestStat.R =================================================================== --- pkg/Dowd/R/ADTestStat.R 2015-05-25 20:30:10 UTC (rev 3649) +++ pkg/Dowd/R/ADTestStat.R 2015-05-26 19:53:32 UTC (rev 3650) @@ -1,17 +1,17 @@ -#' Plots cumulative density for Anderson-Darling test and computes confidence -#' interval Anderson-Darling test stat. +#' Plots cumulative density for AD test and computes confidence +#' interval for AD test stat. #' -#' AD test can be used to carry out distribution equality test and is +#' Anderson-Darling(AD) test can be used to carry out distribution equality test and is #' similar to Kolmogorov-Smirnov test. AD test statistic is defined as: #' \deqn{A^2=n\int_{-\infty}^{\infty}\frac{[\hat{F}(x)-F(x)]^2}{F(x)[1-F(x)]}dF(x)} -#' which can be simplified to +#' which is equivalent to #' \deqn{=-n-\frac{1}{n}\sum_{i=1}^n(2i-1)[\ln F(X_i)+\ln(1-F(X_{n+1-i}))]} #' #' @param number.trials #' @param sample.size #' @param confidence.interval #' @return Confidence Interval for AD test statistic -#' @references Dowd, Kevin. Measuring Market Risk, Wiley, 2007. +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. #' #' Anderson, T.W. and Darling, D.A. Asymptotic Theory of Certain Goodness of #' Fit Criteria Based on Stochastic Processes, The Annals of Mathematical @@ -45,10 +45,10 @@ AD.test.stat <- double(m) # Compute AD test statistic - for (i in 1:m){ + for (i in 1:m) { trial.sample <- data[i, ] ordered.trial.sample <- sort(trial.sample) - for (j in 1:n){ + for (j in 1:n) { term[j] <- (2*j-1)*(log(pnorm(ordered.trial.sample[j],0,1))- log(1-pnorm(ordered.trial.sample[n+1-j],0,1))); } @@ -59,7 +59,7 @@ # Obtain confidence interval lower.bound.index <- round(m*(1-confidence.interval)/2) upper.bound.index <- round(m* (confidence.interval+(1-confidence.interval)/2)) - confidence.interval.for.KS.test.stat <- c(AD.test.stat[lower.bound.index], + confidence.interval.for.AD.test.stat <- c(AD.test.stat[lower.bound.index], AD.test.stat[upper.bound.index]) # Plot the graph cdf <- seq(1/m, 1, 1/m) @@ -67,6 +67,6 @@ main="Cumulative density for AD test statistic", xlab="AD test statistic", ylab="Cumulative probability") - return(confidence.interval.for.KS.test.stat) + return(confidence.interval.for.AD.test.stat) } Added: pkg/Dowd/R/JarqueBeraBacktest.R =================================================================== --- pkg/Dowd/R/JarqueBeraBacktest.R (rev 0) +++ pkg/Dowd/R/JarqueBeraBacktest.R 2015-05-26 19:53:32 UTC (rev 3650) @@ -0,0 +1,36 @@ +#' Jarque-Bera backtest for normality. +#' +#' Jarque-Bera (JB) is a backtest to test whether the skewness and kurtosis of a +#' given sample matches that of normal distribution. JB test statistic is +#' defined as \deqn{JB=\frac{n}{6}\left(s^2+\frac{(k-3)^2}{4}\right)} where +#' \eqn{n} is sample size, \eqn{s} and \eqn{k} are coefficients of sample +#' skewness and kurtosis. +#' +#' @param sample.skewness Coefficient of Skewness of the sample +#' @param sample.kurtosis Coefficient of Kurtosis of the sample +#' @param n Number of observations +#' @return Probability of null hypothesis H0 +#' +#' @references Dowd, Kevin. Measuring Market Risk, Wiley, 2007. +#' +#' Jarque, C. M. and Bera, A. K. A test for normality of observations and +#' regression residuals, International Statistical Review, 55(2): 163-172. +#' +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # JB test statistic for sample with 500 observations with sample +#' skewness and kurtosis of -0.075 and 2.888 +#' JarqueBeraBacktest(-0.075,2.888,500) +#' +#' @export +JarqueBeraBacktest <- function(sample.skewness, sample.kurtosis, n){ + s <- sample.skewness + k <- sample.kurtosis + jb.test.stat <- (n/6)*(s^2+((k-3)^2)/4) + # Corresponding cdf-value for a chi-squared distribution with two degrees of + # freedom + prob.value.of.null <- 1-pchisq(jb.test.stat, 2) + return(prob.value.of.null) +} \ No newline at end of file Added: pkg/Dowd/R/KSTestStat.R =================================================================== --- pkg/Dowd/R/KSTestStat.R (rev 0) +++ pkg/Dowd/R/KSTestStat.R 2015-05-26 19:53:32 UTC (rev 3650) @@ -0,0 +1,66 @@ +#' Plots cumulative density for KS test and computes confidence interval for +#' KS test stat. +#' +#' Kolmogorov-Smirnov (KS) test statistic is a non parametric test for +#' distribution equality and measures the maximum distance between two cdfs. +#' Formally, the KS test statistic is : \deqn{D=\max_i|F(X_i)-\hat{F}(X_i)|} +#' +#' @param number.trials Number of trials +#' @param sample.size Sizes of the trial samples +#' @param confidence.interval Confidence interval expressed as a fraction of 1 +#' @return Confidence Interval for KS test stat +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' Chakravarti, I. M., Laha, R. G. and Roy, J. Handbook of Methods of #' Applied Statistics, Volume 1, Wiley, 1967. +#' +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # Plots the cdf for KS Test statistic and returns KS confidence interval +#' for 100 trials with 1000 sample size and 0.95 confidence interval +#' KSTestStat(100, 1000, 0.95) +#' +#' @export +KSTestStat <- function(number.trials, sample.size, confidence.interval){ + + if (confidence.interval>1){ + stop("Confidence Interval should be less than 1.") + } + + # Read back input parameters + m <- number.trials + n <- sample.size + # Random number generator + data <- matrix(rnorm(m*n), m, n) + + # Initialize vectors + cdf.diff <- double(n) + max.diff <- double(m) + + # Compute KS Test Statistic + for (i in 1:m) { + trial.sample <- data[i, ] + ordered.trial.sample <- sort(trial.sample) + for (j in 1:n) { + cdf.diff[j] <- j/n-pnorm(ordered.trial.sample[j],0,1) + } + max.diff[i] <- max(abs(cdf.diff)) + } + max.diff <- sort(max.diff) + + # Obtain confidence interval + lower.bound.index <- round(m*(1-confidence.interval)/2) + upper.bound.index <- round(m*(confidence.interval+(1-confidence.interval)/2)) + confidence.interval.for.KS.test.stat <- c(max.diff[lower.bound.index], + max.diff[upper.bound.index]) + + # Plot + cdf <- seq(1/m, 1, 1/m) + plot(max.diff, cdf, col="red", type="l", + main="Cumulative Density for KS test statistic", + xlab="KS test statistic", ylab="Cumulative probability") + + return(confidence.interval.for.KS.test.stat) +} \ No newline at end of file Added: pkg/Dowd/R/KuiperTestStat.R =================================================================== --- pkg/Dowd/R/KuiperTestStat.R (rev 0) +++ pkg/Dowd/R/KuiperTestStat.R 2015-05-26 19:53:32 UTC (rev 3650) @@ -0,0 +1,67 @@ +#' Plots cummulative density for Kuiper test and computes confidence interval +#' for Kuiper test stat. +#' +#' Kuiper test statistic is a non parametric test for +#' distribution equality and is closely related to KS test. Formally, the +#' Kuiper test statistic is : +#' \deqn{D*=\max_i\{F(X_i)-\hat{F(x_i)}+\max_i\{\hat{F}(X_i)-F(X_i)\}} +#' +#' @param number.trials Number of trials +#' @param sample.size Sizes of the trial samples +#' @param confidence.interval Confidence interval expressed as a fraction of 1 +#' @return Confidence Interval for KS test stat +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # Plots the cdf for Kuiper Test statistic and returns Kuiper confidence +#' interval for 100 trials with 1000 sample size and 0.95 confidence +#' interval. +#' KuiperTestStat(100, 1000, 0.95) +#' +#' @export +KuiperTestStat <- function(number.trials, sample.size, confidence.interval){ + + if (confidence.interval>1){ + stop("Confidence Interval should be less than 1.") + } + + # Read back input parameters + m <- number.trials + n <- sample.size + + # Random number generator + data <- matrix(rnorm(m*n), m, n) + + # Initialize vectors + cdf.diff <- double(n) + Kuiper.test.stat <- double(m) + + # Compute KS Test Statistic + for (i in 1:m) { + trial.sample <- data[i, ] + ordered.trial.sample <- sort(trial.sample) + for (j in 1:n) { + cdf.diff[j] <- j/n-pnorm(ordered.trial.sample[j],0,1) + } + Kuiper.test.stat[i] <- max(cdf.diff)-min(cdf.diff) + } + Kuiper.test.stat <- sort(Kuiper.test.stat) + + # Obtain confidence interval + lower.bound.index <- round(m*(1-confidence.interval)/2) + upper.bound.index <- round(m*(confidence.interval+(1-confidence.interval)/2)) + confidence.interval.for.Kuiper.test.stat <- c(Kuiper.test.stat[lower.bound.index], + Kuiper.test.stat[upper.bound.index]) + + # Plot + cdf <- seq(1/m, 1, 1/m) + plot(Kuiper.test.stat, cdf, col="red", type="l", + main="Cumulative density for Kuiper test statistic", + xlab="Kuiper test statistic", ylab="Cumulative probability") + + return(confidence.interval.for.Kuiper.test.stat) +} \ No newline at end of file Modified: pkg/Dowd/man/ADTestStat.Rd =================================================================== --- pkg/Dowd/man/ADTestStat.Rd 2015-05-25 20:30:10 UTC (rev 3649) +++ pkg/Dowd/man/ADTestStat.Rd 2015-05-26 19:53:32 UTC (rev 3650) @@ -2,8 +2,8 @@ % Please edit documentation in R/ADTestStat.R \name{ADTestStat} \alias{ADTestStat} -\title{Plots cumulative density for Anderson-Darling test and computes confidence -interval Anderson-Darling test stat.} +\title{Plots cumulative density for AD test and computes confidence +interval for AD test stat.} \usage{ ADTestStat(number.trials, sample.size, confidence.interval) } @@ -18,10 +18,10 @@ Confidence Interval for AD test statistic } \description{ -AD test can be used to carry out distribution equality test and is +Anderson-Darling(AD) test can be used to carry out distribution equality test and is similar to Kolmogorov-Smirnov test. AD test statistic is defined as: \deqn{A^2=n\int_{-\infty}^{\infty}\frac{[\hat{F}(x)-F(x)]^2}{F(x)[1-F(x)]}dF(x)} -which can be simplified to +which is equivalent to \deqn{=-n-\frac{1}{n}\sum_{i=1}^n(2i-1)[\ln F(X_i)+\ln(1-F(X_{n+1-i}))]} } \examples{ @@ -33,7 +33,7 @@ Dinesh Acharya } \references{ -Dowd, Kevin. Measuring Market Risk, Wiley, 2007. +Dowd, K. Measuring Market Risk, Wiley, 2007. Anderson, T.W. and Darling, D.A. Asymptotic Theory of Certain Goodness of Fit Criteria Based on Stochastic Processes, The Annals of Mathematical Added: pkg/Dowd/man/Dowd-package.Rd =================================================================== --- pkg/Dowd/man/Dowd-package.Rd (rev 0) +++ pkg/Dowd/man/Dowd-package.Rd 2015-05-26 19:53:32 UTC (rev 3650) @@ -0,0 +1,29 @@ +\name{Dowd-package} +\alias{Dowd-package} +\docType{package} +\title{ +R-version of Kevin Dowd's MATLAB Toolbox from book "Measuring Market Risk". +} + +\description{ +\kbd{Dowd} Kevin Dowd's book "Measuring Market Risk" gives overview of risk measurement procedures with focus on Value at Risk (VaR) and Expected Shortfall (ES). +} +\author{ +Dinesh Acharya \cr + +Maintainer: Dinesh Acharya \email{dines.acharya at gmail.com} +} + +\references{ + +Dowd, K. \emph{Measuring Market Risk}. Wiley. 2005. + +} + +\section{Acknowledgments}{ +Without Kevin Dowd's book Measuring Market Risk and accompanying MATLAB toolbox, this project would not have been possible. + +Peter Carl and Brian G. Peterson deserve special acknowledgement for mentoring me on this project. +} + +\keyword{ package } \ No newline at end of file Added: pkg/Dowd/man/JarqueBeraBacktest.Rd =================================================================== --- pkg/Dowd/man/JarqueBeraBacktest.Rd (rev 0) +++ pkg/Dowd/man/JarqueBeraBacktest.Rd 2015-05-26 19:53:32 UTC (rev 3650) @@ -0,0 +1,40 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/JarqueBeraBacktest.R +\name{JarqueBeraBacktest} +\alias{JarqueBeraBacktest} +\title{Jarque-Bera backtest for normality.} +\usage{ +JarqueBeraBacktest(sample.skewness, sample.kurtosis, n) +} +\arguments{ +\item{sample.skewness}{Coefficient of Skewness of the sample} + +\item{sample.kurtosis}{Coefficient of Kurtosis of the sample} + +\item{n}{Number of observations} +} +\value{ +Probability of null hypothesis H0 +} +\description{ +Jarque-Bera (JB) is a backtest to test whether the skewness and kurtosis of a +given sample matches that of normal distribution. JB test statistic is +defined as \deqn{JB=\frac{n}{6}\left(s^2+\frac{(k-3)^2}{4}\right)} where +\eqn{n} is sample size, \eqn{s} and \eqn{k} are coefficients of sample +skewness and kurtosis. +} +\examples{ +# JB test statistic for sample with 500 observations with sample + skewness and kurtosis of -0.075 and 2.888 + JarqueBeraBacktest(-0.075,2.888,500) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, Kevin. Measuring Market Risk, Wiley, 2007. + +Jarque, C. M. and Bera, A. K. A test for normality of observations and +regression residuals, International Statistical Review, 55(2): 163-172. +} + Added: pkg/Dowd/man/KSTestStat.Rd =================================================================== --- pkg/Dowd/man/KSTestStat.Rd (rev 0) +++ pkg/Dowd/man/KSTestStat.Rd 2015-05-26 19:53:32 UTC (rev 3650) @@ -0,0 +1,38 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/KSTestStat.R +\name{KSTestStat} +\alias{KSTestStat} +\title{Plots cumulative density for KS test and computes confidence interval for +KS test stat.} +\usage{ +KSTestStat(number.trials, sample.size, confidence.interval) +} +\arguments{ +\item{number.trials}{Number of trials} + +\item{sample.size}{Sizes of the trial samples} + +\item{confidence.interval}{Confidence interval expressed as a fraction of 1} +} +\value{ +Confidence Interval for KS test stat +} +\description{ +Kolmogorov-Smirnov (KS) test statistic is a non parametric test for +distribution equality and measures the maximum distance between two cdfs. +Formally, the KS test statistic is : \deqn{D=\max_i|F(X_i)-\hat{F}(X_i)|} +} +\examples{ +# Plots the cdf for KS Test statistic and returns KS confidence interval + for 100 trials with 1000 sample size and 0.95 confidence interval + KSTestStat(100, 1000, 0.95) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. + +Chakravarti, I. M., Laha, R. G. and Roy, J. Handbook of Methods of #' Applied Statistics, Volume 1, Wiley, 1967. +} + Added: pkg/Dowd/man/KuiperTestStat.Rd =================================================================== --- pkg/Dowd/man/KuiperTestStat.Rd (rev 0) +++ pkg/Dowd/man/KuiperTestStat.Rd 2015-05-26 19:53:32 UTC (rev 3650) @@ -0,0 +1,38 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/KuiperTestStat.R +\name{KuiperTestStat} +\alias{KuiperTestStat} +\title{Plots cummulative density for Kuiper test and computes confidence interval +for Kuiper test stat.} +\usage{ +KuiperTestStat(number.trials, sample.size, confidence.interval) +} +\arguments{ +\item{number.trials}{Number of trials} + +\item{sample.size}{Sizes of the trial samples} + +\item{confidence.interval}{Confidence interval expressed as a fraction of 1} +} +\value{ +Confidence Interval for KS test stat +} +\description{ +Kuiper test statistic is a non parametric test for +distribution equality and is closely related to KS test. Formally, the +Kuiper test statistic is : + \deqn{D*=\max_i\{F(X_i)-\hat{F(x_i)}+\max_i\{\hat{F}(X_i)-F(X_i)\}} +} +\examples{ +# Plots the cdf for Kuiper Test statistic and returns Kuiper confidence + interval for 100 trials with 1000 sample size and 0.95 confidence + interval. + KuiperTestStat(100, 1000, 0.95) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. +} + Added: pkg/Dowd/tests/testthat/testJarqueBeraBacktest.R =================================================================== --- pkg/Dowd/tests/testthat/testJarqueBeraBacktest.R (rev 0) +++ pkg/Dowd/tests/testthat/testJarqueBeraBacktest.R 2015-05-26 19:53:32 UTC (rev 3650) @@ -0,0 +1,5 @@ +test_that("Binomial Backtest Works.",{ + # Success + expect_equal(0.6942, JarqueBeraBacktest(-0.0758, 2.8888, 500), tolerance=0.01) + expect_equal(1, JarqueBeraBacktest(0, 3, 100), tolerance=0.01) +}) \ No newline at end of file From noreply at r-forge.r-project.org Wed May 27 17:41:44 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 27 May 2015 17:41:44 +0200 (CEST) Subject: [Returnanalytics-commits] r3651 - in pkg/Dowd: . R man Message-ID: <20150527154144.3EFD5184777@r-forge.r-project.org> Author: dacharya Date: 2015-05-27 17:41:43 +0200 (Wed, 27 May 2015) New Revision: 3651 Added: pkg/Dowd/R/BlancoIhleBacktest.R pkg/Dowd/man/BlancoIhleBacktest.Rd Modified: pkg/Dowd/NAMESPACE Log: BlancoIhleBacktest: source and documentation. Modified: pkg/Dowd/NAMESPACE =================================================================== --- pkg/Dowd/NAMESPACE 2015-05-26 19:53:32 UTC (rev 3650) +++ pkg/Dowd/NAMESPACE 2015-05-27 15:41:43 UTC (rev 3651) @@ -2,6 +2,9 @@ export(ADTestStat) export(BinomialBacktest) +export(BlancoIhleBacktest) +export(ChristoffersenBacktestForUnconditionalCoverage) export(JarqueBeraBacktest) export(KSTestStat) export(KuiperTestStat) +export(LopezBacktest) Added: pkg/Dowd/R/BlancoIhleBacktest.R =================================================================== --- pkg/Dowd/R/BlancoIhleBacktest.R (rev 0) +++ pkg/Dowd/R/BlancoIhleBacktest.R 2015-05-27 15:41:43 UTC (rev 3651) @@ -0,0 +1,40 @@ +#' Blanco-Ihle forecast evaluation backtest measure +#' +#' Derives the Blanco-Ihle forecast evaluation loss measure for a VaR +#' risk measurement model. +#' +#' @param Ra Vector of a portfolio profit and loss +#' @param Rb Vector of corresponding VaR forecasts +#' @param Rc Vector of corresponding Expected Tailed Loss forecasts +#' @param cl VaR confidence interval +#' @return Something +#' +#' @references Dowd, Kevin. Measuring Market Risk, Wiley, 2007. +#' +#' Blanco, C. and Ihle, G. How Good is Your Var? Using Backtesting to Assess +#' System Performance. Financial Engineering News, 1999. +#' +#' @author Dinesh Acharya +#' @examples +#' # To be added +#' +#' @export +BlancoIhleBacktest <- function(Ra, Rb, Rc, cl){ + + profit.loss <- as.vector(Ra) + VaR <- as.vector(Rb) + ETL <- as.vector(Rc) + + n <- length(profit.loss) + p <- 1-cl + excess.loss <- -profit.loss(-profit.loss>VaR) # Derives excess loss + benchmark <- double(length(excess_loss)) + + for (i in 1:length(excess_loss)){ + benchmark[i] <- (ETL[i]-VaR[i])/Var[i] + score[i] <- (excess.loss[i]-VaR[i])/VaR[i]-benchmark[i] + } + + # First Blanco-Ihle score measure + return((2/n)*sum(score)^2) +} \ No newline at end of file Added: pkg/Dowd/man/BlancoIhleBacktest.Rd =================================================================== --- pkg/Dowd/man/BlancoIhleBacktest.Rd (rev 0) +++ pkg/Dowd/man/BlancoIhleBacktest.Rd 2015-05-27 15:41:43 UTC (rev 3651) @@ -0,0 +1,59 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/BlancoIhleBacktest.R, R/ChristoffersenBacktestForIndependence.R +\name{BlancoIhleBacktest} +\alias{BlancoIhleBacktest} +\title{Blanco-Ihle forecast evaluation backtest measure} +\usage{ +BlancoIhleBacktest(Ra, Rb, cl) + +BlancoIhleBacktest(Ra, Rb, cl) +} +\arguments{ +\item{Ra}{Vector of a portfolio profit and loss} + +\item{Rb}{Vector of corresponding VaR forecasts} + +\item{cl}{VaR confidence interval} + +\item{Rc}{Vector of corresponding Expected Tailed Loss forecasts} + +\item{Ra}{Vector of portfolio profit and loss observations} + +\item{Rb}{Vector of corresponding VaR forecasts} + +\item{cl}{Confidence interval for} +} +\value{ +Something + +Probability that given the data set, the null hypothesis +(i.e. independence) is correct. +} +\description{ +Derives the Blanco-Ihle forecast evaluation loss measure for a VaR +risk measurement model. + +Carries out the Christoffersen backtest of independence for a VaR risk +measurement model, for specified VaR confidence level. +} +\examples{ +# To be added +# To be added +} +\author{ +Dinesh Acharya + +Dinesh Acharya +} +\references{ +Dowd, Kevin. Measuring Market Risk, Wiley, 2007. + +Blanco, C. and Ihle, G. How Good is Your Var? Using Backtesting to Assess +System Performance. Financial Engineering News, 1999. + +Dowd, K. Measuring Market Risk, Wiley, 2007. + +Christoffersen, P. Evaluating Interval Forecasts. International Economic +Review, 39(4), 1992, 841-862. +} + From noreply at r-forge.r-project.org Wed May 27 17:43:37 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 27 May 2015 17:43:37 +0200 (CEST) Subject: [Returnanalytics-commits] r3652 - in pkg/Dowd: R man Message-ID: <20150527154337.25C1A184777@r-forge.r-project.org> Author: dacharya Date: 2015-05-27 17:43:36 +0200 (Wed, 27 May 2015) New Revision: 3652 Added: pkg/Dowd/R/LopezBacktest.R pkg/Dowd/man/LopezBacktest.Rd Log: LopezBacktest: source and documentation. Added: pkg/Dowd/R/LopezBacktest.R =================================================================== --- pkg/Dowd/R/LopezBacktest.R (rev 0) +++ pkg/Dowd/R/LopezBacktest.R 2015-05-27 15:43:36 UTC (rev 3652) @@ -0,0 +1,37 @@ +#' First (binomial) Lopez forecast evaluation backtest score measure +#' +#' Derives the first Lopez (i.e. binomial) forecast evaluation score +#' for a VaR risk measurement model. +#' +#' @param Ra Vector of portfolio of profit loss distribution +#' @param Rb Vector of corresponding VaR forecasts +#' @param cl VaR confidence level +#' @return Something +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' Lopez, J. A. Methods for Evaluating Value-at-Risk Estimates. Federal Reserve +#' Bank of New York Economic Policy Review, 1998, p. 121. +#' +#' Lopez, J. A. Regulatory Evaluations of Value-at-Risk Models. Journal of Risk +#' 1999, 37-64. +#' +#' @author Dinesh Acharya +#' @examples +#' # To be added +#' +#' @export +LopezBacktest <- function(Ra, Rb, cl){ + + profit.loss <- as.vector(Ra) + VaR <- as.vector(Rb) + + n <- length(profit.loss) + p <- 1-cl + excess.loss <- profit.loss-VaR # Derives excess loss + excess.loss <- excess.loss[excess.loss>0] # Gets rid of non-positive excess + x <- length(excess.loss) # Score for each positive excess loss observation + y <- (2/n)*sum(x-n*p)^2 # Score measure + return(y) + +} \ No newline at end of file Added: pkg/Dowd/man/LopezBacktest.Rd =================================================================== --- pkg/Dowd/man/LopezBacktest.Rd (rev 0) +++ pkg/Dowd/man/LopezBacktest.Rd 2015-05-27 15:43:36 UTC (rev 3652) @@ -0,0 +1,38 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/LopezBacktest.R +\name{LopezBacktest} +\alias{LopezBacktest} +\title{First (binomial) Lopez forecast evaluation backtest score measure} +\usage{ +LopezBacktest(Ra, Rb, cl) +} +\arguments{ +\item{Ra}{Vector of portfolio of profit loss distribution} + +\item{Rb}{Vector of corresponding VaR forecasts} + +\item{cl}{VaR confidence level} +} +\value{ +Something +} +\description{ +Derives the first Lopez (i.e. binomial) forecast evaluation score +for a VaR risk measurement model. +} +\examples{ +# To be added +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. + +Lopez, J. A. Methods for Evaluating Value-at-Risk Estimates. Federal Reserve +Bank of New York Economic Policy Review, 1998, p. 121. + +Lopez, J. A. Regulatory Evaluations of Value-at-Risk Models. Journal of Risk +1999, 37-64. +} + From noreply at r-forge.r-project.org Wed May 27 17:49:03 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 27 May 2015 17:49:03 +0200 (CEST) Subject: [Returnanalytics-commits] r3653 - in pkg/Dowd: R man Message-ID: <20150527154903.6341D187930@r-forge.r-project.org> Author: dacharya Date: 2015-05-27 17:49:03 +0200 (Wed, 27 May 2015) New Revision: 3653 Added: pkg/Dowd/R/ChristoffersenBacktestForIndependence.R pkg/Dowd/R/ChristoffersenBacktestForUnconditionalCoverage.R pkg/Dowd/man/ChristoffersenBacktestForUnconditionalCoverage.Rd Log: Christoffersen Backtests: source and documentation. Added: pkg/Dowd/R/ChristoffersenBacktestForIndependence.R =================================================================== --- pkg/Dowd/R/ChristoffersenBacktestForIndependence.R (rev 0) +++ pkg/Dowd/R/ChristoffersenBacktestForIndependence.R 2015-05-27 15:49:03 UTC (rev 3653) @@ -0,0 +1,67 @@ +#' Christoffersen Backtest for Independence +#' +#' Carries out the Christoffersen backtest of independence for a VaR risk +#' measurement model, for specified VaR confidence level. +#' +#' @param Ra Vector of portfolio profit and loss observations +#' @param Rb Vector of corresponding VaR forecasts +#' @param cl Confidence interval for +#' @return Probability that given the data set, the null hypothesis +#' (i.e. independence) is correct. +#' +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' Christoffersen, P. Evaluating Interval Forecasts. International Economic +#' Review, 39(4), 1992, 841-862. +#' +#' @author Dinesh Acharya +#' @examples +#' # To be added +#' +#' @export +BlancoIhleBacktest <- function(Ra, Rb, cl){ + + profit.loss <- as.vector(Ra) + VaR <- as.vector(Ra) + + n <- length(profit.loss) + p <- 1-cl + excess.loss <- -profit.loss-VaR # Derives excess loss + excess.loss <- excess.loss[excess.loss>0] # Gets rid of negative or zeros + ########################################## + # Read Documentation/Alternative Implementation. + # VaR <- VaR[excess.loss>0] + ########################################## + t00 <- 0 + t01 <- 0 + t10 <- 0 + t11 <- 0 + for (i in 2:n){ + if(excess.loss[i]<=0){ + if(excess.loss[i-1]<=0){ + t00 <- t00+1; + } else { + t10 <- t10+1 + } + } else { + if(excess.loss[i-1]<=0){ + t01 <- t01+1 + } else { + t11 <- t11+1 + } + } + } + + # Recover pie terms + pie0 <- t01/(t00+t01) + pie1 <- t11/(t10+t11) + + # Likelihood ratio test statistic + LR=-2*log((((1-p)^(T00+T10))*(p^(T01+T11)))+2*log((((1-pie0)^T00))*(pie0^T01)*((1-pie1)^(T10))*pie1^T11)) + + # Probability that null hypothesis (independence is correct) + y <- 1-pchisq(LR,1) + return(y) + +} \ No newline at end of file Added: pkg/Dowd/R/ChristoffersenBacktestForUnconditionalCoverage.R =================================================================== --- pkg/Dowd/R/ChristoffersenBacktestForUnconditionalCoverage.R (rev 0) +++ pkg/Dowd/R/ChristoffersenBacktestForUnconditionalCoverage.R 2015-05-27 15:49:03 UTC (rev 3653) @@ -0,0 +1,37 @@ +#' Christoffersen Backtest for Unconditional Coverage +#' +#' Carries out the Christiffersen backtest for unconditional coverage for a +#' VaR risk measurement model, for specified VaR confidence level. +#' +#' @param Ra Vector of portfolio profit and loss observations +#' @param Rb Vector of VaR forecasts corresponding to PandL observations +#' @param cl Confidence level for VaR +#' @return Probability, given the data set, that the null hypothesis (i.e. +#' a correct model) is correct. +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' Christoffersen, P. Evaluating interval forecasts. International Economic +#' Review, 39(4), 1998, 841-862. +#' +#' @author Dinesh Acharya +#' @examples +#' # To be added +#' +#' @export +ChristoffersenBacktestForUnconditionalCoverage <- function(Ra, Rb, cl){ + + profit.loss <- as.vector(Ra) + VaR <- as.vector(Rb) + + n <- length(profit.loss) # Number of observations + p <- 1-cl # Probability of failure under null hypothesis + v <- length(which(VaR+profit.loss<0)) # Frequency of failures + + # Likelihood ratio test statistic + LR <- -2*log(((p^x)*(1-p)^(n-x))/((phat^x)*((1-phat)^(n-x)))) + + # Probability that null hypothesis (model) is correct + return(1-pchisq(LR,1)) + +} \ No newline at end of file Added: pkg/Dowd/man/ChristoffersenBacktestForUnconditionalCoverage.Rd =================================================================== --- pkg/Dowd/man/ChristoffersenBacktestForUnconditionalCoverage.Rd (rev 0) +++ pkg/Dowd/man/ChristoffersenBacktestForUnconditionalCoverage.Rd 2015-05-27 15:49:03 UTC (rev 3653) @@ -0,0 +1,36 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/ChristoffersenBacktestForUnconditionalCoverage.R +\name{ChristoffersenBacktestForUnconditionalCoverage} +\alias{ChristoffersenBacktestForUnconditionalCoverage} +\title{Christoffersen Backtest for Unconditional Coverage} +\usage{ +ChristoffersenBacktestForUnconditionalCoverage(Ra, Rb, cl) +} +\arguments{ +\item{Ra}{Vector of portfolio profit and loss observations} + +\item{Rb}{Vector of VaR forecasts corresponding to PandL observations} + +\item{cl}{Confidence level for VaR} +} +\value{ +Probability, given the data set, that the null hypothesis (i.e. +a correct model) is correct. +} +\description{ +Carries out the Christiffersen backtest for unconditional coverage for a +VaR risk measurement model, for specified VaR confidence level. +} +\examples{ +# To be added +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. + +Christoffersen, P. Evaluating interval forecasts. International Economic +Review, 39(4), 1998, 841-862. +} + From noreply at r-forge.r-project.org Wed May 27 18:59:27 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 27 May 2015 18:59:27 +0200 (CEST) Subject: [Returnanalytics-commits] r3654 - pkg/Dowd Message-ID: <20150527165927.2DE6C186CF4@r-forge.r-project.org> Author: dacharya Date: 2015-05-27 18:59:26 +0200 (Wed, 27 May 2015) New Revision: 3654 Added: pkg/Dowd/readme.txt Log: readme file added. Added: pkg/Dowd/readme.txt =================================================================== --- pkg/Dowd/readme.txt (rev 0) +++ pkg/Dowd/readme.txt 2015-05-27 16:59:26 UTC (rev 3654) @@ -0,0 +1,17 @@ +#*************************************************************** +# Jarque-Bera Test: +# It has to be checked Probability of null (H0) or (H1). +# (http://stats.stackexchange.com/questions/130368/why-do-i-get-this-p-value-doing-the-jarque-bera-test-in-r) +#*************************************************************** +# Christofferson Backtest for Independence: +# VaR(excess_loss<=0)=[]; Does not make sense. It is still to be checked if it is as intended. +# if(excess.loss[i-1]<=0) if condition incomplete statement. +#*************************************************************** +# Tests/Examples for profit.loss distribution and corresponding VaR and ETL +# still needs to be completed. Around 4 in Backtest do not have examples. +# It still has to be completed. +#*************************************************************** +# Lopez Backtest: +# In Christofferson , excess.loss is defined as -profit.loss-VaR +# But in Lopez Backtest, profit.loss-VaR is used. It has to be checked. +#*************************************************************** \ No newline at end of file From noreply at r-forge.r-project.org Wed May 27 21:05:09 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 27 May 2015 21:05:09 +0200 (CEST) Subject: [Returnanalytics-commits] r3655 - in pkg/Dowd: . R man Message-ID: <20150527190509.3B6D31876C8@r-forge.r-project.org> Author: dacharya Date: 2015-05-27 21:05:08 +0200 (Wed, 27 May 2015) New Revision: 3655 Added: pkg/Dowd/man/ChristoffersenBacktestForIndependence.Rd Modified: pkg/Dowd/NAMESPACE pkg/Dowd/R/BlancoIhleBacktest.R pkg/Dowd/R/ChristoffersenBacktestForIndependence.R pkg/Dowd/R/ChristoffersenBacktestForUnconditionalCoverage.R pkg/Dowd/R/LopezBacktest.R pkg/Dowd/man/BlancoIhleBacktest.Rd pkg/Dowd/man/ChristoffersenBacktestForUnconditionalCoverage.Rd pkg/Dowd/man/LopezBacktest.Rd Log: Bugs removed from 4 new functions added today. Modified: pkg/Dowd/NAMESPACE =================================================================== --- pkg/Dowd/NAMESPACE 2015-05-27 16:59:26 UTC (rev 3654) +++ pkg/Dowd/NAMESPACE 2015-05-27 19:05:08 UTC (rev 3655) @@ -3,6 +3,7 @@ export(ADTestStat) export(BinomialBacktest) export(BlancoIhleBacktest) +export(ChristoffersenBacktestForIndependence) export(ChristoffersenBacktestForUnconditionalCoverage) export(JarqueBeraBacktest) export(KSTestStat) Modified: pkg/Dowd/R/BlancoIhleBacktest.R =================================================================== --- pkg/Dowd/R/BlancoIhleBacktest.R 2015-05-27 16:59:26 UTC (rev 3654) +++ pkg/Dowd/R/BlancoIhleBacktest.R 2015-05-27 19:05:08 UTC (rev 3655) @@ -16,7 +16,13 @@ #' #' @author Dinesh Acharya #' @examples -#' # To be added +#' +#' # Has to be modified with appropriate data: +#' # Christoffersen Backtest For Independence for given parameters +#' a <- rnorm(1*100) +#' b <- abs(rnorm(1*100))+2 +#' c <- abs(rnorm(1*100))+2 +#' BlancoIhleBacktest(a, b, c, 0.95) #' #' @export BlancoIhleBacktest <- function(Ra, Rb, Rc, cl){ @@ -27,14 +33,17 @@ n <- length(profit.loss) p <- 1-cl - excess.loss <- -profit.loss(-profit.loss>VaR) # Derives excess loss - benchmark <- double(length(excess_loss)) + excess.loss <- -profit.loss[-profit.loss>VaR] # Derives excess loss + m <- length(excess.loss) - for (i in 1:length(excess_loss)){ - benchmark[i] <- (ETL[i]-VaR[i])/Var[i] + benchmark <- double(m) + score <- double(m) + for (i in 1:m){ + benchmark[i] <- (ETL[i]-VaR[i])/VaR[i] score[i] <- (excess.loss[i]-VaR[i])/VaR[i]-benchmark[i] } # First Blanco-Ihle score measure - return((2/n)*sum(score)^2) + y <- (2/n)*sum(score)^2 + return(y) } \ No newline at end of file Modified: pkg/Dowd/R/ChristoffersenBacktestForIndependence.R =================================================================== --- pkg/Dowd/R/ChristoffersenBacktestForIndependence.R 2015-05-27 16:59:26 UTC (rev 3654) +++ pkg/Dowd/R/ChristoffersenBacktestForIndependence.R 2015-05-27 19:05:08 UTC (rev 3655) @@ -16,11 +16,17 @@ #' Review, 39(4), 1992, 841-862. #' #' @author Dinesh Acharya +#' @author Dinesh Acharya #' @examples -#' # To be added +#' +#' # Has to be modified with appropriate data: +#' # Christoffersen Backtest For Independence for given parameters +#' a <- rnorm(1*100) +#' b <- abs(rnorm(1*100))+2 +#' ChristoffersenBacktestForIndependence(a, b, 0.95) #' #' @export -BlancoIhleBacktest <- function(Ra, Rb, cl){ +ChristoffersenBacktestForIndependence <- function(Ra, Rb, cl){ profit.loss <- as.vector(Ra) VaR <- as.vector(Ra) @@ -30,17 +36,17 @@ excess.loss <- -profit.loss-VaR # Derives excess loss excess.loss <- excess.loss[excess.loss>0] # Gets rid of negative or zeros ########################################## - # Read Documentation/Alternative Implementation. + # There are mistakes in original code and needs to be addressed. # VaR <- VaR[excess.loss>0] ########################################## t00 <- 0 t01 <- 0 t10 <- 0 t11 <- 0 - for (i in 2:n){ + for (i in 2:length(excess.loss)){ if(excess.loss[i]<=0){ if(excess.loss[i-1]<=0){ - t00 <- t00+1; + t00 <- t00+1 } else { t10 <- t10+1 } @@ -58,7 +64,7 @@ pie1 <- t11/(t10+t11) # Likelihood ratio test statistic - LR=-2*log((((1-p)^(T00+T10))*(p^(T01+T11)))+2*log((((1-pie0)^T00))*(pie0^T01)*((1-pie1)^(T10))*pie1^T11)) + LR=-2*log((((1-p)^(t00+t10))*(p^(t01+t11)))+2*log((((1-pie0)^t00))*(pie0^t01)*((1-pie1)^(t10))*pie1^t11)) # Probability that null hypothesis (independence is correct) y <- 1-pchisq(LR,1) Modified: pkg/Dowd/R/ChristoffersenBacktestForUnconditionalCoverage.R =================================================================== --- pkg/Dowd/R/ChristoffersenBacktestForUnconditionalCoverage.R 2015-05-27 16:59:26 UTC (rev 3654) +++ pkg/Dowd/R/ChristoffersenBacktestForUnconditionalCoverage.R 2015-05-27 19:05:08 UTC (rev 3655) @@ -16,7 +16,12 @@ #' #' @author Dinesh Acharya #' @examples -#' # To be added +#' +#' # Has to be modified with appropriate data: +#' # Christoffersen Backtest For Unconditional Coverage for given parameters +#' a <- rnorm(1*100) +#' b <- abs(rnorm(1*100))+2 +#' ChristoffersenBacktestForUnconditionalCoverage(a, b, 0.95) #' #' @export ChristoffersenBacktestForUnconditionalCoverage <- function(Ra, Rb, cl){ @@ -26,8 +31,8 @@ n <- length(profit.loss) # Number of observations p <- 1-cl # Probability of failure under null hypothesis - v <- length(which(VaR+profit.loss<0)) # Frequency of failures - + x <- length(which(VaR+profit.loss<0)) # Number of Failures + phat <- x/n # Frequency of Failures # Likelihood ratio test statistic LR <- -2*log(((p^x)*(1-p)^(n-x))/((phat^x)*((1-phat)^(n-x)))) Modified: pkg/Dowd/R/LopezBacktest.R =================================================================== --- pkg/Dowd/R/LopezBacktest.R 2015-05-27 16:59:26 UTC (rev 3654) +++ pkg/Dowd/R/LopezBacktest.R 2015-05-27 19:05:08 UTC (rev 3655) @@ -18,7 +18,12 @@ #' #' @author Dinesh Acharya #' @examples -#' # To be added +#' +#' # Has to be modified with appropriate data: +#' # LopezBacktest for given parameters +#' a <- rnorm(1*100) +#' b <- abs(rnorm(1*100))+2 +#' LopezBacktest(a, b, 0.95) #' #' @export LopezBacktest <- function(Ra, Rb, cl){ Modified: pkg/Dowd/man/BlancoIhleBacktest.Rd =================================================================== --- pkg/Dowd/man/BlancoIhleBacktest.Rd 2015-05-27 16:59:26 UTC (rev 3654) +++ pkg/Dowd/man/BlancoIhleBacktest.Rd 2015-05-27 19:05:08 UTC (rev 3655) @@ -1,59 +1,42 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/BlancoIhleBacktest.R, R/ChristoffersenBacktestForIndependence.R +% Please edit documentation in R/BlancoIhleBacktest.R \name{BlancoIhleBacktest} \alias{BlancoIhleBacktest} \title{Blanco-Ihle forecast evaluation backtest measure} \usage{ -BlancoIhleBacktest(Ra, Rb, cl) - -BlancoIhleBacktest(Ra, Rb, cl) +BlancoIhleBacktest(Ra, Rb, Rc, cl) } \arguments{ \item{Ra}{Vector of a portfolio profit and loss} \item{Rb}{Vector of corresponding VaR forecasts} -\item{cl}{VaR confidence interval} - \item{Rc}{Vector of corresponding Expected Tailed Loss forecasts} -\item{Ra}{Vector of portfolio profit and loss observations} - -\item{Rb}{Vector of corresponding VaR forecasts} - -\item{cl}{Confidence interval for} +\item{cl}{VaR confidence interval} } \value{ Something - -Probability that given the data set, the null hypothesis -(i.e. independence) is correct. } \description{ Derives the Blanco-Ihle forecast evaluation loss measure for a VaR risk measurement model. - -Carries out the Christoffersen backtest of independence for a VaR risk -measurement model, for specified VaR confidence level. } \examples{ -# To be added -# To be added +# Has to be modified with appropriate data: + # Christoffersen Backtest For Independence for given parameters + a <- rnorm(1*100) + b <- abs(rnorm(1*100))+2 + c <- abs(rnorm(1*100))+2 + BlancoIhleBacktest(a, b, c, 0.95) } \author{ Dinesh Acharya - -Dinesh Acharya } \references{ Dowd, Kevin. Measuring Market Risk, Wiley, 2007. Blanco, C. and Ihle, G. How Good is Your Var? Using Backtesting to Assess System Performance. Financial Engineering News, 1999. - -Dowd, K. Measuring Market Risk, Wiley, 2007. - -Christoffersen, P. Evaluating Interval Forecasts. International Economic -Review, 39(4), 1992, 841-862. } Added: pkg/Dowd/man/ChristoffersenBacktestForIndependence.Rd =================================================================== --- pkg/Dowd/man/ChristoffersenBacktestForIndependence.Rd (rev 0) +++ pkg/Dowd/man/ChristoffersenBacktestForIndependence.Rd 2015-05-27 19:05:08 UTC (rev 3655) @@ -0,0 +1,42 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/ChristoffersenBacktestForIndependence.R +\name{ChristoffersenBacktestForIndependence} +\alias{ChristoffersenBacktestForIndependence} +\title{Christoffersen Backtest for Independence} +\usage{ +ChristoffersenBacktestForIndependence(Ra, Rb, cl) +} +\arguments{ +\item{Ra}{Vector of portfolio profit and loss observations} + +\item{Rb}{Vector of corresponding VaR forecasts} + +\item{cl}{Confidence interval for} +} +\value{ +Probability that given the data set, the null hypothesis +(i.e. independence) is correct. +} +\description{ +Carries out the Christoffersen backtest of independence for a VaR risk +measurement model, for specified VaR confidence level. +} +\examples{ +# Has to be modified with appropriate data: + # Christoffersen Backtest For Independence for given parameters + a <- rnorm(1*100) + b <- abs(rnorm(1*100))+2 + ChristoffersenBacktestForIndependence(a, b, 0.95) +} +\author{ +Dinesh Acharya + +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. + +Christoffersen, P. Evaluating Interval Forecasts. International Economic +Review, 39(4), 1992, 841-862. +} + Modified: pkg/Dowd/man/ChristoffersenBacktestForUnconditionalCoverage.Rd =================================================================== --- pkg/Dowd/man/ChristoffersenBacktestForUnconditionalCoverage.Rd 2015-05-27 16:59:26 UTC (rev 3654) +++ pkg/Dowd/man/ChristoffersenBacktestForUnconditionalCoverage.Rd 2015-05-27 19:05:08 UTC (rev 3655) @@ -22,7 +22,11 @@ VaR risk measurement model, for specified VaR confidence level. } \examples{ -# To be added +# Has to be modified with appropriate data: + # Christoffersen Backtest For Unconditional Coverage for given parameters + a <- rnorm(1*100) + b <- abs(rnorm(1*100))+2 + ChristoffersenBacktestForUnconditionalCoverage(a, b, 0.95) } \author{ Dinesh Acharya Modified: pkg/Dowd/man/LopezBacktest.Rd =================================================================== --- pkg/Dowd/man/LopezBacktest.Rd 2015-05-27 16:59:26 UTC (rev 3654) +++ pkg/Dowd/man/LopezBacktest.Rd 2015-05-27 19:05:08 UTC (rev 3655) @@ -21,7 +21,11 @@ for a VaR risk measurement model. } \examples{ -# To be added +# Has to be modified with appropriate data: + # LopezBacktest for given parameters + a <- rnorm(1*100) + b <- abs(rnorm(1*100))+2 + LopezBacktest(a, b, 0.95) } \author{ Dinesh Acharya From noreply at r-forge.r-project.org Thu May 28 23:14:29 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 28 May 2015 23:14:29 +0200 (CEST) Subject: [Returnanalytics-commits] r3656 - in pkg/Dowd: . R man Message-ID: <20150528211429.D07E81877D4@r-forge.r-project.org> Author: dacharya Date: 2015-05-28 23:14:29 +0200 (Thu, 28 May 2015) New Revision: 3656 Added: pkg/Dowd/R/BootstrapES.R pkg/Dowd/R/HSES.R pkg/Dowd/R/HSVaR.R pkg/Dowd/man/BootstrapES.Rd pkg/Dowd/man/HSES.Rd pkg/Dowd/man/HSVaR.Rd Modified: pkg/Dowd/NAMESPACE pkg/Dowd/readme.txt Log: BootstrapES, HSES and HSVaR: source and documentation Modified: pkg/Dowd/NAMESPACE =================================================================== --- pkg/Dowd/NAMESPACE 2015-05-27 19:05:08 UTC (rev 3655) +++ pkg/Dowd/NAMESPACE 2015-05-28 21:14:29 UTC (rev 3656) @@ -3,8 +3,11 @@ export(ADTestStat) export(BinomialBacktest) export(BlancoIhleBacktest) +export(BootstrapES) export(ChristoffersenBacktestForIndependence) export(ChristoffersenBacktestForUnconditionalCoverage) +export(HSES) +export(HSVaR) export(JarqueBeraBacktest) export(KSTestStat) export(KuiperTestStat) Added: pkg/Dowd/R/BootstrapES.R =================================================================== --- pkg/Dowd/R/BootstrapES.R (rev 0) +++ pkg/Dowd/R/BootstrapES.R 2015-05-28 21:14:29 UTC (rev 3656) @@ -0,0 +1,60 @@ +#' Bootstrapped ES for specified confidence level +#' +#' Estimates the bootstrapped ES for confidence level and holding period +#' implied by data frequency. +#' +#' @param Ra Vector corresponding to profit and loss distribution +#' @param number.sample Number of samples to be taken in bootstrap procedure +#' @return cl Number corresponding to Value at Risk confidence level +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # Estimates bootstrapped Es for given parameters +#' a <- rnorm(100) # generate a random profit/loss vector +#' BootstrappedES(a, 50, 0.95) +#' +#' @export +BootstrapES <- function(Ra, number.sample, cl){ + + if (nargs() < 3){ + error("Too few arguments") + } + if (nargs() > 3){ + error("Too many arguments") + } + + profit.loss.data <- as.vector(Ra) + # Preprocess data + unsorted.loss.data <- -profit.loss.data + losses.data <- sort(unsorted.loss.data) + n <- length(losses.data) + + # Check that inputs have correct dimensions + if (length(cl) != 1) { + error("Confidence level must be a scalar") + } + if (length(number.samples) != 1){ + error("Number of resamples must be a scalar"); + } + + # Check that inputs obey sign and value restrictions + if (cl >= 1){ + stop("Confidence level must be less that 1") + } + if (number.resamples <= 0){ + stop("Number of resamples must be at least 0") + } + + ############################################# + # suitable alternative to bootstrp in R is still to be explored. + ############################################# + # ES estimation + # + # es <- bootstrp(number.resamples, "hses", losses.data, cl) + # y <- mean(es) + # return (y) +} \ No newline at end of file Added: pkg/Dowd/R/HSES.R =================================================================== --- pkg/Dowd/R/HSES.R (rev 0) +++ pkg/Dowd/R/HSES.R 2015-05-28 21:14:29 UTC (rev 3656) @@ -0,0 +1,108 @@ +#' Expected Shortfall of a portfolio using Historical Estimator +#' +#' Estimates the Expected Shortfall (aka. Average Value at Risk or Conditional +#' Value at Risk) using historical estimator approach for the specified +#' confidence level and the holding period implies by data frequency. +#' +#' @param Ra Vector corresponding to profit and loss distribution +#' @param cl Number between 0 and 1 corresponding to confidence level +#' @return Expected Shortfall of the portfolio +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' Cont, R., Deguest, R. and Scandolo, G. Robustness and sensitivity analysis +#' of risk measurement procedures. Quantitative Finance, 10(6), 2010, 593-606. +#' +#' Acerbi, C. and Tasche, D. On the coherence of Expected Shortfall. Journal +#' of Banking and Finance, 26(7), 2002, 1487-1503 +#' +#' Artzner, P., Delbaen, F., Eber, J.M. and Heath, D. Coherent Risk Measures +#' of Risk. Mathematical Finance 9(3), 1999, 203. +#' +#' F?llmer, H. and Scheid, A. Stochastic Finance: An Introduction in Discrete +#' Time. De Gryuter, 2011. +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # Computes Historical Expected Shortfall for a given profit/loss +#' # distribution and confidence level +#' a <- rnorm(100) # generate a random profit/loss vector +#' HSES(a, 0.95) +#' +#' @export +HSES <- function(Ra, cl){ + + if (nargs() < 2) { + stop("Too few arguments") + } + + if (nargs() > 2) { + stop("Too many arguments") + } + + + if (nargs() == 2) { + profit.loss.data <- as.vector(Ra) + unsorted.loss.data <- -profit.loss.data # Derives L/P data from input P/L + losses.data <- sort(unsorted.loss.data) # Puts losses in ascending order + n <- length(losses.data) + } + + # Check that inputs have correct dimensions + if (length(cl) != 1) { + stop('Confidence level must be scalar (length-1 vector in R)') + } + + + # Check that inputs obey sign and value restrictions + if (cl >= 1) { + stop("Confidence level must be less than 1.") + } + if (cl <= 0) { + stop("Confidence level must be positive") + } + + index <- n*cl # This putative index value may or may not be an integer + + # Each case needs to be considered in turn + # If index value is an integegr, VaR follows immediately and then we + # estimate ES + if (index-round(index)==0){ + var <- losses.data[index] # Historical Value at Risk + k <- which[var <= losses.data] # Finds indices of tail loss data + tail.losses <- losses.data[k] # Creates data set of tail loss observations + es <- mean(tail.losses) # Expected Shortfall + y <- es + } + + # If index not an integer, take VaR as linear interpolation of loss + # observationsjust above and "below" true VaR and take Expected Shortfall + # as linear interpolation of corresponding upper and lower Expected Shortfall + if (index-round(index) != 0){ + # Deal with loss + upper.index <- ceiling(index) + upper.var <- losses.data(upper.index) # Upper VaR + upper.k <- which(upper.var<=losses.data) # Finds indices of upper tail loss data + upper.tail.losses <- losses.data(upper.k) # Creates data set of upper tail loss obs. + lower.es <- mean(lower.tail.losses) # Lower Expected Shortfall (ES) + # If lower and upper indices are the same, ES is upper ES + if (upper.index == lower.index){ + y <- upper.es + } + # If lower and upper indices are different, ES is weighted average of + # upper and lower ESs + if (upper.index!=lower.index) { + # Weights attached to upper and lower ESs + lower.weight <- (upper.index-index)/(upper.index-lower.index) + upper.weight <- (index-lower.index)/(upper.index-lower.index) + # Finally, the weighted, ES as a linear interpolation of upper and lower + # ESs + y <- lower.weight*lower.es+upper.weight*upper.es + + } + return(y) + } + +} + Added: pkg/Dowd/R/HSVaR.R =================================================================== --- pkg/Dowd/R/HSVaR.R (rev 0) +++ pkg/Dowd/R/HSVaR.R 2015-05-28 21:14:29 UTC (rev 3656) @@ -0,0 +1,106 @@ +#' Value at Risk of a portfolio using Historical Estimator +#' +#' Estimates the Value at Risk (VaR) using historical estimator +#' approach for the specified range of confidence levels and the holding +#' period implies by data frequency. +#' +#' @param Ra Vector corresponding to profit and loss distribution +#' @param Rb Vector corresponding to VaR confidence levels. +#' @return Value at Risk of the portfolio +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' Jorion, P. Value at Risk: The New Benchmark for Managing Financial Risk. +#' McGraw-Hill, 2006 +#' +#' Cont, R., Deguest, R. and Scandolo, G. Robustness and sensitivity analysis +#' of risk measurement procedures. Quantitative Finance, 10(6), 2010, 593-606. +#' +#' Artzner, P., Delbaen, F., Eber, J.M. and Heath, D. Coherent Risk Measures +#' of Risk. Mathematical Finance 9(3), 1999, 203. +#' +#' F?llmer, H. and Scheid, A. Stochastic Finance: An Introduction in Discrete +#' Time. De Gryuter, 2011. +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # To be added. +#' +#' @export +HSVaR <- function(Ra, Rb){ + + # Determine if there are two arguments and ensure that they are read as + # intended + if (nargs() < 2) { + stop("Too few arguments") + } + + if (nargs() > 2) { + stop("Too many arguments") + } + + + if (nargs() == 2) { + profit.loss.data <- as.vector(Ra) + cl <- as.vector(Rb) + unsorted.loss.data <- -profit.loss.data # Derives L/P data from input P/L + losses.data <- sort(unsorted.loss.data) # Puts losses in ascending order + n <- length(losses.data) + } + + # Check that inputs have correct dimensions + if (is.vector(Rb)) { + stop("Confidence level must be a vector") + } + + + # Check that inputs obey sign and value restrictions + if (max(cl) >= 1) { + stop("Confidence level must be less than 1.") + } + if (max(cl) <= 0) { + stop("Confidence level must be positive") + } + + i <- 1:length(cl) + index <- cl*n # This putative index value may or may not be an integer + + # If index value is an integer, VaR follows immediately + y <- double(length(i)) + if (index-round[index] == 0){ + y[i] <- losses.data[index] + } + + # If index not an integer, take VaR as linear interpolation of loss + # observations just above and below "true" VaR + + if (index-round(index)!=0){ + # Deal with loss observation just above VaR + upper.index <- ceiling(index) + upper.var <- losses.data[upper.index] # Loss observation just above VaR or upper VaR + + # Deal with loss observation just below VaR + lower.index <- floor(index) + lower.var <- losses.data[lower.index] # Loss observation just below VaR or lower VaR + + # If lower and upper indices are the same ,VaR is upper VaR + if (upper.index==lower.index){ + y <- upper.var + } + + # If lower and upper indices different, VaR is weighted average of upper + # and lower VaRs + if (upper.index!=lower.index){ + # Weights attached to upper and lower VaRs + lower.weight <- (upper.index-index)/(upper.index-lower.index) # weight on upper.var + + # Finally, the weighted, VaR as a linear interpolation of upper and lower VaRs + + y <- lower.weight * lower.var + upper.weight * upper.var + + } + + } + return(y) +} \ No newline at end of file Added: pkg/Dowd/man/BootstrapES.Rd =================================================================== --- pkg/Dowd/man/BootstrapES.Rd (rev 0) +++ pkg/Dowd/man/BootstrapES.Rd 2015-05-28 21:14:29 UTC (rev 3656) @@ -0,0 +1,32 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/BootstrapES.R +\name{BootstrapES} +\alias{BootstrapES} +\title{Bootstrapped ES for specified confidence level} +\usage{ +BootstrapES(Ra, number.sample, cl) +} +\arguments{ +\item{Ra}{Vector corresponding to profit and loss distribution} + +\item{number.sample}{Number of samples to be taken in bootstrap procedure} +} +\value{ +cl Number corresponding to Value at Risk confidence level +} +\description{ +Estimates the bootstrapped ES for confidence level and holding period +implied by data frequency. +} +\examples{ +# Estimates bootstrapped Es for given parameters + a <- rnorm(100) # generate a random profit/loss vector + BootstrappedES(a, 50, 0.95) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. +} + Added: pkg/Dowd/man/HSES.Rd =================================================================== --- pkg/Dowd/man/HSES.Rd (rev 0) +++ pkg/Dowd/man/HSES.Rd 2015-05-28 21:14:29 UTC (rev 3656) @@ -0,0 +1,46 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/HSES.R +\name{HSES} +\alias{HSES} +\title{Expected Shortfall of a portfolio using Historical Estimator} +\usage{ +HSES(Ra, cl) +} +\arguments{ +\item{Ra}{Vector corresponding to profit and loss distribution} + +\item{cl}{Number between 0 and 1 corresponding to confidence level} +} +\value{ +Expected Shortfall of the portfolio +} +\description{ +Estimates the Expected Shortfall (aka. Average Value at Risk or Conditional +Value at Risk) using historical estimator approach for the specified +confidence level and the holding period implies by data frequency. +} +\examples{ +# Computes Historical Expected Shortfall for a given profit/loss + # distribution and confidence level + a <- rnorm(100) # generate a random profit/loss vector + HSES(a, 0.95) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. + +Cont, R., Deguest, R. and Scandolo, G. Robustness and sensitivity analysis +of risk measurement procedures. Quantitative Finance, 10(6), 2010, 593-606. + +Acerbi, C. and Tasche, D. On the coherence of Expected Shortfall. Journal +of Banking and Finance, 26(7), 2002, 1487-1503 + +Artzner, P., Delbaen, F., Eber, J.M. and Heath, D. Coherent Risk Measures +of Risk. Mathematical Finance 9(3), 1999, 203. + +F?llmer, H. and Scheid, A. Stochastic Finance: An Introduction in Discrete +Time. De Gryuter, 2011. +} + Added: pkg/Dowd/man/HSVaR.Rd =================================================================== --- pkg/Dowd/man/HSVaR.Rd (rev 0) +++ pkg/Dowd/man/HSVaR.Rd 2015-05-28 21:14:29 UTC (rev 3656) @@ -0,0 +1,43 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/HSVaR.R +\name{HSVaR} +\alias{HSVaR} +\title{Value at Risk of a portfolio using Historical Estimator} +\usage{ +HSVaR(Ra, Rb) +} +\arguments{ +\item{Ra}{Vector corresponding to profit and loss distribution} + +\item{Rb}{Vector corresponding to VaR confidence levels.} +} +\value{ +Value at Risk of the portfolio +} +\description{ +Estimates the Value at Risk (VaR) using historical estimator +approach for the specified range of confidence levels and the holding +period implies by data frequency. +} +\examples{ +# To be added. +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. + +Jorion, P. Value at Risk: The New Benchmark for Managing Financial Risk. +McGraw-Hill, 2006 + +Cont, R., Deguest, R. and Scandolo, G. Robustness and sensitivity analysis +of risk measurement procedures. Quantitative Finance, 10(6), 2010, 593-606. + +Artzner, P., Delbaen, F., Eber, J.M. and Heath, D. Coherent Risk Measures +of Risk. Mathematical Finance 9(3), 1999, 203. + +F?llmer, H. and Scheid, A. Stochastic Finance: An Introduction in Discrete +Time. De Gryuter, 2011. +} + Modified: pkg/Dowd/readme.txt =================================================================== --- pkg/Dowd/readme.txt 2015-05-27 19:05:08 UTC (rev 3655) +++ pkg/Dowd/readme.txt 2015-05-28 21:14:29 UTC (rev 3656) @@ -1,4 +1,8 @@ #*************************************************************** +# most suitable function similar to bootsrtp in matlab is still to be checked +# original bootstrp VaR so that still needs to be checked. +# Other functions depending on bootstrp are still only half complete. +#*************************************************************** # Jarque-Bera Test: # It has to be checked Probability of null (H0) or (H1). # (http://stats.stackexchange.com/questions/130368/why-do-i-get-this-p-value-doing-the-jarque-bera-test-in-r) From noreply at r-forge.r-project.org Fri May 29 05:26:25 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 29 May 2015 05:26:25 +0200 (CEST) Subject: [Returnanalytics-commits] r3657 - in pkg/FactorAnalytics: . R man vignettes Message-ID: <20150529032625.A2E69187877@r-forge.r-project.org> Author: pragnya Date: 2015-05-29 05:26:24 +0200 (Fri, 29 May 2015) New Revision: 3657 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/R/fitTsfm.R pkg/FactorAnalytics/R/fitTsfm.control.R pkg/FactorAnalytics/R/fmmc.R pkg/FactorAnalytics/R/plot.sfm.r pkg/FactorAnalytics/R/plot.tsfm.r pkg/FactorAnalytics/man/fitTsfm.control.Rd pkg/FactorAnalytics/vignettes/fitSfm_vignette.pdf pkg/FactorAnalytics/vignettes/fitTsfm_vignette.pdf Log: Edits to lasso var selection, opt.method for st.mple, fix bug in fmmc Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2015-05-28 21:14:29 UTC (rev 3656) +++ pkg/FactorAnalytics/DESCRIPTION 2015-05-29 03:26:24 UTC (rev 3657) @@ -1,8 +1,8 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version:2.0.20 -Date:2015-05-19 +Version:2.0.21 +Date:2015-05-28 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Description: An R package for the estimation and risk analysis of linear factor Modified: pkg/FactorAnalytics/R/fitTsfm.R =================================================================== --- pkg/FactorAnalytics/R/fitTsfm.R 2015-05-28 21:14:29 UTC (rev 3656) +++ pkg/FactorAnalytics/R/fitTsfm.R 2015-05-29 03:26:24 UTC (rev 3657) @@ -192,7 +192,7 @@ m5 <- match(c("type","normalize","eps","max.steps","trace"), names(control), 0L) lars.args <- control[m5, drop=TRUE] - m6 <- match(c("K","type","normalize","eps","max.steps","trace"), + m6 <- match(c("K","type","normalize","eps","max.steps","trace","plot.it"), names(control), 0L) cv.lars.args <- control[m6, drop=TRUE] @@ -404,30 +404,30 @@ lars.fit <- do.call(lars, c(list(x=xmat, y=yvec),lars.args)) lars.sum <- summary(lars.fit) lars.cv <- do.call(cv.lars, c(list(x=xmat,y=yvec,mode="step"),cv.lars.args)) - # including plot.it=FALSE to cv.lars strangely gives an error: "Argument s - # out of range". And, specifying index=seq(nrow(lars.fit$beta)-1) resolves - # the issue, but care needs to be taken for small N # get the step that minimizes the "Cp" statistic or # the K-fold "cv" mean-squared prediction error if (lars.criterion=="Cp") { - s <- which.min(lars.sum$Cp)-1 # 2nd row is "step 1" + s <- which.min(lars.sum$Cp) } else { - s <- which.min(lars.cv$cv)-1 + s <- which.min(lars.cv$cv) } # get factor model coefficients & fitted values at the step obtained above coef.lars <- predict(lars.fit, s=s, type="coef", mode="step") + # alternately: coef.lars <- lars.fit[s, ] fitted.lars <- predict(lars.fit, xmat, s=s, type="fit", mode="step") fitted.list[[i]] <- xts(fitted.lars$fit, index(reg.xts)) # extract and assign the results asset.fit[[i]] = lars.fit - alpha[i] <- (fitted.lars$fit - - reg.xts[,factor.names]%*%coef.lars$coefficients)[1] beta.names <- names(coef.lars$coefficients) beta[i, beta.names] <- coef.lars$coefficients - r2[i] <- lars.fit$R2[s+1] - resid.sd[i] <- sqrt(lars.sum$Rss[s+1]/(nrow(reg.xts)-lars.sum$Df[s+1])) - + alpha[i] <- predict(lars.fit, matrix(0,1,length(beta.names)), s=s, + type="fit", mode="step")$fit + # alternately: alpha[i] <- + # (fitted.lars$fit - reg.xts[,factor.names]%*%coef.lars$coefficients)[1] + r2[i] <- lars.fit$R2[s] + resid.sd[i] <- sqrt(lars.sum$Rss[s]/(nrow(reg.xts)-sum(!beta[i,]==0))) + # according to summary.lars help files, $df is tricky for some models } if (length(asset.names)>1) { fitted.xts <- do.call(merge, fitted.list) Modified: pkg/FactorAnalytics/R/fitTsfm.control.R =================================================================== --- pkg/FactorAnalytics/R/fitTsfm.control.R 2015-05-28 21:14:29 UTC (rev 3656) +++ pkg/FactorAnalytics/R/fitTsfm.control.R 2015-05-29 03:26:24 UTC (rev 3657) @@ -103,6 +103,8 @@ #' during any step, variables are frequently droppped and added as the #' algorithm proceeds. Although the default usually guarantees that the #' algorithm has proceeded to the saturated fit, users should check. +#' @param plot.it option to plot the output for \code{\link[lars]{cv.lars}}. +#' Default is \code{FALSE}. #' @param lars.criterion an option to assess model selection for the #' \code{"lars"} method; one of "Cp" or "cv". See details. Default is "Cp". #' @param K number of folds for computing the K-fold cross-validated mean @@ -143,7 +145,7 @@ steps=1000, k=2, nvmin=1, nvmax=8, force.in=NULL, force.out=NULL, method, really.big=FALSE, type, normalize=TRUE, eps=.Machine$double.eps, max.steps, - lars.criterion="Cp", K=10) { + plot.it=FALSE, lars.criterion="Cp", K=10) { # get the user-specified arguments (that have no defaults) # this part of the code was adapted from stats::lm @@ -177,6 +179,12 @@ if (!is.logical(really.big) || length(really.big) != 1) { stop("Invalid argument: control parameter 'really.big' must be logical") } + if (!is.logical(normalize) || length(normalize) != 1) { + stop("Invalid argument: control parameter 'normalize' must be logical") + } + if (!is.logical(plot.it) || length(plot.it) != 1) { + stop("Invalid argument: control parameter 'plot.it' must be logical") + } if (nvmin <= 0 || round(nvmin) != nvmin) { stop("Control parameter 'nvmin' must be a positive integer") } @@ -197,6 +205,6 @@ trace=trace, steps=steps, k=k, nvmin=nvmin, nvmax=nvmax, force.in=force.in, force.out=force.out, really.big=really.big, normalize=normalize, eps=eps, - lars.criterion=lars.criterion, K=K)) + plot.it=plot.it, lars.criterion=lars.criterion, K=K)) return(result) } Modified: pkg/FactorAnalytics/R/fmmc.R =================================================================== --- pkg/FactorAnalytics/R/fmmc.R 2015-05-28 21:14:29 UTC (rev 3656) +++ pkg/FactorAnalytics/R/fmmc.R 2015-05-29 03:26:24 UTC (rev 3657) @@ -1,332 +1,333 @@ -#' @title Functions to compute estimates and thier standard errors using fmmc -#' -#' Control default arguments. Usually for factorAnalytics. -#' -#' @details -#' This method takes in the additional arguments list and checks if parameters -#' are set. Then it defaults values if they are unset. Currently it controls the -#' fit.method(default: OLS) and variable.selection(default: subsets). If -#' variable.selection is set to values other than subsets/none then it will -#' default to subsets. -#' arguments for factorAnalytics -#' -#' @param ... Arguments that must be passed to fitTsfm -#' -#' -.fmmc.default.args <- function(...) { - add.args <- list(...) - if(!"fit.method" %in% names(add.args)) add.args[["fit.method"]] <- "LS" - - if(!"variable.selection" %in% names(add.args)) - add.args[["variable.selection"]] <- "subsets" - else { - if(!add.args[["variable.selection"]] %in% c("none", "subsets")) - add.args[["variable.selection"]] <- "subsets" - } - - if (add.args[["variable.selection"]] == "subsets") { - if(!"nvmax" %in% names(add.args)) - add.args[["nvmax"]] <- NA - } - - add.args -} - -#' This is the main implementation of the Factor Model Monte Carlo method. It returns -#' a fmmc object that contains the joint empirical density of factors and returns. This -#' fmmc object can be reused to for calucluting risk and performance estimates along -#' with standard errors for the estimates -#' -#' @details -#' This method takes in data, factors and residual type. It then does the following -#' 1. Fit a time series factor model to the data using user supplied selection and -#' fit variables or it defaults them to stepwise and OLS respectively. If any -#' of the betas are NA then the corresponding factors are dropped -#' 2. If the residual type beisdes empirical is specified then it fits the -#' corresponding distribution to the residuals and simulates from the fitted -#' distribution. The number of NA's in the simulated sample are the same as -#' original residuals. -#' 3. It then merges factors and non-NA residuals for each asset to create a full -#' outer join of the factors and residuals. We use this joined data to create new -#' simulated returns. Returns together with factors define a joint emperical density. -#' -#' @param R single vector of returns -#' @param factors matrix of factor returns -#' @param ... allows passing paramters to factorAnalytics. -#' @author Rohit Arora -#' -#' -.fmmc.proc <- function(R, factors ,... ) { - - # Check if the classes of Returns and factors are correct - if(is.null(nrow(R)) || is.null(nrow(factors))) { - warning("Inputs are not matrix") - return(NA) - } - - factors.data <- na.omit(factors) - T <- nrow(factors.data); T1 <- nrow(R) - if (T < T1) { - warning("Length of factors cannot be less than assets") - return(NA) - } - - # Start getting ready to fit a time-series factor model to the data. - .data <- as.matrix(merge(R,factors.data)) - - #default args if not set - add.args <- .fmmc.default.args(...) - fit.method <- add.args[["fit.method"]] - variable.selection <- add.args[["variable.selection"]] - - if(variable.selection == "subsets" && is.na(add.args[["nvmax"]])) - add.args[["nvmax"]] <- floor((ncol(factors.data) - 1)/2) - - # Lets fit the time-series model - args <- list(asset.names=colnames(R), - factor.names=colnames(factors.data), data=.data) - - args <- merge.list(args,add.args) - - # We do not need to remove NA's. Beta's do no change if NA's are not removed - possibleError <- tryCatch( - fit <- do.call(fitTsfm, args), - error=function(e) - e) - - if(inherits(possibleError, "error")) { - warning(paste("Timeseries model fitting failed for ", colnames(R))) - return(NA) - } - - resid <- do.call(merge,lapply(lapply(fit$asset.fit,residuals),as.xts)) - beta <- t(fit$beta) - - if(any(is.na(beta))) { - warning("some of the betas where NA in .fmmc.proc. Dropping those") - beta <- beta[!is.na(c(beta)), 1, drop=FALSE] - names.factors <- colnames(factors.data) - names.beta <- rownames(beta) - factors.data <- as.matrix(factors.data[,names.factors %in% names.beta]) - } - - # define a joint empirical density for the factors and residuals and use - # that to calculate the returns. - .data <- as.matrix(merge(as.matrix(factors.data), resid)) - alpha <- matrix(as.numeric(fit$alpha), nrow=nrow(.data), ncol=1, byrow=TRUE) - - returns <- alpha + .data[,-ncol(.data),drop=FALSE] %*% beta + - .data[,ncol(.data),drop=FALSE] - - result <- list(bootdist = list(returns = returns, - factors = .data[,-ncol(.data),drop=FALSE]), - data = list(R = R, factors = factors.data), args = add.args) - result -} - -#' Statistic function for the boot call. It calculates the risk or performnace -#' meeasure by using the estimatation function in its argument list. -#' -#' @details -#' This method works as follows. -#' 1. Get data with factors and returns. -#' 2. Subset T rows from the data. -#' 3. Discard first TR-TR1 of the asset returns by setting them to NA -#' 4. calls .fmmc.proc method over the new data set to get a new joint empirical -#' distribution of returns and factors -#' 5. We use the new returns with the estimation function to calculate the -#' risk or performance measure. -#' -#' @param data matrix of (all factors + returns of just 1 asset) -#' @param indices row numbers generated by boot -#' @param args additinal paramters needed for subsetting the data and calulating -#' the perfomance/risk measure. -#' @author Rohit Arora -#' -#' -.fmmc.boot <- function(data, indices, args) { - - TR <- args$TR - TR1 <- args$TR1 - estimate.func <- args$estimate.func - fit.method <- args$fit.method - var.sel <- args$var.sel - - fun <- match.fun(estimate.func) - - # we just need TR rows of data - ind <- sample(indices, TR , replace = TRUE) - data <- data[ind,] - - # discard the first (TR-TR1) portion of returns if using fmmc. For - # complete data TR = TR1 - .data <- data - .data[1:(TR-TR1),ncol(.data)] <- NA - - # If the data does not have dates then it cannot be transformed to xts. - # So lets fake dates to make xts happy - .data <- as.xts(.data , order.by=seq(as.Date("1980/1/1"), by = "day", - length.out = nrow(.data))) - - # lets get a new empirical distribution of factors and returns for a new subset - fmmcObj <- .fmmc.proc(R=.data[,ncol(.data),drop=FALSE], - factors=.data[,-ncol(.data)], - fit.method = fit.method, variable.selection = var.sel) - - # lets calculate the performance or risk estimate - measure <- fun(fmmcObj$bootdist$returns) - measure -} - -#' Main function to calculate the risk/performance estimate and calculate the -#' standard error of the estimate using bootstrapping. -#' -#' @details -#' bootstrapping in our case can be painfully slow, so we exploit the parallel -#' capabilities of boot function. All cores on your machine are used. -#' We use the boot call from the boot library for calculating the estimate and -#' its standard error. -#' -#' @param fmmcObj object returned by fmmc proc. This is a comprehensive object -#' with all data for factors and returns. -#' @param nboot number of bootstap samples. Not sure how many repetations are -#' reuired but remember bias-variance tradeoff. Increasing nboot will only -#' reduce variance and not have a significant effect on bias(estimate) -#' @param estimate.func this is a handle to the function used for calulating -#' the perfomance/risk measure. -#' @param cl A cluster for running across multiple cores -#' @author Rohit Arora -#' -#' -.fmmc.se <- function(fmmcObj, nboot = 50, estimate.func, cl = NULL) { - - parallel <- if(is.null(cl)) "no" else "snow" - ncpus <- if(is.null(cl)) 1 else detectCores() - - # length of factors - TR <- nrow(fmmcObj$data$factors) - - # length of the asset returns - len <- nrow(fmmcObj$data$R) - - apply(fmmcObj$data$R, 2, function(col) which.min(is.na(col))) + 1 - - returns <- fmmcObj$bootdist$returns - factors <- fmmcObj$bootdist$factors - - # no need to do variable selection again. So lets turn it off - args <- list(TR = TR, TR1 = len, estimate.func = estimate.func, - fit.method = fmmcObj$args[["fit.method"]], var.sel = "none") - - result <- boot(data=cbind(factors, returns), statistic = .fmmc.boot, - R = nboot, parallel = parallel, ncpus = ncpus, cl = cl, args=args) - - se <- apply(result$t,2,sd) - se -} - -#' Worker function that acts between the fmmc procedure and calling method. -#' -#' @details -#' This method takes in data as single time series and factors as xts objects -#' It then calls the actual estimation procedure. -#' -#' @param R single vector of returns -#' @param factors matrix of factor returns -#' @param ... allows passing paramters to factorAnalytics. -#' @author Rohit Arora -#' -#' -#' -.fmmc.worker <- function(R, factors, ...) { - fmmc.obj <- .fmmc.proc(R=R, factors=factors, ...) - fmmc.obj -} - -#' Compute fmmc objects that can be used for calcuation of estimates and their -#' standard errors -#' -#' @details -#' This method takes in data and factors as xts objects where multiple -#' time series with different starting dates are merged together. It then -#' computes FMMC objects as described in Jiang and Martin (2013) -#' -#' @param R matrix of returns in xts format -#' @param factors matrix of factor returns in xts format -#' @param parallel flag to utilize multiplecores on the cpu. All cores are used. -#' @param ... Arguments that must be passed to fitTsfm -#' -#' @return returns an list of fmmc objects -#' -#' @references -#' Yindeng Jiang and Richard Doug Martin. Better Risk and Performance -#' Estimates with Factor Model Monte Carlo. SSRN Electronic Journal, July 2013. -#' -#' @author Rohit Arora -#' @export -#' -#' -fmmc <- function(R, factors, parallel=FALSE, ...) { - - ret <- NA - assets.count <- ncol(R) - - if (parallel) { - cl <- makeCluster(detectCores()) - registerDoSNOW(cl) - ret <- foreach (i = 1:assets.count) %dopar% .fmmc.worker(R[,i], factors, ...) - stopCluster(cl) - } else - ret <- foreach (i = 1:assets.count) %do% .fmmc.worker(R[,i], factors, ...) - - result <- ret[lapply(ret,length) > 1] - result -} - -#' Main function to calculate the standard errror of the estimate -#' -#' @details -#' This method takes in a list of fmmc objects and a callback function to compute -#' an estimate. The first argument of the callback function must be the data -#' bootstrapped using fmmc procedure. The remaining arguments can be suitably -#' bound to the parameters as needed. This function can also be used to calculate -#' the standard error using the se flag. -#' -#' @param fmmcObjs A list of fmmc objects computed using .fmmc.proc and containing -#' bootstrapped returns -#' @param fun A callback function where the first argument is returns and all the -#' other arguments are bounded to values -#' @param se A flag to indicate if standard error for the estimate must be calculated -#' @param parallel A flag to indicate if multiple cpu cores must be used -#' @param nboot Number of bootstrap samples -#' -#' @return returns the estimates and thier standard errors given fmmc objects -#' -#' @author Rohit Arora -#' @export -#' -fmmc.estimate.se <- function(fmmcObjs, fun=NULL, se=FALSE, nboot=100, - parallel = FALSE) { - - result <- as.matrix(rep(NA, length(fmmcObjs))); colnames(result) <- "estimate" - rownames(result) <- unlist(lapply(fmmcObjs, function(obj) colnames(obj$data$R))) - - if(is.null(fun)) return(result) - - cl <- NULL - if(parallel) { - cl <- makeCluster(detectCores()) - clusterEvalQ(cl, library(xts)) - } - - result[,1] <- unlist(lapply(fmmcObjs, function(obj) fun(obj$bootdist$returns))) - if(se) { - serr <- unlist( - lapply(fmmcObjs, function(obj) .fmmc.se(obj, nboot, fun, cl))) - result <- cbind(result, serr) - colnames(result) <- c("estimate", "se") - } - - if(parallel) stopCluster(cl) - - result +#' @title Functions to compute estimates and thier standard errors using fmmc +#' +#' Control default arguments. Usually for factorAnalytics. +#' +#' @details +#' This method takes in the additional arguments list and checks if parameters +#' are set. Then it defaults values if they are unset. Currently it controls the +#' fit.method(default: OLS) and variable.selection(default: subsets). If +#' variable.selection is set to values other than subsets/none then it will +#' default to subsets. +#' arguments for factorAnalytics +#' +#' @param ... Arguments that must be passed to fitTsfm +#' +#' +.fmmc.default.args <- function(...) { + add.args <- list(...) + if(!"fit.method" %in% names(add.args)) add.args[["fit.method"]] <- "LS" + + if(!"variable.selection" %in% names(add.args)) + add.args[["variable.selection"]] <- "subsets" + else { + if(!add.args[["variable.selection"]] %in% c("none", "subsets")) + add.args[["variable.selection"]] <- "subsets" + } + + if (add.args[["variable.selection"]] == "subsets") { + if(!"nvmax" %in% names(add.args)) + add.args[["nvmax"]] <- NA + } + + add.args +} + +#' This is the main implementation of the Factor Model Monte Carlo method. It returns +#' a fmmc object that contains the joint empirical density of factors and returns. This +#' fmmc object can be reused to for calucluting risk and performance estimates along +#' with standard errors for the estimates +#' +#' @details +#' This method takes in data, factors and residual type. It then does the following +#' 1. Fit a time series factor model to the data using user supplied selection and +#' fit variables or it defaults them to stepwise and OLS respectively. If any +#' of the betas are NA then the corresponding factors are dropped +#' 2. If the residual type beisdes empirical is specified then it fits the +#' corresponding distribution to the residuals and simulates from the fitted +#' distribution. The number of NA's in the simulated sample are the same as +#' original residuals. +#' 3. It then merges factors and non-NA residuals for each asset to create a full +#' outer join of the factors and residuals. We use this joined data to create new +#' simulated returns. Returns together with factors define a joint emperical density. +#' +#' @param R single vector of returns +#' @param factors matrix of factor returns +#' @param ... allows passing paramters to factorAnalytics. +#' @author Rohit Arora +#' +#' +.fmmc.proc <- function(R, factors ,... ) { + + # Check if the classes of Returns and factors are correct + if(is.null(nrow(R)) || is.null(nrow(factors))) { + warning("Inputs are not matrix") + return(NA) + } + + factors.data <- na.omit(factors) + T <- nrow(factors.data); T1 <- nrow(R) + if (T < T1) { + warning("Length of factors cannot be less than assets") + return(NA) + } + + # Start getting ready to fit a time-series factor model to the data. + .data <- as.matrix(merge(R,factors.data)) + + #default args if not set + add.args <- .fmmc.default.args(...) + fit.method <- add.args[["fit.method"]] + variable.selection <- add.args[["variable.selection"]] + + if(variable.selection == "subsets" && is.na(add.args[["nvmax"]])) + add.args[["nvmax"]] <- floor((ncol(factors.data) - 1)/2) + + # Lets fit the time-series model + args <- list(asset.names=colnames(R), + factor.names=colnames(factors.data), data=.data) + + args <- merge.list(args,add.args) + + # We do not need to remove NA's. Beta's do no change if NA's are not removed + possibleError <- tryCatch( + fit <- do.call(fitTsfm, args), + error=function(e) + e) + + if(inherits(possibleError, "error")) { + warning(paste("Timeseries model fitting failed for ", colnames(R))) + return(NA) + } + + resid <- do.call(merge,lapply(lapply(fit$asset.fit,residuals),as.xts)) + beta <- t(fit$beta) + + if(any(is.na(beta))) { + warning("some of the betas where NA in .fmmc.proc. Dropping those") + beta <- beta[!is.na(c(beta)), 1, drop=FALSE] + names.factors <- colnames(factors.data) + names.beta <- rownames(beta) + factors.data <- as.matrix(factors.data[,names.factors %in% names.beta]) + } + + # define a joint empirical density for the factors and residuals and use + # that to calculate the returns. + .data <- as.matrix(merge(as.matrix(factors.data), resid)) + alpha <- matrix(as.numeric(fit$alpha), nrow=nrow(.data), ncol=1, byrow=TRUE) + + returns <- alpha + .data[,-ncol(.data),drop=FALSE] %*% beta + + .data[,ncol(.data),drop=FALSE] + + result <- list(bootdist = list(returns = returns, + factors = .data[,-ncol(.data),drop=FALSE]), + data = list(R = R, factors = factors.data), args = add.args) + result +} + +#' Statistic function for the boot call. It calculates the risk or performnace +#' meeasure by using the estimatation function in its argument list. +#' +#' @details +#' This method works as follows. +#' 1. Get data with factors and returns. +#' 2. Subset T rows from the data. +#' 3. Discard first TR-TR1 of the asset returns by setting them to NA +#' 4. calls .fmmc.proc method over the new data set to get a new joint empirical +#' distribution of returns and factors +#' 5. We use the new returns with the estimation function to calculate the +#' risk or performance measure. +#' +#' @param data matrix of (all factors + returns of just 1 asset) +#' @param indices row numbers generated by boot +#' @param args additinal paramters needed for subsetting the data and calulating +#' the perfomance/risk measure. +#' @author Rohit Arora +#' +#' +.fmmc.boot <- function(data, indices, args) { + + TR <- args$TR + TR1 <- args$TR1 + estimate.func <- args$estimate.func + fit.method <- args$fit.method + var.sel <- args$var.sel + + fun <- match.fun(estimate.func) + + # we just need TR rows of data + ind <- sample(indices, TR , replace = TRUE) + data <- data[ind,] + + # discard the first (TR-TR1) portion of returns if using fmmc. For + # complete data TR = TR1 + .data <- data + .data[1:(TR-TR1),ncol(.data)] <- NA + + # If the data does not have dates then it cannot be transformed to xts. + # So lets fake dates to make xts happy + .data <- as.xts(.data , order.by=seq(as.Date("1980/1/1"), by = "day", + length.out = nrow(.data))) + + # lets get a new empirical distribution of factors and returns for a new subset + fmmcObj <- .fmmc.proc(R=.data[,ncol(.data),drop=FALSE], + factors=.data[,-ncol(.data)], + fit.method = fit.method, variable.selection = var.sel) + + # lets calculate the performance or risk estimate + measure <- fun(fmmcObj$bootdist$returns) + measure +} + +#' Main function to calculate the risk/performance estimate and calculate the +#' standard error of the estimate using bootstrapping. +#' +#' @details +#' bootstrapping in our case can be painfully slow, so we exploit the parallel +#' capabilities of boot function. All cores on your machine are used. +#' We use the boot call from the boot library for calculating the estimate and +#' its standard error. +#' +#' @param fmmcObj object returned by fmmc proc. This is a comprehensive object +#' with all data for factors and returns. +#' @param nboot number of bootstap samples. Not sure how many repetations are +#' reuired but remember bias-variance tradeoff. Increasing nboot will only +#' reduce variance and not have a significant effect on bias(estimate) +#' @param estimate.func this is a handle to the function used for calulating +#' the perfomance/risk measure. +#' @param cl A cluster for running across multiple cores +#' @author Rohit Arora +#' +#' +.fmmc.se <- function(fmmcObj, nboot = 50, estimate.func, cl = NULL) { + + parallel <- if(is.null(cl)) "no" else "snow" + ncpus <- if(is.null(cl)) 1 else detectCores() + + # length of factors + TR <- nrow(fmmcObj$data$factors) + + # length of the asset returns + len <- nrow(fmmcObj$data$R) - + apply(fmmcObj$data$R, 2, function(col) which.min(is.na(col))) + 1 + + returns <- fmmcObj$bootdist$returns + factors <- fmmcObj$bootdist$factors + + # no need to do variable selection again. So lets turn it off + args <- list(TR = TR, TR1 = len, estimate.func = estimate.func, + fit.method = fmmcObj$args[["fit.method"]], var.sel = "none") + + result <- boot(data=cbind(factors, returns), statistic = .fmmc.boot, + R = nboot, parallel = parallel, ncpus = ncpus, cl = cl, args=args) + + se <- apply(result$t,2,sd) + se +} + +#' Worker function that acts between the fmmc procedure and calling method. +#' +#' @details +#' This method takes in data as single time series and factors as xts objects +#' It then calls the actual estimation procedure. +#' +#' @param R single vector of returns +#' @param factors matrix of factor returns +#' @param ... allows passing paramters to factorAnalytics. +#' @author Rohit Arora +#' +#' +#' +.fmmc.worker <- function(R, factors, ...) { + fmmc.obj <- .fmmc.proc(R=R, factors=factors, ...) + fmmc.obj +} + +#' Compute fmmc objects that can be used for calcuation of estimates and their +#' standard errors +#' +#' @details +#' This method takes in data and factors as xts objects where multiple +#' time series with different starting dates are merged together. It then +#' computes FMMC objects as described in Jiang and Martin (2013) +#' +#' @param R matrix of returns in xts format +#' @param factors matrix of factor returns in xts format +#' @param parallel flag to utilize multiplecores on the cpu. All cores are used. +#' @param ... Arguments that must be passed to fitTsfm +#' +#' @return returns an list of fmmc objects +#' +#' @references +#' Yindeng Jiang and Richard Doug Martin. Better Risk and Performance +#' Estimates with Factor Model Monte Carlo. SSRN Electronic Journal, July 2013. +#' +#' @author Rohit Arora +#' @export +#' +#' +fmmc <- function(R, factors, parallel=FALSE, ...) { + + ret <- NA + assets.count <- ncol(R) + i <- NA + + if (parallel) { + cl <- makeCluster(detectCores()) + registerDoSNOW(cl) + ret <- foreach (i = 1:assets.count) %dopar% .fmmc.worker(R[,i], factors, ...) + stopCluster(cl) + } else + ret <- foreach (i = 1:assets.count) %do% .fmmc.worker(R[,i], factors, ...) + + result <- ret[lapply(ret,length) > 1] + result +} + +#' Main function to calculate the standard errror of the estimate +#' +#' @details +#' This method takes in a list of fmmc objects and a callback function to compute +#' an estimate. The first argument of the callback function must be the data +#' bootstrapped using fmmc procedure. The remaining arguments can be suitably +#' bound to the parameters as needed. This function can also be used to calculate +#' the standard error using the se flag. +#' +#' @param fmmcObjs A list of fmmc objects computed using .fmmc.proc and containing +#' bootstrapped returns +#' @param fun A callback function where the first argument is returns and all the +#' other arguments are bounded to values +#' @param se A flag to indicate if standard error for the estimate must be calculated +#' @param parallel A flag to indicate if multiple cpu cores must be used +#' @param nboot Number of bootstrap samples +#' +#' @return returns the estimates and thier standard errors given fmmc objects +#' +#' @author Rohit Arora +#' @export +#' +fmmc.estimate.se <- function(fmmcObjs, fun=NULL, se=FALSE, nboot=100, + parallel = FALSE) { + + result <- as.matrix(rep(NA, length(fmmcObjs))); colnames(result) <- "estimate" + rownames(result) <- unlist(lapply(fmmcObjs, function(obj) colnames(obj$data$R))) + + if(is.null(fun)) return(result) + + cl <- NULL + if(parallel) { + cl <- makeCluster(detectCores()) + clusterEvalQ(cl, library(xts)) + } + + result[,1] <- unlist(lapply(fmmcObjs, function(obj) fun(obj$bootdist$returns))) + if(se) { + serr <- unlist( + lapply(fmmcObjs, function(obj) .fmmc.se(obj, nboot, fun, cl))) + result <- cbind(result, serr) + colnames(result) <- c("estimate", "se") + } + + if(parallel) stopCluster(cl) + + result } \ No newline at end of file Modified: pkg/FactorAnalytics/R/plot.sfm.r =================================================================== --- pkg/FactorAnalytics/R/plot.sfm.r 2015-05-28 21:14:29 UTC (rev 3656) +++ pkg/FactorAnalytics/R/plot.sfm.r 2015-05-29 03:26:24 UTC (rev 3657) @@ -174,7 +174,8 @@ den <- density(Residuals) xval <- den$x den.norm <- dnorm(xval, mean=mean(Residuals), sd=resid.sd) - den.st <- dst(xval, dp=st.mple(x=matrix(1,nrow(Residuals)), y=as.vector(Residuals))$dp) + den.st <- dst(xval, dp=st.mple(x=matrix(1,nrow(Residuals)), + y=as.vector(Residuals), opt.method="BFGS")$dp) # plot selection repeat { Modified: pkg/FactorAnalytics/R/plot.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/plot.tsfm.r 2015-05-28 21:14:29 UTC (rev 3656) +++ pkg/FactorAnalytics/R/plot.tsfm.r 2015-05-29 03:26:24 UTC (rev 3657) @@ -179,7 +179,8 @@ den <- density(Residuals) xval <- den$x den.norm <- dnorm(xval, mean=mean(Residuals), sd=resid.sd) - den.st <- dst(xval, dp=st.mple(x=matrix(1,nrow(Residuals)), y=as.vector(Residuals))$dp) + den.st <- dst(xval, dp=st.mple(x=matrix(1,nrow(Residuals)), + y=as.vector(Residuals), opt.method="BFGS")$dp) # plot selection repeat { Modified: pkg/FactorAnalytics/man/fitTsfm.control.Rd =================================================================== --- pkg/FactorAnalytics/man/fitTsfm.control.Rd 2015-05-28 21:14:29 UTC (rev 3656) +++ pkg/FactorAnalytics/man/fitTsfm.control.Rd 2015-05-29 03:26:24 UTC (rev 3657) @@ -9,7 +9,8 @@ mxf = 50, mxs = 50, scope, scale, direction, trace = FALSE, steps = 1000, k = 2, nvmin = 1, nvmax = 8, force.in = NULL, force.out = NULL, method, really.big = FALSE, type, normalize = TRUE, - eps = .Machine$double.eps, max.steps, lars.criterion = "Cp", K = 10) + eps = .Machine$double.eps, max.steps, plot.it = FALSE, + lars.criterion = "Cp", K = 10) } \arguments{ \item{decay}{a scalar in (0, 1] to specify the decay factor for "DLS". @@ -111,6 +112,9 @@ algorithm proceeds. Although the default usually guarantees that the [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3657 From noreply at r-forge.r-project.org Fri May 29 23:20:42 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 29 May 2015 23:20:42 +0200 (CEST) Subject: [Returnanalytics-commits] r3658 - in pkg/Dowd: . R man Message-ID: <20150529212042.64CFA185831@r-forge.r-project.org> Author: dacharya Date: 2015-05-29 23:20:41 +0200 (Fri, 29 May 2015) New Revision: 3658 Added: pkg/Dowd/R/BootstrapESConfInterval.R pkg/Dowd/R/BootstrapESFigure.R pkg/Dowd/R/BootstrapVaR.R pkg/Dowd/R/BootstrapVaRConfInterval.R pkg/Dowd/R/BootstrapVaRFigure.R pkg/Dowd/man/BootstrapESConfInterval.Rd pkg/Dowd/man/BootstrapESFigure.Rd pkg/Dowd/man/BootstrapVaR.Rd pkg/Dowd/man/BootstrapVarConfInterval.Rd Modified: pkg/Dowd/DESCRIPTION pkg/Dowd/NAMESPACE pkg/Dowd/R/BootstrapES.R pkg/Dowd/R/HSES.R pkg/Dowd/man/BootstrapES.Rd pkg/Dowd/readme.txt Log: Source and documentation for BootstrapES, BootstrapESConfInterval, BootstrapESFigure, BootstrapVaR, BootstrapVaRConfInterval, BootstrapVaRFigure, Modified: pkg/Dowd/DESCRIPTION =================================================================== --- pkg/Dowd/DESCRIPTION 2015-05-29 03:26:24 UTC (rev 3657) +++ pkg/Dowd/DESCRIPTION 2015-05-29 21:20:41 UTC (rev 3658) @@ -1,12 +1,14 @@ Package: Dowd Type: Package -Title: R-version of Matlab Toolbox offered in Kevin Dowd's book Measuring Market Risk +Title: R-version of MMR II toolbox offered in Kevin Dowd's book Measuring Market Risk Version: 0.1 Date: 2015-05-24 Author: Dinesh Acharya Maintainer: Dinesh Acharya -Description: -Depends: R (>= 2.14.0) -Suggests: PerformanceAnalytics, - testthat +Description: This package is R-version of MMR2 Toolbox that supplements + Kevin Dowd's book measuring market risk. +Depends: R (>= 3.0.0), + bootstrap +Suggests: PerformanceAnalytics, + testthat License: GNU Public License Modified: pkg/Dowd/NAMESPACE =================================================================== --- pkg/Dowd/NAMESPACE 2015-05-29 03:26:24 UTC (rev 3657) +++ pkg/Dowd/NAMESPACE 2015-05-29 21:20:41 UTC (rev 3658) @@ -4,6 +4,10 @@ export(BinomialBacktest) export(BlancoIhleBacktest) export(BootstrapES) +export(BootstrapESConfInterval) +export(BootstrapESFigure) +export(BootstrapVaR) +export(BootstrapVarConfInterval) export(ChristoffersenBacktestForIndependence) export(ChristoffersenBacktestForUnconditionalCoverage) export(HSES) Modified: pkg/Dowd/R/BootstrapES.R =================================================================== --- pkg/Dowd/R/BootstrapES.R 2015-05-29 03:26:24 UTC (rev 3657) +++ pkg/Dowd/R/BootstrapES.R 2015-05-29 21:20:41 UTC (rev 3658) @@ -4,8 +4,8 @@ #' implied by data frequency. #' #' @param Ra Vector corresponding to profit and loss distribution -#' @param number.sample Number of samples to be taken in bootstrap procedure -#' @return cl Number corresponding to Value at Risk confidence level +#' @param number.resamples Number of samples to be taken in bootstrap procedure +#' @return cl Number corresponding to Expected Shortfall confidence level #' #' @references Dowd, K. Measuring Market Risk, Wiley, 2007. #' @@ -13,12 +13,12 @@ #' @author Dinesh Acharya #' @examples #' -#' # Estimates bootstrapped Es for given parameters +#' # Estimates bootstrapped ES for given parameters #' a <- rnorm(100) # generate a random profit/loss vector -#' BootstrappedES(a, 50, 0.95) +#' BootstrapVaR(a, 50, 0.95) #' #' @export -BootstrapES <- function(Ra, number.sample, cl){ +BootstrapES <- function(Ra, number.resamples, cl){ if (nargs() < 3){ error("Too few arguments") @@ -37,7 +37,7 @@ if (length(cl) != 1) { error("Confidence level must be a scalar") } - if (length(number.samples) != 1){ + if (length(number.resamples) != 1){ error("Number of resamples must be a scalar"); } @@ -45,16 +45,17 @@ if (cl >= 1){ stop("Confidence level must be less that 1") } + if (cl <= 0){ + stop("Confidence level must be at least 0") + } if (number.resamples <= 0){ stop("Number of resamples must be at least 0") } - ############################################# - # suitable alternative to bootstrp in R is still to be explored. - ############################################# + # Load bootstrap package + library(bootstrap) # ES estimation - # - # es <- bootstrp(number.resamples, "hses", losses.data, cl) - # y <- mean(es) - # return (y) + es <- bootstrap(losses.data, number.resamples, HSES, cl)$thetastar + y <- mean(es) + return (y) } \ No newline at end of file Added: pkg/Dowd/R/BootstrapESConfInterval.R =================================================================== --- pkg/Dowd/R/BootstrapESConfInterval.R (rev 0) +++ pkg/Dowd/R/BootstrapESConfInterval.R 2015-05-29 21:20:41 UTC (rev 3658) @@ -0,0 +1,66 @@ +#' Bootstrapped ES Confidence Interval +#' +#' Estimates the 90% confidence interval for bootstrapped ES, for confidence +#' level and holding period implied by data frequency. +#' +#' @param Ra Vector corresponding to profit and loss distribution +#' @param number.resample Number of samples to be taken in bootstrap procedure +#' @param cl Number corresponding to Expected Shortfall confidence level +#' @return 90% Confidence interval for bootstrapped ES +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # To be modified with appropriate data. +#' # Estimates 90% confidence interval for bootstrapped ES for 95% +#' # confidence interval +#' Ra <- rnorm(1000) +#' BootstrapESConfInterval(Ra, 50, 0.95) +#' +#' @export +BootstrapESConfInterval <- function(Ra, number.resamples, cl){ + + # Determine if there are three arguments + if (nargs() < 3){ + stop("Too few arguments") + } + if (nargs() > 3){ + stop("Too many arguments") + } + + profit.loss.data <- as.vector(Ra) + + # Preprocess data + unsorted.loss.data <- -profit.loss.data # Derives L/P data from input P/L data + losses.data <- sort(unsorted.loss.data) # Puts losses in ascending order + n <- length(losses.data) + + # Check that inputs have correct dimensions + if (is.vector(cl) & (length(cl) != 1) ) { + error("Confidence level must be a scalar") + } + if (length(number.resamples) != 1) { + error("Number of resamples must be a scalar") + } + # Check that inputs obey sign and value restrictions + if (cl >= 1){ + stop("Confidence level must be less that 1") + } + if (cl <= 0){ + stop("Confidence level must be at least 0") + } + if (number.resamples <= 0){ + stop("Number of resamples must be at least 0") + } + + library(bootstrap) + + # ES estimation + es <- bootstrap(losses.data, number.resamples, HSES, cl)[1] + y <- quantile(es, c(.05, .95)) + return(y) + +} \ No newline at end of file Added: pkg/Dowd/R/BootstrapESFigure.R =================================================================== --- pkg/Dowd/R/BootstrapESFigure.R (rev 0) +++ pkg/Dowd/R/BootstrapESFigure.R 2015-05-29 21:20:41 UTC (rev 3658) @@ -0,0 +1,72 @@ +#' Plots figure of bootstrapped ES +#' +#' Plots figure for the bootstrapped ES, for confidence +#' level and holding period implied by data frequency. +#' +#' @param Ra Vector corresponding to profit and loss distribution +#' @param number.resample Number of samples to be taken in bootstrap procedure +#' @param cl Number corresponding to Expected Shortfall confidence level +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # To be modified with appropriate data. +#' # Estimates 90% confidence interval for bootstrapped ES for 95% +#' # confidence interval +#' Ra <- rnorm(1000) +#' BootstrapESFigure(Ra, 500, 0.95) +#' +#' @export +BootstrapESFigure <- function(Ra, number.resamples, cl){ + + # Determine if there are three arguments + if (nargs() < 3){ + stop("Too few arguments") + } + if (nargs() > 3){ + stop("Too many arguments") + } + + profit.loss.data <- as.vector(Ra) + + # Preprocess data + unsorted.loss.data <- -profit.loss.data # Derives L/P data from input P/L data + losses.data <- sort(unsorted.loss.data) # Puts losses in ascending order + n <- length(losses.data) + + # Check that inputs have correct dimensions + if (is.vector(cl) & (length(cl) != 1) ) { + error("Confidence level must be a scalar") + } + if (length(number.resamples) != 1) { + error("Number of resamples must be a scalar") + } + # Check that inputs obey sign and value restrictions + if (cl >= 1){ + stop("Confidence level must be less that 1") + } + if (cl <= 0){ + stop("Confidence level must be at least 0") + } + if (number.resamples <= 0){ + stop("Number of resamples must be at least 0") + } + + library(bootstrap) + + # ES Estimation + es <- bootstrap(losses.data, number.resamples, HSES, cl)$thetastar + mean.es <- mean(es) + std.es <- sd(es) + min.es <- min(es) + max.es <- max(es) + ninety.five.perc.conf.interval <- quantile(es, c(.05, .95)) + + # Histogram + cl.for.label <- 100*cl + hist(es, 30, xlab="ES", ylab="Frequency", main=paste("Bootstrapped Historical Simulation ES at", cl, "% Confidence Level")) + +} \ No newline at end of file Added: pkg/Dowd/R/BootstrapVaR.R =================================================================== --- pkg/Dowd/R/BootstrapVaR.R (rev 0) +++ pkg/Dowd/R/BootstrapVaR.R 2015-05-29 21:20:41 UTC (rev 3658) @@ -0,0 +1,61 @@ +#' Bootstrapped VaR for specified confidence level +#' +#' Estimates the bootstrapped VaR for confidence level and holding period +#' implied by data frequency. +#' +#' @param Ra Vector corresponding to profit and loss distribution +#' @param number.sample Number of samples to be taken in bootstrap procedure +#' @return cl Number corresponding to Value at Risk confidence level +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # Estimates bootstrapped VaR for given parameters +#' a <- rnorm(100) # generate a random profit/loss vector +#' BootstrapES(a, 50, 0.95) +#' +#' @export +BootstrapVaR <- function(Ra, number.sample, cl){ + + if (nargs() < 3){ + error("Too few arguments") + } + if (nargs() > 3){ + error("Too many arguments") + } + + profit.loss.data <- as.vector(Ra) + # Preprocess data + unsorted.loss.data <- -profit.loss.data + losses.data <- sort(unsorted.loss.data) + n <- length(losses.data) + + # Check that inputs have correct dimensions + if (length(cl) != 1) { + error("Confidence level must be a scalar") + } + if (length(number.samples) != 1){ + error("Number of resamples must be a scalar"); + } + + # Check that inputs obey sign and value restrictions + if (cl >= 1){ + stop("Confidence level must be less that 1") + } + if (cl <= 0){ + stop("Confidence level must be at least 0") + } + if (number.resamples <= 0){ + stop("Number of resamples must be at least 0") + } + + # Load bootstrap package + library(bootstrap) + # ES estimation + VaR <- bootstrap(losses.data, number.resamples, HSVaR, cl)$thetastar + y <- mean(VaR) + return (y) +} \ No newline at end of file Added: pkg/Dowd/R/BootstrapVaRConfInterval.R =================================================================== --- pkg/Dowd/R/BootstrapVaRConfInterval.R (rev 0) +++ pkg/Dowd/R/BootstrapVaRConfInterval.R 2015-05-29 21:20:41 UTC (rev 3658) @@ -0,0 +1,66 @@ +#' Bootstrapped VaR Confidence Interval +#' +#' Estimates the 90% confidence interval for bootstrapped VaR, for confidence +#' level and holding period implied by data frequency. +#' +#' @param Ra Vector corresponding to profit and loss distribution +#' @param number.sample Number of samples to be taken in bootstrap procedure +#' @param cl Number corresponding to Value at Risk confidence level +#' @return 90% Confidence interval for bootstrapped VaR +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # To be modified with appropriate data. +#' # Estimates 90% confidence interval for bootstrapped Var for 95% +#' # confidence interval +#' Ra <- rnorm(1000) +#' BootstrapVarConfInterval(Ra, 500, 0.95) +#' +#' @export +BootstrapVarConfInterval <- function(Ra, number.resamples, cl){ + + # Determine if there are three arguments + if (nargs() < 3){ + stop("Too few arguments") + } + if (nargs() > 3){ + stop("Too many arguments") + } + + profit.loss.data <- as.vector(Ra) + + # Preprocess data + unsorted.loss.data <- -profit.loss.data # Derives L/P data from input P/L data + losses.data <- sort(unsorted.loss.data) # Puts losses in ascending order + n <- length(losses.data) + + # Check that inputs have correct dimensions + if (is.vector(cl) & (length(cl) != 1) ) { + error("Confidence level must be a scalar") + } + if (length(number.resamples) != 1) { + error("Number of resamples must be a scalar") + } + # Check that inputs obey sign and value restrictions + if (cl >= 1){ + stop("Confidence level must be less that 1") + } + if (cl <= 0){ + stop("Confidence level must be at least 0") + } + if (number.resamples <= 0){ + stop("Number of resamples must be at least 0") + } + + library(bootstrap) + + # VaR estimation + VaR <- bootstrap(losses.data, number.resamples, HSVaR, cl)$thetastar + y <- quantile(VaR, c(.05, .95)) + return(y) + +} \ No newline at end of file Added: pkg/Dowd/R/BootstrapVaRFigure.R =================================================================== --- pkg/Dowd/R/BootstrapVaRFigure.R (rev 0) +++ pkg/Dowd/R/BootstrapVaRFigure.R 2015-05-29 21:20:41 UTC (rev 3658) @@ -0,0 +1,72 @@ +#' Plots figure of bootstrapped VaR +#' +#' Plots figure for the bootstrapped VaR, for confidence +#' level and holding period implied by data frequency. +#' +#' @param Ra Vector corresponding to profit and loss distribution +#' @param number.sample Number of samples to be taken in bootstrap procedure +#' @param cl Number corresponding to Value at Risk confidence level +#' +#' @references Dowd, K. Measuring Market Risk, Wiley, 2007. +#' +#' +#' @author Dinesh Acharya +#' @examples +#' +#' # To be modified with appropriate data. +#' # Estimates 90% confidence interval for bootstrapped VaR for 95% +#' # confidence interval +#' Ra <- rnorm(1000) +#' BootstrapESFigure(Ra, 500, 0.95) +#' +#' @export +BootstrapESFigure <- function(Ra, number.resamples, cl){ + + # Determine if there are three arguments + if (nargs() < 3){ + stop("Too few arguments") + } + if (nargs() > 3){ + stop("Too many arguments") + } + + profit.loss.data <- as.vector(Ra) + + # Preprocess data + unsorted.loss.data <- -profit.loss.data # Derives L/P data from input P/L data + losses.data <- sort(unsorted.loss.data) # Puts losses in ascending order + n <- length(losses.data) + + # Check that inputs have correct dimensions + if (is.vector(cl) & (length(cl) != 1) ) { + error("Confidence level must be a scalar") + } + if (length(number.resamples) != 1) { + error("Number of resamples must be a scalar") + } + # Check that inputs obey sign and value restrictions + if (cl >= 1){ + stop("Confidence level must be less that 1") + } + if (cl <= 0){ + stop("Confidence level must be at least 0") + } + if (number.resamples <= 0){ + stop("Number of resamples must be at least 0") + } + + library(bootstrap) + + # ES Estimation + VaR <- bootstrap(losses.data, number.resamples, HSVaR, cl)$thetastar + mean.VaR <- mean(VaR) + std.VaR <- sd(VaR) + min.VaR <- min(VaR) + max.VaR <- max(VaR) + ninety.five.perc.conf.interval <- quantile(VaR, c(.05, .95)) + + # Histogram + cl.for.label <- 100*cl + hist(VaR[1], 30, xlab="VaR", ylab="Frequency", main=paste("Bootstrapped Historical Simulation VaR at", cl, "% Confidence Level")) + +} \ No newline at end of file Modified: pkg/Dowd/R/HSES.R =================================================================== --- pkg/Dowd/R/HSES.R 2015-05-29 03:26:24 UTC (rev 3657) +++ pkg/Dowd/R/HSES.R 2015-05-29 21:20:41 UTC (rev 3658) @@ -41,7 +41,6 @@ stop("Too many arguments") } - if (nargs() == 2) { profit.loss.data <- as.vector(Ra) unsorted.loss.data <- -profit.loss.data # Derives L/P data from input P/L @@ -54,7 +53,6 @@ stop('Confidence level must be scalar (length-1 vector in R)') } - # Check that inputs obey sign and value restrictions if (cl >= 1) { stop("Confidence level must be less than 1.") @@ -63,14 +61,15 @@ stop("Confidence level must be positive") } + # VaR and ES estimation index <- n*cl # This putative index value may or may not be an integer # Each case needs to be considered in turn # If index value is an integegr, VaR follows immediately and then we # estimate ES if (index-round(index)==0){ - var <- losses.data[index] # Historical Value at Risk - k <- which[var <= losses.data] # Finds indices of tail loss data + VaR <- losses.data[index] # Historical Value at Risk + k <- which(VaR <= losses.data) # Finds indices of tail loss data tail.losses <- losses.data[k] # Creates data set of tail loss observations es <- mean(tail.losses) # Expected Shortfall y <- es @@ -82,27 +81,32 @@ if (index-round(index) != 0){ # Deal with loss upper.index <- ceiling(index) - upper.var <- losses.data(upper.index) # Upper VaR - upper.k <- which(upper.var<=losses.data) # Finds indices of upper tail loss data - upper.tail.losses <- losses.data(upper.k) # Creates data set of upper tail loss obs. + upper.VaR <- losses.data[upper.index] # Upper VaR + upper.k <- which(upper.VaR<=losses.data) # Finds indices of upper tail loss data + upper.tail.losses <- losses.data[upper.k] # Creates data set of upper tail loss obs. + upper.es <- mean(upper.tail.losses) # Upper ES + # Deal with loss observation just below VaR to derive lower ES + lower.index <- ceil(index) + lower.VaR <- losses.data[lower.index] # Lower VaR + lower.k <- which(lower.VaR <= losses.data) # Finds indices of lower tail loss data + lower.tail.losses <- losses.data[lower.k] # Creates data set of lower tail loss obs. + lower.es <- mean(lower.tail.losses)# Lower ES + lower.es <- mean(lower.tail.losses) # Lower Expected Shortfall (ES) # If lower and upper indices are the same, ES is upper ES if (upper.index == lower.index){ y <- upper.es } - # If lower and upper indices are different, ES is weighted average of + # If lower and upper indices are different, ES is weighted average of # upper and lower ESs if (upper.index!=lower.index) { # Weights attached to upper and lower ESs - lower.weight <- (upper.index-index)/(upper.index-lower.index) - upper.weight <- (index-lower.index)/(upper.index-lower.index) + lower.weight <- (upper.index-index)/(upper.index-lower.index) # weight on upper_var + upper.weight <- (index-lower.index)/(upper.index-lower.index) # weight on upper_var # Finally, the weighted, ES as a linear interpolation of upper and lower # ESs y <- lower.weight*lower.es+upper.weight*upper.es - } - return(y) } - -} - + return(y) +} \ No newline at end of file Modified: pkg/Dowd/man/BootstrapES.Rd =================================================================== --- pkg/Dowd/man/BootstrapES.Rd 2015-05-29 03:26:24 UTC (rev 3657) +++ pkg/Dowd/man/BootstrapES.Rd 2015-05-29 21:20:41 UTC (rev 3658) @@ -4,24 +4,24 @@ \alias{BootstrapES} \title{Bootstrapped ES for specified confidence level} \usage{ -BootstrapES(Ra, number.sample, cl) +BootstrapES(Ra, number.resamples, cl) } \arguments{ \item{Ra}{Vector corresponding to profit and loss distribution} -\item{number.sample}{Number of samples to be taken in bootstrap procedure} +\item{number.resamples}{Number of samples to be taken in bootstrap procedure} } \value{ -cl Number corresponding to Value at Risk confidence level +cl Number corresponding to Expected Shortfall confidence level } \description{ Estimates the bootstrapped ES for confidence level and holding period implied by data frequency. } \examples{ -# Estimates bootstrapped Es for given parameters +# Estimates bootstrapped ES for given parameters a <- rnorm(100) # generate a random profit/loss vector - BootstrappedES(a, 50, 0.95) + BootstrapVaR(a, 50, 0.95) } \author{ Dinesh Acharya Added: pkg/Dowd/man/BootstrapESConfInterval.Rd =================================================================== --- pkg/Dowd/man/BootstrapESConfInterval.Rd (rev 0) +++ pkg/Dowd/man/BootstrapESConfInterval.Rd 2015-05-29 21:20:41 UTC (rev 3658) @@ -0,0 +1,36 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/BootstrapESConfInterval.R +\name{BootstrapESConfInterval} +\alias{BootstrapESConfInterval} +\title{Bootstrapped ES Confidence Interval} +\usage{ +BootstrapESConfInterval(Ra, number.resamples, cl) +} +\arguments{ +\item{Ra}{Vector corresponding to profit and loss distribution} + +\item{cl}{Number corresponding to Expected Shortfall confidence level} + +\item{number.resample}{Number of samples to be taken in bootstrap procedure} +} +\value{ +90% Confidence interval for bootstrapped ES +} +\description{ +Estimates the 90% confidence interval for bootstrapped ES, for confidence +level and holding period implied by data frequency. +} +\examples{ +# To be modified with appropriate data. + # Estimates 90\% confidence interval for bootstrapped ES for 95\% + # confidence interval + Ra <- rnorm(1000) + BootstrapESConfInterval(Ra, 50, 0.95) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. +} + Added: pkg/Dowd/man/BootstrapESFigure.Rd =================================================================== --- pkg/Dowd/man/BootstrapESFigure.Rd (rev 0) +++ pkg/Dowd/man/BootstrapESFigure.Rd 2015-05-29 21:20:41 UTC (rev 3658) @@ -0,0 +1,53 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/BootstrapESFigure.R, R/BootstrapVaRFigure.R +\name{BootstrapESFigure} +\alias{BootstrapESFigure} +\title{Plots figure of bootstrapped ES} +\usage{ +BootstrapESFigure(Ra, number.resamples, cl) + +BootstrapESFigure(Ra, number.resamples, cl) +} +\arguments{ +\item{Ra}{Vector corresponding to profit and loss distribution} + +\item{cl}{Number corresponding to Expected Shortfall confidence level} + +\item{number.resample}{Number of samples to be taken in bootstrap procedure} + +\item{Ra}{Vector corresponding to profit and loss distribution} + +\item{number.sample}{Number of samples to be taken in bootstrap procedure} + +\item{cl}{Number corresponding to Value at Risk confidence level} +} +\description{ +Plots figure for the bootstrapped ES, for confidence +level and holding period implied by data frequency. + +Plots figure for the bootstrapped VaR, for confidence +level and holding period implied by data frequency. +} +\examples{ +# To be modified with appropriate data. + # Estimates 90\% confidence interval for bootstrapped ES for 95\% + # confidence interval + Ra <- rnorm(1000) + BootstrapESFigure(Ra, 500, 0.95) +# To be modified with appropriate data. + # Estimates 90\% confidence interval for bootstrapped VaR for 95\% + # confidence interval + Ra <- rnorm(1000) + BootstrapESFigure(Ra, 500, 0.95) +} +\author{ +Dinesh Acharya + +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. + +Dowd, K. Measuring Market Risk, Wiley, 2007. +} + Added: pkg/Dowd/man/BootstrapVaR.Rd =================================================================== --- pkg/Dowd/man/BootstrapVaR.Rd (rev 0) +++ pkg/Dowd/man/BootstrapVaR.Rd 2015-05-29 21:20:41 UTC (rev 3658) @@ -0,0 +1,32 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/BootstrapVaR.R +\name{BootstrapVaR} +\alias{BootstrapVaR} +\title{Bootstrapped VaR for specified confidence level} +\usage{ +BootstrapVaR(Ra, number.sample, cl) +} +\arguments{ +\item{Ra}{Vector corresponding to profit and loss distribution} + +\item{number.sample}{Number of samples to be taken in bootstrap procedure} +} +\value{ +cl Number corresponding to Value at Risk confidence level +} +\description{ +Estimates the bootstrapped VaR for confidence level and holding period +implied by data frequency. +} +\examples{ +# Estimates bootstrapped VaR for given parameters + a <- rnorm(100) # generate a random profit/loss vector + BootstrapES(a, 50, 0.95) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. +} + Added: pkg/Dowd/man/BootstrapVarConfInterval.Rd =================================================================== --- pkg/Dowd/man/BootstrapVarConfInterval.Rd (rev 0) +++ pkg/Dowd/man/BootstrapVarConfInterval.Rd 2015-05-29 21:20:41 UTC (rev 3658) @@ -0,0 +1,36 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/BootstrapVaRConfInterval.R +\name{BootstrapVarConfInterval} +\alias{BootstrapVarConfInterval} +\title{Bootstrapped VaR Confidence Interval} +\usage{ +BootstrapVarConfInterval(Ra, number.resamples, cl) +} +\arguments{ +\item{Ra}{Vector corresponding to profit and loss distribution} + +\item{cl}{Number corresponding to Value at Risk confidence level} + +\item{number.sample}{Number of samples to be taken in bootstrap procedure} +} +\value{ +90% Confidence interval for bootstrapped VaR +} +\description{ +Estimates the 90% confidence interval for bootstrapped VaR, for confidence +level and holding period implied by data frequency. +} +\examples{ +# To be modified with appropriate data. + # Estimates 90\% confidence interval for bootstrapped Var for 95\% + # confidence interval + Ra <- rnorm(1000) + BootstrapVarConfInterval(Ra, 500, 0.95) +} +\author{ +Dinesh Acharya +} +\references{ +Dowd, K. Measuring Market Risk, Wiley, 2007. +} + Modified: pkg/Dowd/readme.txt =================================================================== --- pkg/Dowd/readme.txt 2015-05-29 03:26:24 UTC (rev 3657) +++ pkg/Dowd/readme.txt 2015-05-29 21:20:41 UTC (rev 3658) @@ -1,7 +1,5 @@ #*************************************************************** -# most suitable function similar to bootsrtp in matlab is still to be checked -# original bootstrp VaR so that still needs to be checked. -# Other functions depending on bootstrp are still only half complete. +# Bootstrap is almost complete. It is still to be tested/debugged. Tests still remaining. #*************************************************************** # Jarque-Bera Test: # It has to be checked Probability of null (H0) or (H1).