[Returnanalytics-commits] r3440 - in pkg/FactorAnalytics: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 25 18:05:02 CEST 2014
Author: pragnya
Date: 2014-06-25 18:05:02 +0200 (Wed, 25 Jun 2014)
New Revision: 3440
Added:
pkg/FactorAnalytics/R/fitTSFM.R
Removed:
pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R
Modified:
pkg/FactorAnalytics/DESCRIPTION
Log:
FitTSFM: Reformatted the function into smaller testable components, renamed functions and variables to conform to the Google R style Guide (Camel case), added a detailed and consistent description, added step() control options, included more warnings and input checks.
Modified: pkg/FactorAnalytics/DESCRIPTION
===================================================================
--- pkg/FactorAnalytics/DESCRIPTION 2014-06-24 22:26:12 UTC (rev 3439)
+++ pkg/FactorAnalytics/DESCRIPTION 2014-06-25 16:05:02 UTC (rev 3440)
@@ -11,14 +11,15 @@
factor model, fundamental factor model and statistical factor model. They
allow for different types of distributions to be specified for modeling the
fat-tailed behavior of financial returns, including Edgeworth expansions.
- Risk analysis measures such as VaR and ES are also provided for the results
- of the fitted models.
+ Risk analysis measures such as VaR and ES and performance attribution (to
+ factor-contributed and idiosyncratic returns) are also included.
License: GPL-2
Depends:
R (>= 2.14.0),
robust,
leaps,
lars,
+ lmtest,
PerformanceAnalytics,
sn,
tseries,
Added: pkg/FactorAnalytics/R/fitTSFM.R
===================================================================
--- pkg/FactorAnalytics/R/fitTSFM.R (rev 0)
+++ pkg/FactorAnalytics/R/fitTSFM.R 2014-06-25 16:05:02 UTC (rev 3440)
@@ -0,0 +1,446 @@
+#' @title Fits a time series factor model (TSFM) using time series regression
+#'
+#' @description Fits a time series (or, macroeconomic) factor model for single
+#' or multiple asset returns or excess returns using time series regression.
+#' Users can choose between ordinary least squares-OLS, discounted least
+#' squares-DLS (or) robust regression. Several variable selection options
+#' including Stepwise, Subsets, Lars are available as well. An object of class
+#' \code{tsfm} is returned.
+#'
+#' @details
+#' Estimation method "OLS" corresponds to ordinary least squares, "DLS" is
+#' discounted least squares, which is weighted least squares estimation with
+#' exponentially declining weights that sum to unity, and, "Robust" is robust
+#' regression (uses \code{\link[robust]{lmRob}}).
+#'
+#' If \code{variable.selection}="none", all chosen factors are used in the
+#' factor model. Whereas, "stepwise" performs traditional forward/backward
+#' stepwise OLS regression (using \code{\link[stats]{step}}), that starts from
+#' the initial set of factors and adds factors only if the regression fit, as
+#' measured by the Bayesian Information Criterion (BIC) or Akaike Information
+#' Criterion (AIC), improves. And, "all subsets" enables subsets selection
+#' using \code{\link[leaps]{regsubsets}} that chooses the n-best performing
+#' subsets of any given size (specified as \code{num.factor.subsets} here).
+#' "lars" and "lasso" correspond to variants of least angle regression using
+#' \code{\link[lars]{lars}}. If "lars" or "lasso" are chosen, \code{fit.method}
+#' will be ignored.
+#'
+#' Note: If \code{variable.selection}="lars" or "lasso", \code{fit.method}
+#' will be ignored. And, "Robust" \code{fit.method} is not truly available with
+#' \code{variable.selection}="all subsets"; instead, results are produced for
+#' \code{variable.selection}="none" with "Robust" to include all factors.
+#'
+#' If \code{add.up.market = TRUE}, max(0, Rm-Rf) is added as a factor in the
+#' regression, following Henriksson & Merton (1981), to account for market
+#' timing (price movement of the general stock market relative to fixed income
+#' securities). The coefficient can be interpreted as the number of free put
+#' options.
+#'
+#' Finally, for both the "lars" and "lasso" methods, the "Cp" statistic
+#' (defined in page 17 of Efron et al. (2002)) is calculated using
+#' \code{\link[lars]{summary.lars}} . While, "cv" computes the K-fold
+#' cross-validated mean squared prediction error using
+#' \code{\link[lars]{cv.lars}}.
+#'
+#' @param asset.names a character vector containing the names of the assets,
+#' whose returns or excess returns are the dependent variable.
+#' @param factor.names a character vector containing the names of the
+#' macroeconomic factors.
+#' @param market.name name of an optional column for market excess returns
+#' (Rm-Rf). Necessary if \code{add.up.market} or \code{add.up.market.squared}
+#' are \code{TRUE}.
+#' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object
+#' containing column(s) named \code{asset.names} and \code{factor.names}.
+#' \code{market.name} is also necessary if \code{add.up.market} or
+#' \code{add.market.sqd} are \code{TRUE}.
+#' @param fit.method the estimation method, one of "OLS", "DLS" or "Robust".
+#' See details. If \code{variable.selection}="lars" or "lasso",
+#' \code{fit.method} will be ignored. And, "Robust" \code{fit.method} is not
+#' available with \code{variable.selection}="all subsets".
+#' @param variable.selection the variable selection method, one of "none",
+#' "stepwise","all subsets","lars" or "lasso". See details.
+#' @param subsets.method a required option for the "all subsets" method; one of
+#' "exhaustive", "forward", "backward" or "seqrep" (sequential replacement)
+#' to specify the type of subset search/selection.
+#' @param nvmax an option for the "all subsets" method; a scalar, specifies
+#' the maximum size of subsets to examine. Default is 8.
+#' @param force.in an option for the "all subsets" method; a vector containing
+#' the names of factors that should always be included in the model. Default
+#' is NULL.
+#' @param num.factors.subset an option for the "all subsets" method; a scalar
+#' number of factors required in the factor model. Default is 1.
+#' Note: nvmax >= num.factors.subset >= length(force.in).
+#' @param add.up.market a logical value that when set to \code{TRUE}, adds
+#' max(0, Rm-Rf) as a regressor. If \code{TRUE}, \code{market.name} is
+#' required. Default is \code{FALSE}. See Details.
+#' @param add.market.sqd a logical value that when set to \code{TRUE}, adds
+#' (Rm-Rf)^2 as a regressor. If \code{TRUE}, \code{market.name} is
+#' required. Default is \code{FALSE}.
+#' @param decay a scalar, specifies the decay factor for
+#' \code{fit.method="DLS"}. Default is 0.95.
+#' @param lars.criterion an option to assess model selection for the "lars" or
+#' "lasso" variable.selection methods; one of "Cp" or "cv". See details.
+#' Default is "Cp".
+#' @param ... optional arguments passed to the \code{step} function for
+#' variable.selection method "stepwise", such as direction, steps and
+#' the penalty factor k. Note that argument k is available only for "OLS"
+#' and "DLS" fits. Scope argument is not available presently. Also plan to
+#' include other controls passed to \code{lmRob} soon.
+#'
+#' @return The returned value is an S3 object of class \code{tsfm}
+#' containing the following components:
+#' \item{asset.fit} {list of the fitted objects for each asset. Each fitted
+#' object is of class \code{lm} if \code{fit.method} is "OLS" or "DLS";
+#' of class \code{lmRob} if the \code{fit.method} is "Robust"; of class
+#' \code{lars} if \code{variable.selection}="lars" or "lasso".
+#' \item{alpha} {N x 1 vector of estimated alphas.}
+#' \item{beta} {N x K matrix of estimated betas.}
+#' \item{r2} {N x 1 vector of R-squared values.}
+#' \item{resid.sd} {N x 1 vector of residual standard deviations.}
+#' \item{call} {the matched function call.}
+#' \item{data} {data as input.}
+#' \item{asset.names} {asset.names as input.}
+#' \item{factor.names{ {factor.names as input.}
+#' \item{fit.method} {fit.method as input.}
+#' \item{variable.selection} {variable.selection as input.}
+#' Where N is the number of assets and K is the number of factors.
+#'
+#' @family Factor Models
+#'
+#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan.
+#' @references
+#' \enumerate{
+#' \item Christopherson, Carino and Ferson (2009). Portfolio Performance
+#' Measurement and Benchmarking, McGraw Hill.
+#' \item Efron, Hastie, Johnstone and Tibshirani (2002) "Least Angle
+#' Regression" (with discussion) Annals of Statistics. Also refer to
+#' \url{http://www-stat.stanford.edu/~hastie/Papers/LARS/LeastAngle_2002.pdf}.
+#' \item Hastie, Tibshirani and Friedman (2008) Elements of Statistical
+#' Learning 2nd edition, Springer, NY.
+#' \item Henriksson and Merton (1981). On market timing and investment
+#' performance. II. Statistical procedures for evaluating forecasting skills,
+#' Journal of Business, Vol 54, No 4.
+#' }
+#'
+#' @examples
+#' \dontrun{
+#' # load data from the database
+#' data(managers.df)
+#' fit <- fitTimeSeriesFactorModel(asset.names=colnames(managers.df[,(1:6)]),
+#' factor.names=c("EDHEC.LS.EQ","SP500.TR"),
+#' data=managers.df,fit.method="OLS")
+#' # summary of HAM1
+#' summary(fit$asset.fit$HAM1)
+#' # plot actual vs. fitted over time for HAM1
+#' # use chart.TimeSeries() function from PerformanceAnalytics package
+#' dataToPlot <- cbind(fitted(fit$asset.fit$HAM1), na.omit(managers.df$HAM1))
+#' colnames(dataToPlot) <- c("Fitted","Actual")
+#' chart.TimeSeries(dataToPlot, main="FM fit for HAM1",
+#' colorset=c("black","blue"), legend.loc="bottomleft")
+#' }
+#'
+#' @export
+
+fitTSFM <- function(asset.names, factor.names, market.name, data=data,
+ fit.method = c("OLS","DLS","Robust"),
+ variable.selection = c("none","stepwise","all subsets",
+ "lars","lasso"),
+ subsets.method = c("exhaustive", "backward", "forward",
+ "seqrep"),
+ nvmax=8, force.in=NULL, num.factors.subset=1,
+ add.up.market=FALSE, add.market.sqd=FALSE,
+ decay=0.95, lars.criterion="Cp", ...) {
+
+ # get all the arguments specified by their full names
+ call <- match.call()
+ if (!exists("direction")) {direction <- "backward"}
+ if (!exists("steps")) {steps <- 1000}
+ if (!exists("k")) {k <- 2}
+ if (!exists("market.name") && (add.up.market==TRUE | add.market.sqd==TRUE)) {
+ stop("Missing input: 'market.name' to include factors 'up.market' or
+ 'market.sqd'")
+ }
+
+ # convert data into an xts object and hereafter work with xts objects
+ data.xts <- checkData(data)
+
+ # extract columns to be used in the time series regression
+ dat.xts <- merge(data.xts[,asset.names], data.xts[,factor.names])
+ if (add.up.market == TRUE | add.market.sqd == TRUE ) {
+ dat.xts <- merge(dat.xts, data.xts[,market.name])
+ }
+
+ # Selects regression procedure based on specified variable.selection method.
+ # Each method returns a list of fitted factor models for each asset.
+ if (variable.selection == "none") {
+ reg.list <- NoVariableSelection(dat.xts, asset.names, factor.names,
+ market.name, fit.method, add.up.market,
+ add.market.sqd, decay)
+ } else if (variable.selection == "stepwise"){
+ reg.list <- SelectStepwise(dat.xts, asset.names, factor.names,
+ market.name, fit.method,
+ add.up.market, add.market.sqd, decay,
+ direction, steps, k)
+ } else if (variable.selection == "all subsets"){
+ reg.list <- SelectAllSubsets(dat.xts, asset.names, factor.names,
+ market.name, fit.method, subsets.method,
+ nvmax, force.in, num.factors.subset,
+ add.up.market, add.market.sqd, decay)
+ } else if (variable.selection == "lars" | variable.selection == "lasso"){
+ result.lars <- SelectLars(dat.xts, asset.names, factor.names, market.name,
+ variable.selection, add.up.market, add.market.sqd,
+ decay, lars.criterion)
+ result.lars <- c(result.lars, call, data, asset.names, factor.names,
+ fit.method, variable.selection)
+ return(result.lars)
+ }
+ else {
+ stop("Invalid argument: variable.selection must be either 'none',
+ 'stepwise','all subsets','lars' or 'lasso'")
+ }
+
+ # extract the fitted factor models, coefficients, r2 values and residual vol
+ # from returned factor model fits above
+ alpha <- sapply(reg.list, function(x) coef(x)[1], USE.NAMES = FALSE)
+ beta <- sapply(reg.list, function(x) coef(x)[-1], USE.NAMES = FALSE)
+ r2 <- sapply(reg.list, function(x) summary(x)$r.squared)
+ resid.sd <- sapply(reg.list, function(x) summary(x)$sigma)
+ # create list of return values.
+ result <- list(asset.fit=reg.list, alpha=alpha, beta=beta, r2=r2,
+ resid.sd=resid.sd, call=call, data=data,
+ asset.names=asset.names, factor.names=factor.names,
+ fit.method=fit.method, variable.selection=variable.selection)
+ class(result) <- "tsfm"
+ return(result)
+}
+
+
+### method variable.selection = "none"
+#
+NoVariableSelection <- function (dat.xts, asset.names, factor.names,
+ market.name, fit.method, add.up.market,
+ add.market.sqd, decay){
+ # initialize list object to hold the fitted objects
+ reg.list <- list()
+
+ # loop through and estimate model for each asset to allow unequal histories
+ for (i in asset.names){
+ # completely remove NA cases
+ reg.xts <- na.omit(dat.xts[, c(i, factor.names)])
+ # optionally add factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2
+ reg.xts <- MarketFactors(dat.xts, reg.xts, market.name,
+ add.up.market, add.market.sqd)
+ # formula to pass to lm or lmRob
+ fm.formula <- as.formula(paste(i," ~ ."))
+
+ # fit based on time series regression method chosen
+ if (fit.method == "OLS") {
+ reg.list[[i]] <- lm(fm.formula, data=reg.xts)
+ } else if (fit.method == "DLS") {
+ w <- WeightsDLS(nrow(reg.xts), decay)
+ reg.list[[i]] <- lm(fm.formula, data=reg.xts, weights=w)
+ } else if (fit.method == "Robust") {
+ reg.list[[i]] <- lmRob(fm.formula, data=reg.xts)
+ } else {
+ stop("Invalid argument: fit.method must be 'OLS', 'DLS' or 'Robust'")
+ }
+ }
+ reg.list
+}
+
+
+### method variable.selection = "stepwise"
+#
+SelectStepwise <- function(dat.xts, asset.names, factor.names,
+ market.name, fit.method, add.up.market,
+ add.market.sqd, decay, direction, steps, k){
+ # initialize list object to hold the fitted objects
+ reg.list <- list()
+
+ # loop through and estimate model for each asset to allow unequal histories
+ for (i in asset.names){
+ # completely remove NA cases
+ reg.xts <- na.omit(dat.xts[, c(i, factor.names)])
+ # formula to pass to lm or lmRob
+ fm.formula <- as.formula(paste(i," ~ ."))
+
+ # optionally add factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2
+ if(fit.method=="Robust" && (add.up.market==TRUE | add.market.sqd==TRUE)) {
+ stop("This function does not support add.up.market/add.market.sqd when
+ variable.selection = 'stepwise' && fit.method = 'Robust'. Please
+ choose a different combination of options.")
+ } else {
+ reg.xts <- MarketFactors(dat.xts, reg.xts, market.name,
+ add.up.market, add.market.sqd)
+ }
+
+ # fit based on time series regression method chosen
+ if (fit.method == "OLS") {
+ reg.list[[i]] <- step(lm(fm.formula, data=reg.xts), direction=direction,
+ steps=steps, k=k, trace=0)
+ } else if (fit.method == "DLS") {
+ w <- WeightsDLS(nrow(reg.xts), decay)
+ reg.list[[i]] <- step(lm(fm.formula, data=reg.xts, weights=w),
+ direction=direction, steps=steps, k=k, trace=0)
+ } else if (fit.method == "Robust") {
+ reg.list[[i]] <- step.lmRob(lmRob(fm.formula, data=reg.df), trace=FALSE,
+ direction=direction, steps=steps, k=k)
+ } else {
+ stop("Invalid argument: fit.method must be 'OLS', 'DLS' or 'Robust'")
+ }
+ }
+ reg.list
+}
+
+
+### method variable.selection = "all subsets"
+#
+SelectAllSubsets <- function(dat.xts, asset.names, factor.names,
+ market.name, fit.method, subsets.method,
+ nvmax, force.in, num.factors.subset,
+ add.up.market, add.market.sqd, decay){
+ # Check argument validity
+ if (nvmax < num.factors.subset) {
+ stop("Invaid Argument: nvmax should be >= num.factors.subset")
+ }
+ # initialize list object to hold the fitted objects
+ reg.list <- list()
+
+ # loop through and estimate model for each asset to allow unequal histories
+ for (i in asset.names){
+ # formula to pass to lm or lmRob
+ fm.formula <- as.formula(paste(i," ~ ."))
+
+ # branch out based on time series regression method chosen
+ if (fit.method == "Robust") {
+ warning("'Robust' fit.method is not available with 'all subsets'
+ variable.selection. Instead, results are shown for
+ variable.selection='none' with fit.method='Robust' to include
+ all factors.")
+ reg.xts <- na.omit(dat.xts[, c(i, factor.names)])
+ reg.xts <- MarketFactors(dat.xts, reg.xts, market.name,
+ add.up.market, add.market.sqd)
+ asset.fit <- lmRob(fm.formula, data=reg.xts)
+ }
+ else if (fit.method == "OLS" | fit.method == "DLS") {
+ # use regsubsets to find the best model with a subset of factors of size
+ # num.factors.subset
+
+ if (num.factors.subset == length(force.in)) {
+ reg.xts <- na.omit(dat.xts[, c(i, force.in)])
+ } else if (num.factors.subset > length(force.in)) {
+ reg.xts <- na.omit(dat.xts[, c(i, factor.names)])
+ if (fit.method != "DLS") {decay <- 1}
+ # do weighted least squares if "DLS"
+ w <- WeightsDLS(nrow(reg.xts), decay)
+ fm.subsets <- regsubsets(fm.formula, data=reg.xts, nvmax=nvmax,
+ force.in=force.in, method=subsets.method,
+ weights=w)
+ sum.sub <- summary(fm.subsets)
+ reg.xts <- na.omit(dat.xts[,c(i,names(which(sum.sub$which[
+ as.character(num.factors.subset),-1]==TRUE)))])
+ } else {
+ stop("Invalid Argument: num.factors.subset should be >=
+ length(force.in)")
+ }
+
+ # optionally add factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2
+ reg.xts <- MarketFactors(dat.xts, reg.xts, market.name,
+ add.up.market, add.market.sqd)
+ # fit linear regression model for the factors chosen
+ reg.list[[i]] <- lm(fm.formula, data=reg.xts, weights=w)
+ }
+ else {
+ stop("Invalid argument: fit.method must be 'OLS', 'DLS' or 'Robust'")
+ }
+ }
+ reg.list
+}
+
+
+### method variable.selection = "lars" or "lasso"
+#
+SelectLars <- function(dat.xts, asset.names, factor.names, market.name,
+ variable.selection, add.up.market, add.market.sqd,
+ decay, lars.criterion) {
+ # initialize list object to hold the fitted objects and, vectors and matrices
+ # for the other results
+ asset.fit <- list()
+ alpha <- rep(NA, length(asset.names))
+ beta <- matrix(NA, length(asset.names), length(factor.names))
+ r2 <- rep(NA, length(asset.names))
+ resid.sd <- rep(NA, length(asset.names))
+
+
+ # loop through and estimate model for each asset to allow unequal histories
+ for (i in asset.names){
+ # completely remove NA cases
+ reg.xts <- na.omit(dat.xts[, c(i, factor.names)])
+ # optionally add factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2
+ reg.xts <- MarketFactors(dat.xts, reg.xts, market.name,
+ add.up.market, add.market.sqd)
+ # convert to matrix
+ reg.mat <- as.matrix(na.omit(reg.xts))
+ # fit lar or lasso regression model
+ lars.fit <- lars(reg.mat[,factor.names], reg.mat[,i],
+ type=variable.selection, trace = FALSE)
+ lars.sum <- summary(lars.fit)
+
+ # get the step that minimizes the "Cp" statistic or the "cv" mean-sqd
+ # prediction error
+ if (lars.criterion == "Cp") {
+ s <- which.min(lars.sum$Cp)
+ } else if (lars.criterion == "cv") {
+ lars.cv <- cv.lars(reg.mat[,factor.names], reg.mat[,i], trace=FALSE,
+ type=variable.selection, mode="step", plot.it=FALSE)
+ s <- which.min(lars.cv$cv)
+ } else {
+ stop("Invalid argument: lars.criterion must be Cp' or 'cv'")
+ }
+
+ # get factor model coefficients & fitted values at the step obtained above
+ coef.lars <- predict(lars.fit, s=s, type="coef", mode="step")
+ fitted.lars <- predict(lars.fit, reg.xts[,factor.names], s=s, type="fit",
+ mode="step")
+ # 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]
+ resid.sd[i] <- lars.sum$Rss[s]/(nrow(reg.xts)-s)
+
+ }
+ results.lars <- list(asset.fit, alpha, beta, r2, resid.sd)
+}
+
+
+### Format and add optional factors "up.market" and "market.sqd"
+#
+MarketFactors <- function(dat.xts, reg.xts, market.name,
+ add.up.market, add.market.sqd) {
+ if(add.up.market == TRUE) {
+ # up.market = max(0,Rm-Rf)
+ up.market <- apply(dat.xts[,market.name],1,max,0)
+ reg.xts <- merge(reg.xts,up.market)
+ colnames(reg.xts)[dim(reg.xts)[2]] <- "up.market"
+ }
+ if(add.market.sqd == TRUE) {
+ # market.sqd = (Rm-Rf)^2
+ market.sqd <- dat.xts[,market.name]^2
+ reg.xts <- merge(reg.xts,market.sqd)
+ colnames(reg.xts)[dim(reg.xts)[2]] <- "market.sqd"
+ }
+ reg.xts
+}
+
+
+### calculate weights for "DLS"
+#
+WeightsDLS <- function(t,d){
+ # more weight given to more recent observations
+ w <- d^seq((t-1),0,-1)
+ # ensure that the weights sum to unity
+ w/sum(w)
+}
\ No newline at end of file
Deleted: pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R
===================================================================
--- pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2014-06-24 22:26:12 UTC (rev 3439)
+++ pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2014-06-25 16:05:02 UTC (rev 3440)
@@ -1,530 +0,0 @@
-#' Fit time series factor model by time series regression techniques.
-#'
-#' @description Fit time series factor model by time series regression techniques for single
-#' or multiple assets. Classic OLS, Robust regression can be chosen and several model selection methods
-#' can be applied. Class "TimeSeriesFactorModel" will be created too.
-#'
-#' @details
-#' \code{add.up.market.returns} adds a max(0,Rm-Rf) term in the regression as suggested by
-#' Merton-Henriksson Model (1981) to measure market timing. The coefficient can be interpreted as
-#' number of free put options.
-#'
-#' If \code{Robust} is chosen, there is no subsets but all factors will be
-#' used. Cp is defined in
-#' http://www-stat.stanford.edu/~hastie/Papers/LARS/LeastAngle_2002.pdf. p17.
-#'
-#' @param assets.names names of assets returns.
-#' @param factors.names names of factors returns.
-#' @param num.factor.subset scalar. Number of factors selected by all subsets.
-#' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object with \code{assets.names}
-#' and \code{factors.names} or \code{excess.market.returns.name} if necassary.
-#' @param fit.method "OLS" is ordinary least squares method, "DLS" is
-#' discounted least squares method. Discounted least squares (DLS) estimation
-#' is weighted least squares estimation with exponentially declining weights
-#' that sum to unity. "Robust"
-#' @param variable.selection "none" will not activate variables sellection. Default is "none".
-#' "stepwise" is traditional forward/backward #' stepwise OLS regression, starting from the initial set of factors, that adds
-#' factors only if the regression fit as measured by the Bayesian Information
-#' Criteria (BIC) or Akaike Information Criteria (AIC) can be done using the R
-#' function step() from the stats package. If "Robust" is chosen, the
-#' function step.lmRob in Robust package will be used. "all subsets" is
-#' Traditional all subsets regression can be done using the R function
-#' regsubsets() from the package leaps. "lar" , "lasso" is based on package
-#' "lars", linear angle regression. If "lar" or "lasso" is chose. fit.method will be ignored.
-#' @param decay.factor for DLS. Default is 0.95.
-#' @param nvmax control option for all subsets. maximum size of subsets to
-#' examine
-#' @param force.in control option for all subsets. The factors that should be
-#' in all models.
-#' @param subsets.method control option for all subsets. se exhaustive search,
-#' forward selection, backward selection or sequential replacement to search.
-#' @param lars.criteria either choose minimum "cp": unbiased estimator of the
-#' true rist or "cv" 10 folds cross-validation. Default is "Cp". See detail.
-#' @param add.up.market.returns Logical. If \code{TRUE}, max(0,Rm-Rf) will be added as a regressor.
-#' Default is \code{FALSE}. \code{excess.market.returns.nam} is required if \code{TRUE}. See Detail.
-#' @param add.quadratic.term Logical. If \code{TRUE}, (Rm-Rf)^2 will be added as a regressor.
-#' \code{excess.market.returns.name} is required if \code{TRUE}. Default is \code{FALSE}.
-#' @param excess.market.returns.name colnames
-#' market returns minus risk free rate. (Rm-Rf).
-#' @return an S3 object containing
-#' \itemize{
-#' \item{asset.fit} {Fit objects for each asset. This is the class "lm" for
-#' each object.}
-#' \item{alpha} {N x 1 Vector of estimated alphas.}
-#' \item{beta} {N x K Matrix of estimated betas.}
-#' \item{r2} {N x 1 Vector of R-square values.}
-#' \item{resid.variance} {N x 1 Vector of residual variances.}
-#' \item{call} {function call.}
-#' \item{data} original data as input
-#' \item{factors.names} factors.names as input
-#' \item{variable.selection} variable.selection as input
-#' \item{assets.names} asset.names as input
-#' }
-#'
-#'
-#'
-#'
-#' @author Eric Zivot and Yi-An Chen.
-#' @references
-#' \enumerate{
-#' \item Efron, Hastie, Johnstone and Tibshirani (2002) "Least Angle
-#' Regression" (with discussion) Annals of Statistics; see also
-#' http://www-stat.stanford.edu/~hastie/Papers/LARS/LeastAngle_2002.pdf.
-#' \item Hastie, Tibshirani and Friedman (2008) Elements of Statistical Learning 2nd
-#' edition, Springer, NY.
-#' \item Christopherson, Carino and Ferson (2009). Portfolio Performance Measurement
-#' and Benchmarking, McGraw Hill.
-#' }
-#' @examples
-#' \dontrun{
-#' # load data from the database
-#' data(managers.df)
-#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
-#' factors.names=c("EDHEC.LS.EQ","SP500.TR"),
-#' data=managers.df,fit.method="OLS")
-#' # summary of HAM1
-#' summary(fit$asset.fit$HAM1)
-#' # plot actual vs. fitted over time for HAM1
-#' # use chart.TimeSeries() function from PerformanceAnalytics package
-#' dataToPlot = cbind(fitted(fit$asset.fit$HAM1), na.omit(managers.df$HAM1))
-#' colnames(dataToPlot) = c("Fitted","Actual")
-#' chart.TimeSeries(dataToPlot, main="FM fit for HAM1",
-#' colorset=c("black","blue"), legend.loc="bottomleft")
-#' }
-#' @export
-fitTimeSeriesFactorModel <-
-function(assets.names, factors.names, data=data, num.factor.subset = 1,
- fit.method=c("OLS","DLS","Robust"),
- variable.selection="none",
- decay.factor = 0.95,nvmax=8,force.in=NULL,
- subsets.method = c("exhaustive", "backward", "forward", "seqrep"),
- lars.criteria = "Cp",add.up.market.returns = FALSE,add.quadratic.term = FALSE,
- excess.market.returns.name ) {
-
- this.call <- match.call()
-
- # convert data into xts and hereafter compute in xts
- data.xts <- checkData(data)
- reg.xts <- merge(data.xts[,assets.names],data.xts[,factors.names])
- if (add.up.market.returns == TRUE || add.quadratic.term == TRUE ) {
- reg.xts <- merge(reg.xts,data.xts[,excess.market.returns.name])
- }
- # initialize list object to hold regression objects
-reg.list = list()
-
-
-# initialize matrices and vectors to hold estimated betas,
-# residual variances, and R-square values from
-# fitted factor models
-
-Alphas = ResidVars = R2values = rep(NA, length(assets.names))
-names(Alphas) = names(ResidVars) = names(R2values) = assets.names
-Betas = matrix(NA, length(assets.names), length(factors.names))
-colnames(Betas) = factors.names
-rownames(Betas) = assets.names
-
-if(add.up.market.returns == TRUE ) {
- Betas <- cbind(Betas,rep(NA,length(assets.names)))
- colnames(Betas)[dim(Betas)[2]] <- "up.beta"
-}
-
-if(add.quadratic.term == TRUE ) {
- Betas <- cbind(Betas,rep(NA,length(assets.names)))
- colnames(Betas)[dim(Betas)[2]] <- "quadratic.term"
-}
-
-#
-### plain vanila method
-#
-if (variable.selection == "none") {
- if (fit.method == "OLS") {
- for (i in assets.names) {
- reg.df = na.omit(reg.xts[, c(i, factors.names)])
- if(add.up.market.returns == TRUE) {
- reg.df$up.beta = reg.df[,excess.market.returns.name]
- reg.df$up.beta[reg.df$up.beta <0] <- rep(0,sum(reg.df$up.beta<0))
- }
- if(add.quadratic.term == TRUE) {
- quadratic.term <- reg.xts[,excess.market.returns.name]^2
- reg.df = merge(reg.df,quadratic.term)
- colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
- }
- fm.formula = as.formula(paste(i,"~", ".", sep=" "))
- fm.fit = lm(fm.formula, data=reg.df)
- fm.summary = summary(fm.fit)
- reg.list[[i]] = fm.fit
- Alphas[i] = coef(fm.fit)[1]
- Betas.names = names(coef(fm.fit)[-1])
- Betas[i,Betas.names] = coef(fm.fit)[-1]
- ResidVars[i] = fm.summary$sigma^2
- R2values[i] = fm.summary$r.squared
- }
- } else if (fit.method == "DLS") {
- for (i in assets.names) {
- reg.df = na.omit(reg.xts[, c(i, factors.names)])
- if(add.up.market.returns == TRUE) {
- up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
- reg.df = merge(reg.df,up.beta)
- }
- if(add.quadratic.term == TRUE) {
- quadratic.term <- reg.xts[,excess.market.returns.name]^2
- reg.df = merge(reg.df,quadratic.term)
- colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
- }
- t.length <- nrow(reg.df)
- w <- rep(decay.factor^(t.length-1),t.length)
- for (k in 2:t.length) {
- w[k] = w[k-1]/decay.factor
- }
- # sum weigth to unitary
- w <- w/sum(w)
- fm.formula = as.formula(paste(i,"~", ".", sep=""))
- fm.fit = lm(fm.formula, data=reg.df,weights=w)
- fm.summary = summary(fm.fit)
- reg.list[[i]] = fm.fit
- Alphas[i] = coef(fm.fit)[1]
- Betas.names = names(coef(fm.fit)[-1])
- Betas[i,Betas.names] = coef(fm.fit)[-1]
- ResidVars[i] = fm.summary$sigma^2
- R2values[i] = fm.summary$r.squared
- }
- } else if (fit.method=="Robust") {
- for (i in assets.names) {
- reg.df = na.omit(reg.xts[, c(i, factors.names)])
- if(add.up.market.returns == TRUE) {
- up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
- reg.df = merge(reg.df,up.beta)
- }
- if(add.quadratic.term == TRUE) {
- quadratic.term <- reg.xts[,excess.market.returns.name]^2
- reg.df = merge(reg.df,quadratic.term)
- colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
- }
- fm.formula = as.formula(paste(i,"~", ".", sep=" "))
- fm.fit = lmRob(fm.formula, data=reg.df)
- fm.summary = summary(fm.fit)
- reg.list[[i]] = fm.fit
- Alphas[i] = coef(fm.fit)[1]
- Betas[i, ] = coef(fm.fit)[-1]
- ResidVars[i] = fm.summary$sigma^2
- R2values[i] = fm.summary$r.squared
- }
-
- } else {
- stop("invalid method")
- }
-
-#
-### subset methods
-#
-}
- else if (variable.selection == "all subsets") {
-# estimate multiple factor model using loop b/c of unequal histories for the hedge funds
-
-if (fit.method == "OLS") {
-
-if (num.factor.subset == length(force.in)) {
- for (i in assets.names) {
- reg.df = na.omit(reg.xts[, c(i, force.in)])
- if(add.up.market.returns == TRUE) {
- up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
- reg.df = merge(reg.df,up.beta)
- }
- if(add.quadratic.term == TRUE) {
- quadratic.term <- reg.xts[,excess.market.returns.name]^2
- reg.df = merge(reg.df,quadratic.term)
- colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
- }
- fm.formula = as.formula(paste(i,"~", ".", sep=" "))
- fm.fit = lm(fm.formula, data=reg.df)
- fm.summary = summary(fm.fit)
- reg.list[[i]] = fm.fit
- Alphas[i] = coef(fm.fit)[1]
- Betas.names = names(coef(fm.fit)[-1])
- Betas[i,Betas.names] = coef(fm.fit)[-1]
- ResidVars[i] = fm.summary$sigma^2
- R2values[i] = fm.summary$r.squared
- }
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3440
More information about the Returnanalytics-commits
mailing list