From noreply at r-forge.r-project.org Tue Sep 15 01:00:03 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 15 Sep 2015 01:00:03 +0200 (CEST) Subject: [Returnanalytics-commits] r3993 - in pkg/FactorAnalytics: . R man Message-ID: <20150914230003.C4532187B81@r-forge.r-project.org> Author: pragnya Date: 2015-09-15 01:00:02 +0200 (Tue, 15 Sep 2015) New Revision: 3993 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/R/fitTsfm.R pkg/FactorAnalytics/R/fitTsfm.control.R pkg/FactorAnalytics/man/Stock.df.Rd Log: Pass names instead of functions to do.call in fitTsfm; Updated Stock.df.Rd Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2015-08-31 21:52:27 UTC (rev 3992) +++ pkg/FactorAnalytics/DESCRIPTION 2015-09-14 23:00:02 UTC (rev 3993) @@ -1,8 +1,8 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version: 2.0.24 -Date: 2015-08-08 +Version: 2.0.25 +Date: 2015-09-14 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Description: Linear factor model fitting for asset returns (three major types- Modified: pkg/FactorAnalytics/R/fitTsfm.R =================================================================== --- pkg/FactorAnalytics/R/fitTsfm.R 2015-08-31 21:52:27 UTC (rev 3992) +++ pkg/FactorAnalytics/R/fitTsfm.R 2015-09-14 23:00:02 UTC (rev 3993) @@ -160,11 +160,11 @@ # set defaults and check input vailidity fit.method = fit.method[1] if (!(fit.method %in% c("LS","DLS","Robust"))) { - stop("Invalid argument: fit.method must be 'LS', 'DLS' or 'Robust'") + stop("Invalid args: fit.method must be 'LS', 'DLS' or 'Robust'") } variable.selection = variable.selection[1] if (!(variable.selection %in% c("none","stepwise","subsets","lars"))) { - stop("Invalid argument: variable.selection must be either 'none', + stop("Invalid args: variable.selection must be either 'none', 'stepwise','subsets' or 'lars'") } if (missing(factor.names) && !is.null(mkt.name)) { @@ -215,8 +215,8 @@ mkt.name <- gsub(" ",".", mkt.name, fixed=TRUE) rf.name <- gsub(" ",".", rf.name, fixed=TRUE) - # Selects regression procedure based on specified variable.selection method. - # Each method returns a list of fitted factor models for each asset. + # select procedure based on the variable.selection method + # returns a list of the fitted factor model for all assets if (variable.selection == "none") { reg.list <- NoVariableSelection(dat.xts, asset.names, factor.names, fit.method, lm.args, lmRob.args, decay) @@ -280,13 +280,12 @@ # fit based on time series regression method chosen if (fit.method == "LS") { - reg.list[[i]] <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args)) + reg.list[[i]] <- do.call("lm", c(list(fm.formula,data=quote(reg.xts)),lm.args)) } else if (fit.method == "DLS") { lm.args$weights <- WeightsDLS(nrow(reg.xts), decay) - reg.list[[i]] <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args)) + reg.list[[i]] <- do.call("lm", c(list(fm.formula,data=quote(reg.xts)),lm.args)) } else if (fit.method == "Robust") { - reg.list[[i]] <- do.call(lmRob, c(list(fm.formula,data=reg.xts), - lmRob.args)) + reg.list[[i]] <- do.call("lmRob", c(list(fm.formula,data=quote(reg.xts)),lmRob.args)) } } reg.list @@ -310,15 +309,15 @@ # fit based on time series regression method chosen if (fit.method == "LS") { - lm.fit <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args)) - reg.list[[i]] <- do.call(step, c(list(lm.fit),step.args)) + lm.fit <- do.call("lm", c(list(fm.formula,data=quote(reg.xts)),lm.args)) + reg.list[[i]] <- do.call("step", c(list(lm.fit),step.args)) } else if (fit.method == "DLS") { lm.args$weights <- WeightsDLS(nrow(reg.xts), decay) - lm.fit <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args)) - reg.list[[i]] <- do.call(step, c(list(lm.fit),step.args)) + lm.fit <- do.call("lm", c(list(fm.formula,data=quote(reg.xts)),lm.args)) + reg.list[[i]] <- do.call("step", c(list(lm.fit),step.args)) } else if (fit.method == "Robust") { - lmRob.fit <- do.call(lmRob, c(list(fm.formula,data=reg.xts), lmRob.args)) - reg.list[[i]] <- do.call(step.lmRob, c(list(lmRob.fit), step.args)) + lmRob.fit <- do.call("lmRob", c(list(fm.formula,data=quote(reg.xts)),lmRob.args)) + reg.list[[i]] <- do.call("step.lmRob", c(list(lmRob.fit),step.args)) } } reg.list @@ -347,7 +346,7 @@ } # choose best subset of factors depending on specified subset size - fm.subsets <- do.call(regsubsets, c(list(fm.formula,data=reg.xts), + fm.subsets <- do.call("regsubsets", c(list(fm.formula,data=quote(reg.xts)), regsubsets.args)) sum.sub <- summary(fm.subsets) @@ -363,13 +362,12 @@ # fit based on time series regression method chosen if (fit.method == "LS") { - reg.list[[i]] <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args)) + reg.list[[i]] <- do.call("lm", c(list(fm.formula,data=quote(reg.xts)),lm.args)) } else if (fit.method == "DLS") { lm.args$weights <- WeightsDLS(nrow(reg.xts), decay) - reg.list[[i]] <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args)) + reg.list[[i]] <- do.call("lm", c(list(fm.formula,data=quote(reg.xts)),lm.args)) } else if (fit.method == "Robust") { - reg.list[[i]] <- do.call(lmRob, c(list(fm.formula,data=reg.xts), - lmRob.args)) + reg.list[[i]] <- do.call("lmRob", c(list(fm.formula,data=quote(reg.xts)),lmRob.args)) } } reg.list @@ -399,9 +397,9 @@ xmat <- as.matrix(reg.xts[,factor.names]) yvec <- as.matrix(reg.xts)[,i] # fit lars regression model - lars.fit <- do.call(lars, c(list(x=xmat, y=yvec),lars.args)) + lars.fit <- do.call("lars", c(list(x=quote(xmat),y=quote(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)) + lars.cv <- do.call("cv.lars", c(list(x=quote(xmat),y=quote(yvec),mode="step"),cv.lars.args)) # get the step that minimizes the "Cp" statistic or # the K-fold "cv" mean-squared prediction error @@ -428,7 +426,7 @@ # according to summary.lars help files, $df is tricky for some models } if (length(asset.names)>1) { - fitted.xts <- do.call(merge, fitted.list) + fitted.xts <- do.call("merge", fitted.list) } else { fitted.xts <- fitted.list[[1]] } @@ -454,7 +452,7 @@ ## l = list of unequal vectors # makePaddedDataFrame <- function(l) { - DF <- do.call(rbind, lapply(lapply(l, unlist), "[", + DF <- do.call("rbind", lapply(lapply(l, unlist), "[", unique(unlist(c(sapply(l,names)))))) DF <- as.data.frame(DF) names(DF) <- unique(unlist(c(sapply(l,names)))) @@ -494,7 +492,7 @@ function(x) checkData(fitted(x))) # this is a list of xts objects, indexed by the asset name # merge the objects in the list into one xts object - fitted.xts <- do.call(merge, fitted.list) + fitted.xts <- do.call("merge", fitted.list) } else { fitted.xts <- checkData(fitted(object$asset.fit[[1]])) colnames(fitted.xts) <- object$asset.names @@ -522,7 +520,7 @@ function(x) checkData(residuals(x))) # this is a list of xts objects, indexed by the asset name # merge the objects in the list into one xts object - residuals.xts <- do.call(merge, residuals.list) + residuals.xts <- do.call("merge", residuals.list) } else { residuals.xts <- checkData(residuals(object$asset.fit[[1]])) colnames(residuals.xts) <- object$asset.names Modified: pkg/FactorAnalytics/R/fitTsfm.control.R =================================================================== --- pkg/FactorAnalytics/R/fitTsfm.control.R 2015-08-31 21:52:27 UTC (rev 3992) +++ pkg/FactorAnalytics/R/fitTsfm.control.R 2015-09-14 23:00:02 UTC (rev 3993) @@ -162,41 +162,41 @@ # check input validity for some of the arguments if (decay<=0 || decay>1) { - stop("Invalid argument: Decay factor should be in (0,1]") + stop("Invalid args: Decay factor should be in (0,1]") } if (!is.logical(model) || length(model) != 1) { - stop("Invalid argument: control parameter 'model' must be logical") + stop("Invalid args: control parameter 'model' must be logical") } if (!is.logical(x) || length(x) != 1) { - stop("Invalid argument: control parameter 'x' must be logical") + stop("Invalid args: control parameter 'x' must be logical") } if (!is.logical(y) || length(y) != 1) { - stop("Invalid argument: control parameter 'y' must be logical") + stop("Invalid args: control parameter 'y' must be logical") } if (!is.logical(qr) || length(qr) != 1) { - stop("Invalid argument: control parameter 'qr' must be logical") + stop("Invalid args: control parameter 'qr' must be logical") } if (!is.logical(really.big) || length(really.big) != 1) { - stop("Invalid argument: control parameter 'really.big' must be logical") + stop("Invalid args: control parameter 'really.big' must be logical") } if (!is.logical(normalize) || length(normalize) != 1) { - stop("Invalid argument: control parameter 'normalize' must be logical") + stop("Invalid args: 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") + stop("Invalid args: control parameter 'plot.it' must be logical") } if (nvmin <= 0 || round(nvmin) != nvmin) { stop("Control parameter 'nvmin' must be a positive integer") } if (nvmax < nvmin || nvmin < length(force.in)) { - stop("Invaid Argument: nvmax should be >= nvmin and nvmin + stop("Invaid args: nvmax should be >= nvmin and nvmin should be >= length(force.in)") } if (!is.logical(normalize) || length(normalize) != 1) { - stop("Invalid argument: control parameter 'normalize' must be logical") + stop("Invalid args: control parameter 'normalize' must be logical") } if (!(lars.criterion %in% c("Cp","cv"))) { - stop("Invalid argument: lars.criterion must be 'Cp' or 'cv'.") + stop("Invalid args: lars.criterion must be 'Cp' or 'cv'.") } # return list of arguments with defaults if they are unspecified Modified: pkg/FactorAnalytics/man/Stock.df.Rd =================================================================== --- pkg/FactorAnalytics/man/Stock.df.Rd 2015-08-31 21:52:27 UTC (rev 3992) +++ pkg/FactorAnalytics/man/Stock.df.Rd 2015-09-14 23:00:02 UTC (rev 3993) @@ -1,21 +1,32 @@ -\docType{data} -\name{Stock.df} -\alias{Stock.df} -\alias{stock} -\title{constructed NYSE 447 assets from 1996-01-01 through 2003-12-31.} -\description{ - constructed NYSE 447 assets from 1996-01-01 through - 2003-12-31. -} -\details{ - Continuous data: PRICE, RETURN, TICKER, VOLUME, SHARES.OUT, - MARKET.EQUITY,LTDEBT, NET.SALES, COMMON.EQUITY, - NET.INCOME, STOCKHOLDERS.EQUITY, LOG.MARKETCAP, - LOG.PRICE, BOOK2MARKET Categorical data: GICS, - GICS.INDUSTRY, GICS.SECTOR -} -\references{ - Guy Yullen and Yi-An Chen -} -\keyword{datasets} - +\docType{data} +\name{Stock.df} +\alias{Stock.df} +\alias{stock} +\title{Fundamental and return data for 447 NYSE stocks} +\description{ + Fundamental and return data: + Assets: 447 stocks listed on the NYSE + Frequency: Monthly + Date range: 1996-02-29 through 2003-12-31 +} +\details{ + ID variables: DATE, TICKER + + Continuous variables: RETURN, PRICE, VOLUME, SHARES.OUT, MARKET.EQUITY, + LTDEBT, NET.SALES, COMMON.EQUITY, NET.INCOME, STOCKHOLDERS.EQUITY, + LOG.MARKETCAP, LOG.PRICE, BOOK2MARKET + + Categorical variables: GICS, GICS.INDUSTRY, GICS.SECTOR +} +\usage{ +data(Stock.df) +} +\format{ +data.frame +} +\examples{ +data(Stock.df) +str(stock) +} +\keyword{datasets} +\keyword{data.frame} From noreply at r-forge.r-project.org Tue Sep 15 08:23:49 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 15 Sep 2015 08:23:49 +0200 (CEST) Subject: [Returnanalytics-commits] r3994 - in pkg/FactorAnalytics: . R man vignettes Message-ID: <20150915062349.91313185F7A@r-forge.r-project.org> Author: pragnya Date: 2015-09-15 08:23:49 +0200 (Tue, 15 Sep 2015) New Revision: 3994 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fmEsDecomp.R pkg/FactorAnalytics/R/fmVaRDecomp.R pkg/FactorAnalytics/R/plot.sfm.r pkg/FactorAnalytics/R/plot.tsfm.r pkg/FactorAnalytics/R/zzz.R pkg/FactorAnalytics/man/fmEsDecomp.Rd pkg/FactorAnalytics/man/fmVaRDecomp.Rd pkg/FactorAnalytics/man/plot.sfm.Rd pkg/FactorAnalytics/man/plot.tsfm.Rd pkg/FactorAnalytics/vignettes/fitSfm_vignette.R pkg/FactorAnalytics/vignettes/fitSfm_vignette.Rnw pkg/FactorAnalytics/vignettes/fitSfm_vignette.pdf pkg/FactorAnalytics/vignettes/fitTsfm_vignette.R pkg/FactorAnalytics/vignettes/fitTsfm_vignette.Rnw pkg/FactorAnalytics/vignettes/fitTsfm_vignette.pdf Log: VaR calculated as a sample quantile. Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/DESCRIPTION 2015-09-15 06:23:49 UTC (rev 3994) @@ -1,7 +1,7 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version: 2.0.25 +Version: 2.0.26 Date: 2015-09-14 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/NAMESPACE 2015-09-15 06:23:49 UTC (rev 3994) @@ -54,7 +54,6 @@ import(zoo) importFrom(MASS,ginv) importFrom(PerformanceAnalytics,Return.cumulative) -importFrom(PerformanceAnalytics,VaR) importFrom(PerformanceAnalytics,chart.ACFplus) importFrom(PerformanceAnalytics,chart.Correlation) importFrom(PerformanceAnalytics,chart.Histogram) Modified: pkg/FactorAnalytics/R/fmEsDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmEsDecomp.R 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/R/fmEsDecomp.R 2015-09-15 06:23:49 UTC (rev 3994) @@ -4,8 +4,8 @@ #' Expected Shortfall (ES) of assets' returns based on Euler's theorem, given #' the fitted factor model. The partial derivative of ES with respect to factor #' beta is computed as the expected factor return given fund return is less -#' than or equal to its value-at-risk (VaR). VaR is computed as the sample quantile of the historic or -#' simulated data. +#' than or equal to its value-at-risk (VaR). VaR is computed as the sample +#' quantile. #' #' @details The factor model for an asset's return at time \code{t} has the #' form \cr \cr \code{R(t) = beta'f(t) + e(t) = beta.star'f.star(t)} \cr \cr @@ -19,20 +19,9 @@ #' being less than or equal to \code{VaR.fm}. This is estimated as a sample #' average of the observations in that data window. #' -#' Computation of the VaR measure is done using -#' \code{\link[PerformanceAnalytics]{VaR}}. Arguments \code{p}, \code{method} -#' and \code{invert} are passed to this function. Refer to their help file for -#' details and other options. \code{invert} consistently affects the sign for -#' all VaR and ES measures. -#' #' @param object fit object of class \code{tsfm}, \code{sfm} or \code{ffm}. #' @param p confidence level for calculation. Default is 0.95. -#' @param method method for computing VaR, one of "modified","gaussian", -#' "historical", "kernel". Default is "modified". See details. -#' @param invert logical; whether to invert the VaR measure. Default is -#' \code{FALSE}. -#' @param ... other optional arguments passed to -#' \code{\link[PerformanceAnalytics]{VaR}}. +#' @param ... other optional arguments passed to \code{\link[stats]{quantile}}. #' #' @return A list containing #' \item{ES.fm}{length-N vector of factor model ES of N-asset returns.} @@ -63,7 +52,6 @@ #' @seealso \code{\link{fitTsfm}}, \code{\link{fitSfm}}, \code{\link{fitFfm}} #' for the different factor model fitting functions. #' -#' \code{\link[PerformanceAnalytics]{VaR}} for VaR computation. #' \code{\link{fmSdDecomp}} for factor model SD decomposition. #' \code{\link{fmVaRDecomp}} for factor model VaR decomposition. #' @@ -96,18 +84,8 @@ #' @method fmEsDecomp tsfm #' @export -fmEsDecomp.tsfm <- function(object, p=0.95, - method=c("modified","gaussian","historical", - "kernel"), invert=FALSE, ...) { +fmEsDecomp.tsfm <- function(object, p=0.95, ...) { - # set defaults and check input vailidity - method = method[1] - - if (!(method %in% c("modified", "gaussian", "historical", "kernel"))) { - stop("Invalid argument: method must be 'modified', 'gaussian', - 'historical' or 'kernel'") - } - # get beta.star beta <- object$beta beta[is.na(beta)] <- 0 @@ -137,7 +115,7 @@ # return data for asset i R.xts <- object$data[,i] # get VaR for asset i - VaR.fm[i] <- VaR(R.xts, p=p, method=method, invert=invert, ...) + VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) # index of VaR exceedances idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) # number of VaR exceedances @@ -147,18 +125,16 @@ factor.star <- merge(factors.xts, resid.xts[,i]) colnames(factor.star)[dim(factor.star)[2]] <- "residual" - if (!invert) {inv=-1} else {inv=1} - # compute ES as expected value of asset return, such that the given asset # return is less than or equal to its value-at-risk (VaR) and approximated # by a kernel estimator. - idx <- which(R.xts <= inv*VaR.fm[i]) - ES.fm[i] <- inv * mean(R.xts[idx], na.rm =TRUE) + idx <- which(R.xts <= VaR.fm[i]) + ES.fm[i] <- mean(R.xts[idx], na.rm =TRUE) # compute marginal ES as expected value of factor returns, such that the # given asset return is less than or equal to its value-at-risk (VaR) and # approximated by a kernel estimator. - mES[i,] <- inv * colMeans(factor.star[idx,], na.rm =TRUE) + mES[i,] <- colMeans(factor.star[idx,], na.rm =TRUE) # correction factor to ensure that sum(cES) = portfolio ES cf <- as.numeric( ES.fm[i] / sum(mES[i,]*beta.star[i,], na.rm=TRUE) ) @@ -180,18 +156,8 @@ #' @method fmEsDecomp sfm #' @export -fmEsDecomp.sfm <- function(object, p=0.95, - method=c("modified","gaussian","historical", - "kernel"), invert=FALSE, ...) { +fmEsDecomp.sfm <- function(object, p=0.95, ...) { - # set defaults and check input vailidity - method = method[1] - - if (!(method %in% c("modified", "gaussian", "historical", "kernel"))) { - stop("Invalid argument: method must be 'modified', 'gaussian', - 'historical' or 'kernel'") - } - # get beta.star beta <- object$loadings beta[is.na(beta)] <- 0 @@ -222,7 +188,7 @@ # return data for asset i R.xts <- object$data[,i] # get VaR for asset i - VaR.fm[i] <- VaR(R.xts, p=p, method=method, invert=invert, ...) + VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) # index of VaR exceedances idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) # number of VaR exceedances @@ -232,18 +198,16 @@ factor.star <- merge(factors.xts, resid.xts[,i]) colnames(factor.star)[dim(factor.star)[2]] <- "residual" - if (!invert) {inv=-1} else {inv=1} - # compute ES as expected value of asset return, such that the given asset # return is less than or equal to its value-at-risk (VaR) and approximated # by a kernel estimator. - idx <- which(R.xts <= inv*VaR.fm[i]) - ES.fm[i] <- inv * mean(R.xts[idx], na.rm =TRUE) + idx <- which(R.xts <= VaR.fm[i]) + ES.fm[i] <- mean(R.xts[idx], na.rm =TRUE) # compute marginal ES as expected value of factor returns, such that the # given asset return is less than or equal to its value-at-risk (VaR) and # approximated by a kernel estimator. - mES[i,] <- inv * colMeans(factor.star[idx,], na.rm =TRUE) + mES[i,] <- colMeans(factor.star[idx,], na.rm =TRUE) # correction factor to ensure that sum(cES) = portfolio ES cf <- as.numeric( ES.fm[i] / sum(mES[i,]*beta.star[i,], na.rm=TRUE) ) Modified: pkg/FactorAnalytics/R/fmVaRDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmVaRDecomp.R 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/R/fmVaRDecomp.R 2015-09-15 06:23:49 UTC (rev 3994) @@ -4,8 +4,7 @@ #' assets' returns based on Euler's theorem, given the fitted factor model. #' The partial derivative of VaR wrt factor beta is computed as the expected #' factor return given fund return is equal to its VaR and approximated by a -#' kernel estimator. VaR is computed either as the sample quantile or as an -#' estimated quantile using the Cornish-Fisher expansion. +#' kernel estimator. VaR is computed as the sample quantile. #' #' @details The factor model for an asset's return at time \code{t} has the #' form \cr \cr \code{R(t) = beta'f(t) + e(t) = beta.star'f.star(t)} \cr \cr @@ -19,19 +18,9 @@ #' being equal to \code{VaR.fm}. This is approximated as described in #' Epperlein & Smillie (2006); a triangular smoothing kernel is used here. #' -#' Computation of the risk measure is done using -#' \code{\link[PerformanceAnalytics]{VaR}}. Arguments \code{p}, \code{method} -#' and \code{invert} are passed to this function. Refer to their help file for -#' details and other options. -#' #' @param object fit object of class \code{tsfm}, \code{sfm} or \code{ffm}. #' @param p confidence level for calculation. Default is 0.95. -#' @param method method for computing VaR, one of "modified","gaussian", -#' "historical", "kernel". Default is "modified". See details. -#' @param invert logical; whether to invert the VaR measure. Default is -#' \code{FALSE}. -#' @param ... other optional arguments passed to -#' \code{\link[PerformanceAnalytics]{VaR}}. +#' @param ... other optional arguments passed to \code{\link[stats]{quantile}}. #' #' @return A list containing #' \item{VaR.fm}{length-N vector of factor model VaRs of N-asset returns.} @@ -59,7 +48,6 @@ #' @seealso \code{\link{fitTsfm}}, \code{\link{fitSfm}}, \code{\link{fitFfm}} #' for the different factor model fitting functions. #' -#' \code{\link[PerformanceAnalytics]{VaR}} for VaR computation. #' \code{\link{fmSdDecomp}} for factor model SD decomposition. #' \code{\link{fmEsDecomp}} for factor model ES decomposition. #' @@ -93,18 +81,8 @@ #' @method fmVaRDecomp tsfm #' @export -fmVaRDecomp.tsfm <- function(object, p=0.95, - method=c("modified","gaussian","historical", - "kernel"), invert=FALSE, ...) { +fmVaRDecomp.tsfm <- function(object, p=0.95, ...) { - # set defaults and check input vailidity - method = method[1] - - if (!(method %in% c("modified", "gaussian", "historical", "kernel"))) { - stop("Invalid argument: method must be 'modified', 'gaussian', - 'historical' or 'kernel'") - } - # get beta.star beta <- object$beta beta[is.na(beta)] <- 0 @@ -134,7 +112,7 @@ # return data for asset i R.xts <- object$data[,i] # get VaR for asset i - VaR.fm[i] <- VaR(R.xts, p=p, method=method, invert=invert, ...) + VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) # index of VaR exceedances idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) # number of VaR exceedances @@ -151,8 +129,6 @@ factor.star <- merge(factors.xts, resid.xts[,i]) colnames(factor.star)[dim(factor.star)[2]] <- "residual" - if (!invert) {inv=-1} else {inv=1} - # epsilon is apprx. using Silverman's rule of thumb (bandwidth selection) # the constant 2.575 corresponds to a triangular kernel eps <- 2.575*sd(R.xts, na.rm =TRUE) * (nrow(R.xts)^(-1/5)) @@ -161,7 +137,7 @@ # VaR value and bandwidth = epsilon. k.weight <- as.vector(1 - abs(R.xts - VaR.fm[i]) / eps) k.weight[k.weight<0] <- 0 - mVaR[i,] <- inv * colMeans(factor.star*k.weight, na.rm =TRUE) + mVaR[i,] <- colMeans(factor.star*k.weight, na.rm =TRUE) # correction factor to ensure that sum(cVaR) = portfolio VaR cf <- as.numeric( VaR.fm[i] / sum(mVaR[i,]*beta.star[i,], na.rm=TRUE) ) @@ -183,18 +159,8 @@ #' @method fmVaRDecomp sfm #' @export -fmVaRDecomp.sfm <- function(object, p=0.95, - method=c("modified","gaussian","historical", - "kernel"), invert=FALSE, ...) { +fmVaRDecomp.sfm <- function(object, p=0.95, ...) { - # set defaults and check input vailidity - method = method[1] - - if (!(method %in% c("modified", "gaussian", "historical", "kernel"))) { - stop("Invalid argument: method must be 'modified', 'gaussian', - 'historical' or 'kernel'") - } - # get beta.star beta <- object$loadings beta[is.na(beta)] <- 0 @@ -224,7 +190,7 @@ # return data for asset i R.xts <- object$data[,i] # get VaR for asset i - VaR.fm[i] <- VaR(R.xts, p=p, method=method, invert=invert, ...) + VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) # index of VaR exceedances idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) # number of VaR exceedances @@ -241,8 +207,6 @@ factor.star <- merge(factors.xts, resid.xts[,i]) colnames(factor.star)[dim(factor.star)[2]] <- "residual" - if (!invert) {inv=-1} else {inv=1} - # epsilon is apprx. using Silverman's rule of thumb (bandwidth selection) # the constant 2.575 corresponds to a triangular kernel eps <- 2.575*sd(R.xts, na.rm =TRUE) * (nrow(R.xts)^(-1/5)) @@ -251,7 +215,7 @@ # VaR value and bandwidth = epsilon. k.weight <- as.vector(1 - abs(R.xts - VaR.fm[i]) / eps) k.weight[k.weight<0] <- 0 - mVaR[i,] <- inv * colMeans(factor.star*k.weight, na.rm =TRUE) + mVaR[i,] <- colMeans(factor.star*k.weight, na.rm =TRUE) # correction factor to ensure that sum(cVaR) = portfolio VaR cf <- as.numeric( VaR.fm[i] / sum(mVaR[i,]*beta.star[i,], na.rm=TRUE) ) Modified: pkg/FactorAnalytics/R/plot.sfm.r =================================================================== --- pkg/FactorAnalytics/R/plot.sfm.r 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/R/plot.sfm.r 2015-09-15 06:23:49 UTC (rev 3994) @@ -82,9 +82,6 @@ #' in \code{plot}. Default is 1. #' @param lwd set the line width, same as in \code{\link{plot}}. Default is 2. #' @param maxlag optional number of lags to be calculated for ACF. Default is 15. -#' @param VaR.method a method for computing VaR; one of "modified", "gaussian", -#' "historical" or "kernel". VaR is computed using -#' \code{\link[PerformanceAnalytics]{VaR}}. Default is "historical". #' @param eig.max scalar in (0,1] for limiting the screeplot to factors that #' explain a given percent of the variance. Default is 0.9. #' @param cum.var logical; If \code{TRUE}, the cumulative fraction of the @@ -149,7 +146,7 @@ "goldenrod","mediumorchid","deepskyblue", "chocolate","darkslategray"), legend.loc="topleft", las=1, lwd=2, maxlag=15, - VaR.method="historical", eig.max=0.9, cum.var=TRUE, ...) { + eig.max=0.9, cum.var=TRUE, ...) { which.vec <- which which <- which[1] @@ -458,7 +455,7 @@ }, "10L" = { ## Factor Percentage Contribution to ES - pcES.fm <- fmEsDecomp(x, method=VaR.method)$pcES[a.sub,c(f.sub,k+1)] + pcES.fm <- fmEsDecomp(x)$pcES[a.sub,c(f.sub,k+1)] plot( barchart(pcES.fm, main="Factor % Contribution to ES", xlab="", auto.key=list(space="bottom",columns=3, points=FALSE,rectangles=TRUE), @@ -469,7 +466,7 @@ }, "11L" = { ## Factor Percentage Contribution to VaR - pcVaR.fm <- fmVaRDecomp(x, method=VaR.method)$pcVaR[a.sub,c(f.sub,k+1)] + pcVaR.fm <- fmVaRDecomp(x)$pcVaR[a.sub,c(f.sub,k+1)] plot( barchart(pcVaR.fm, main="Factor % Contribution to VaR", xlab="", auto.key=list(space="bottom",columns=3, points=FALSE,rectangles=TRUE), Modified: pkg/FactorAnalytics/R/plot.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/plot.tsfm.r 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/R/plot.tsfm.r 2015-09-15 06:23:49 UTC (rev 3994) @@ -92,9 +92,6 @@ #' in \code{plot}. Default is 1. #' @param lwd set the line width, same as in \code{\link{plot}}. Default is 2. #' @param maxlag optional number of lags to be calculated for ACF. Default is 15. -#' @param VaR.method a method for computing VaR; one of "modified", "gaussian", -#' "historical" or "kernel". VaR is computed using -#' \code{\link[PerformanceAnalytics]{VaR}}. Default is "historical". #' @param ... further arguments to be passed to other plotting functions. #' #' @author Eric Zivot, Sangeetha Srinivasan and Yi-An Chen @@ -151,8 +148,7 @@ colorset=c("royalblue","dimgray","olivedrab","firebrick", "goldenrod","mediumorchid","deepskyblue", "chocolate","darkslategray"), - legend.loc="topleft", las=1, lwd=2, maxlag=15, - VaR.method="historical", ...) { + legend.loc="topleft", las=1, lwd=2, maxlag=15, ...) { which.vec <- which which <- which[1] @@ -508,7 +504,7 @@ }, "10L"={ ## Factor percentage contribution to ES - pcES.fm <- fmEsDecomp(x, method=VaR.method)$pcES[a.sub,c(f.sub,k+1)] + pcES.fm <- fmEsDecomp(x)$pcES[a.sub,c(f.sub,k+1)] plot( barchart(pcES.fm, main="Factor % Contribution to ES", xlab="", auto.key=list(space="bottom",columns=3,points=FALSE,rectangles=TRUE), @@ -518,7 +514,7 @@ }, "11L" ={ ## Factor percentage contribution to VaR - pcVaR.fm <- fmVaRDecomp(x, method=VaR.method)$pcVaR[a.sub,c(f.sub,k+1)] + pcVaR.fm <- fmVaRDecomp(x)$pcVaR[a.sub,c(f.sub,k+1)] plot( barchart(pcVaR.fm, main="Factor % Contribution to VaR", xlab="", auto.key=list(space="bottom",columns=3,points=FALSE,rectangles=TRUE), Modified: pkg/FactorAnalytics/R/zzz.R =================================================================== --- pkg/FactorAnalytics/R/zzz.R 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/R/zzz.R 2015-09-15 06:23:49 UTC (rev 3994) @@ -2,7 +2,7 @@ #' @import zoo #' @import foreach -#' @importFrom PerformanceAnalytics checkData VaR Return.cumulative +#' @importFrom PerformanceAnalytics checkData Return.cumulative #' @importFrom robust lmRob step.lmRob #' @importFrom leaps regsubsets #' @importFrom lars lars cv.lars Modified: pkg/FactorAnalytics/man/fmEsDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmEsDecomp.Rd 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/man/fmEsDecomp.Rd 2015-09-15 06:23:49 UTC (rev 3994) @@ -8,25 +8,16 @@ \usage{ fmEsDecomp(object, ...) -\method{fmEsDecomp}{tsfm}(object, p = 0.95, method = c("modified", - "gaussian", "historical", "kernel"), invert = FALSE, ...) +\method{fmEsDecomp}{tsfm}(object, p = 0.95, ...) -\method{fmEsDecomp}{sfm}(object, p = 0.95, method = c("modified", - "gaussian", "historical", "kernel"), invert = FALSE, ...) +\method{fmEsDecomp}{sfm}(object, p = 0.95, ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.} -\item{...}{other optional arguments passed to -\code{\link[PerformanceAnalytics]{VaR}}.} +\item{...}{other optional arguments passed to \code{\link[stats]{quantile}}.} \item{p}{confidence level for calculation. Default is 0.95.} - -\item{method}{method for computing VaR, one of "modified","gaussian", -"historical", "kernel". Default is "modified". See details.} - -\item{invert}{logical; whether to invert the VaR measure. Default is -\code{FALSE}.} } \value{ A list containing @@ -44,8 +35,8 @@ Expected Shortfall (ES) of assets' returns based on Euler's theorem, given the fitted factor model. The partial derivative of ES with respect to factor beta is computed as the expected factor return given fund return is less -than or equal to its value-at-risk (VaR). VaR is computed as the sample quantile of the historic or -simulated data. +than or equal to its value-at-risk (VaR). VaR is computed as the sample +quantile. } \details{ The factor model for an asset's return at time \code{t} has the @@ -59,12 +50,6 @@ defined as the expected value of \code{F.star}, conditional on the loss being less than or equal to \code{VaR.fm}. This is estimated as a sample average of the observations in that data window. - -Computation of the VaR measure is done using -\code{\link[PerformanceAnalytics]{VaR}}. Arguments \code{p}, \code{method} -and \code{invert} are passed to this function. Refer to their help file for -details and other options. \code{invert} consistently affects the sign for -all VaR and ES measures. } \examples{ # Time Series Factor Model @@ -102,7 +87,6 @@ \code{\link{fitTsfm}}, \code{\link{fitSfm}}, \code{\link{fitFfm}} for the different factor model fitting functions. -\code{\link[PerformanceAnalytics]{VaR}} for VaR computation. \code{\link{fmSdDecomp}} for factor model SD decomposition. \code{\link{fmVaRDecomp}} for factor model VaR decomposition. } Modified: pkg/FactorAnalytics/man/fmVaRDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2015-09-15 06:23:49 UTC (rev 3994) @@ -8,25 +8,16 @@ \usage{ fmVaRDecomp(object, ...) -\method{fmVaRDecomp}{tsfm}(object, p = 0.95, method = c("modified", - "gaussian", "historical", "kernel"), invert = FALSE, ...) +\method{fmVaRDecomp}{tsfm}(object, p = 0.95, ...) -\method{fmVaRDecomp}{sfm}(object, p = 0.95, method = c("modified", - "gaussian", "historical", "kernel"), invert = FALSE, ...) +\method{fmVaRDecomp}{sfm}(object, p = 0.95, ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.} -\item{...}{other optional arguments passed to -\code{\link[PerformanceAnalytics]{VaR}}.} +\item{...}{other optional arguments passed to \code{\link[stats]{quantile}}.} \item{p}{confidence level for calculation. Default is 0.95.} - -\item{method}{method for computing VaR, one of "modified","gaussian", -"historical", "kernel". Default is "modified". See details.} - -\item{invert}{logical; whether to invert the VaR measure. Default is -\code{FALSE}.} } \value{ A list containing @@ -44,8 +35,7 @@ assets' returns based on Euler's theorem, given the fitted factor model. The partial derivative of VaR wrt factor beta is computed as the expected factor return given fund return is equal to its VaR and approximated by a -kernel estimator. VaR is computed either as the sample quantile or as an -estimated quantile using the Cornish-Fisher expansion. +kernel estimator. VaR is computed as the sample quantile. } \details{ The factor model for an asset's return at time \code{t} has the @@ -59,11 +49,6 @@ is defined as the expectation of \code{F.star}, conditional on the loss being equal to \code{VaR.fm}. This is approximated as described in Epperlein & Smillie (2006); a triangular smoothing kernel is used here. - -Computation of the risk measure is done using -\code{\link[PerformanceAnalytics]{VaR}}. Arguments \code{p}, \code{method} -and \code{invert} are passed to this function. Refer to their help file for -details and other options. } \examples{ # Time Series Factor Model @@ -99,7 +84,6 @@ \code{\link{fitTsfm}}, \code{\link{fitSfm}}, \code{\link{fitFfm}} for the different factor model fitting functions. -\code{\link[PerformanceAnalytics]{VaR}} for VaR computation. \code{\link{fmSdDecomp}} for factor model SD decomposition. \code{\link{fmEsDecomp}} for factor model ES decomposition. } Modified: pkg/FactorAnalytics/man/plot.sfm.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.sfm.Rd 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/man/plot.sfm.Rd 2015-09-15 06:23:49 UTC (rev 3994) @@ -8,8 +8,7 @@ plot.single = FALSE, asset.name, colorset = c("royalblue", "dimgray", "olivedrab", "firebrick", "goldenrod", "mediumorchid", "deepskyblue", "chocolate", "darkslategray"), legend.loc = "topleft", las = 1, lwd = 2, - maxlag = 15, VaR.method = "historical", eig.max = 0.9, cum.var = TRUE, - ...) + maxlag = 15, eig.max = 0.9, cum.var = TRUE, ...) } \arguments{ \item{x}{an object of class \code{sfm} produced by \code{fitSfm}.} @@ -84,10 +83,6 @@ \item{maxlag}{optional number of lags to be calculated for ACF. Default is 15.} -\item{VaR.method}{a method for computing VaR; one of "modified", "gaussian", -"historical" or "kernel". VaR is computed using -\code{\link[PerformanceAnalytics]{VaR}}. Default is "historical".} - \item{eig.max}{scalar in (0,1] for limiting the screeplot to factors that explain a given percent of the variance. Default is 0.9.} Modified: pkg/FactorAnalytics/man/plot.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.tsfm.Rd 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/man/plot.tsfm.Rd 2015-09-15 06:23:49 UTC (rev 3994) @@ -8,7 +8,7 @@ plot.single = FALSE, asset.name, colorset = c("royalblue", "dimgray", "olivedrab", "firebrick", "goldenrod", "mediumorchid", "deepskyblue", "chocolate", "darkslategray"), legend.loc = "topleft", las = 1, lwd = 2, - maxlag = 15, VaR.method = "historical", ...) + maxlag = 15, ...) } \arguments{ \item{x}{an object of class \code{tsfm} produced by \code{fitTsfm}.} @@ -80,10 +80,6 @@ \item{maxlag}{optional number of lags to be calculated for ACF. Default is 15.} -\item{VaR.method}{a method for computing VaR; one of "modified", "gaussian", -"historical" or "kernel". VaR is computed using -\code{\link[PerformanceAnalytics]{VaR}}. Default is "historical".} - \item{...}{further arguments to be passed to other plotting functions.} } \description{ Modified: pkg/FactorAnalytics/vignettes/fitSfm_vignette.R =================================================================== --- pkg/FactorAnalytics/vignettes/fitSfm_vignette.R 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/vignettes/fitSfm_vignette.R 2015-09-15 06:23:49 UTC (rev 3994) @@ -170,7 +170,7 @@ plot(fit.pca, which=9, f.sub=1:2, a.sub=1:15) ## ----fig.cap="Percentage factor contribution to VaR", fig.width=7, fig.height=5---- -decomp1 <- fmVaRDecomp(fit.apca, method="historical") +decomp1 <- fmVaRDecomp(fit.apca) names(decomp1) # factor model Value-at-Risk; print first 6 assets head(decomp1$VaR.fm) @@ -180,7 +180,7 @@ plot(fit.apca, which=11, f.sub=1:4, a.sub=1:6) ## ----fig.cap="Percentage factor contribution to ES", fig.width=7, fig.height=5---- -decomp2 <- fmEsDecomp(fit.apca, method="historical") +decomp2 <- fmEsDecomp(fit.apca) names(decomp2) # factor model Expected Shortfall; print first 6 assets head(decomp2$ES.fm) @@ -195,8 +195,8 @@ ## plot.single=FALSE, asset.name, ## colorset=c("royalblue","firebrick","olivedrab","firebrick","goldenrod", ## "mediumorchid","deepskyblue","chocolate","darkslategray"), -## legend.loc="topleft", las=1, lwd=2, maxlag=15, -## VaR.method="historical", eig.max=0.9, cum.var=TRUE, ...) +## legend.loc="topleft", las=1, lwd=2, maxlag=15, eig.max=0.9, +## cum.var=TRUE, ...) ## ----eval=FALSE, results='hide'------------------------------------------ ## plot(fit.pca) Modified: pkg/FactorAnalytics/vignettes/fitSfm_vignette.Rnw =================================================================== --- pkg/FactorAnalytics/vignettes/fitSfm_vignette.Rnw 2015-09-14 23:00:02 UTC (rev 3993) +++ pkg/FactorAnalytics/vignettes/fitSfm_vignette.Rnw 2015-09-15 06:23:49 UTC (rev 3994) @@ -65,9 +65,9 @@ \item \verb"fmSdDecomp(object, use, ...)": Returns a list containing the standard deviation of asset returns based on the fitted factor model and the marginal, component and percentage component factor contributions estimated from the given sample. \code{"use"} specifies how missing values are to be handled. -\item \verb"fmVaRDecomp(object, p, method, invert, ...)": Returns a list containing the value-at-risk for asset returns based on the fitted factor model and the marginal, component and percentage component factor contributions estimated from the given sample. \code{"p"} and \code{"method"} specify the confidence level and method (one of "modified","gaussian", "historical" or "kernel") to calculate VaR. VaR is by default a positive quantity and specifying \code{"invert=TRUE"} allows the VaR value to be expressed as a negative quantity. These 3 arguments, \code{"p"}, \code{"method"} and \code{"invert"} are passed on to the \code{VaR} function in the \code{PerformanceAnalytics} package to calculate VaR. +\item \verb"fmVaRDecomp(object, p, ...)": Returns a list containing the value-at-risk for asset returns based on the fitted factor model and the marginal, component and percentage component factor contributions estimated from the given sample. VaR is computed as the sample quantile and \code{"p"} specifies the confidence level. -\item \verb"fmEsDecomp(object, p, method, invert, ...)": Returns a list containing the expected shortfall for asset returns based on the fitted factor model and the marginal, component and percentage component factor contributions estimated from the given sample. Arguments \code{"p"}, \code{"method"} and \code{invert} are the same as above. +\item \verb"fmEsDecomp(object, p, ...)": Returns a list containing the expected shortfall for asset returns based on the fitted factor model and the marginal, component and percentage component factor contributions estimated from the given sample. \item \verb"plot(x)": The \code{plot} method for class "sfm" can be used for plotting factor model characteristics of a group of assets (default) or an individual asset. The user can select the type of plot either from the menu prompt or directly via argument \code{which}. In case multiple plots are needed, the menu is repeated after each plot (enter 0 to exit). User can also input a numeric vector of plot options via \code{which}. @@ -415,12 +415,12 @@ VaR.fm_i = \sum_{k=1}^{K+1} cVaR_{i,k} = \sum_{k=1}^{K+1} \beta^*_{i,k} \: mVaR_{i,k} \end{equation} -The marginal contribution to $VaR.fm$ is defined as the expectation of $F.star$, conditional on the loss being equal to $VaR.fm$. This is approximated as described in \citet{epperlein2006portfolio} using a triangular smoothing kernel. $VaR.fm$ calculation is performed using the function \code{VaR} from the \verb"PerformanceAnalytics" package. Refer to their help file for details and more options. +The marginal contribution to $VaR.fm$ is defined as the expectation of $F.star$, conditional on the loss being equal to $VaR.fm$. This is approximated as described in \citet{epperlein2006portfolio} using a triangular smoothing kernel. $VaR.fm$ is calculated as the sample quantile. \code{fmVaRDecomp} performs this decomposition for all assets in the given factor model fit object as shown below. The total VaR and component, marginal and percentage component contributions for each asset are returned. <>= -decomp1 <- fmVaRDecomp(fit.apca, method="historical") +decomp1 <- fmVaRDecomp(fit.apca) names(decomp1) # factor model Value-at-Risk; print first 6 assets head(decomp1$VaR.fm) @@ -437,12 +437,12 @@ ES.fm_i = \sum_{k=1}^{K+1} cES_{i,k} = \sum_{k=1}^{K+1} \beta^*_{i,k} \: mES_{i,k} \end{equation} -The marginal contribution to $ES.fm$ is defined as the expectation of $F.star$, conditional on the loss being less than or equal to $VaR.fm$. This is estimated as a sample average of the observations in that data window. Once again, $VaR.fm$ calculation is performed using the function \code{VaR} from the \verb"PerformanceAnalytics" package. Refer to their help file for details and more options. +The marginal contribution to $ES.fm$ is defined as the expectation of $F.star$, conditional on the loss being less than or equal to $VaR.fm$. This is estimated as a sample average of the observations in that data window. Once again, $VaR.fm$ is the sample quantile. -\code{fmEsDecomp} performs this decomposition for all assets in the given factor model fit object as shown below. In this example, \code{method} to calculate VaR is "historical" instead of the default "modified". The total ES and component, marginal and percentage component contributions for each asset are returned. +\code{fmEsDecomp} performs this decomposition for all assets in the given factor model fit object as shown below. The total ES and component, marginal and percentage component contributions for each asset are returned. <>= -decomp2 <- fmEsDecomp(fit.apca, method="historical") +decomp2 <- fmEsDecomp(fit.apca) names(decomp2) # factor model Expected Shortfall; print first 6 assets head(decomp2$ES.fm) @@ -462,8 +462,8 @@ plot.single=FALSE, asset.name, colorset=c("royalblue","firebrick","olivedrab","firebrick","goldenrod", "mediumorchid","deepskyblue","chocolate","darkslategray"), - legend.loc="topleft", las=1, lwd=2, maxlag=15, - VaR.method="historical", eig.max=0.9, cum.var=TRUE, ...) [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3994 From noreply at r-forge.r-project.org Wed Sep 16 15:22:45 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 16 Sep 2015 15:22:45 +0200 (CEST) Subject: [Returnanalytics-commits] r3995 - / pkg/FactorAnalytics pkg/FactorAnalytics/R pkg/FactorAnalytics/man Message-ID: <20150916132245.1ED1218795E@r-forge.r-project.org> Author: pragnya Date: 2015-09-16 15:22:44 +0200 (Wed, 16 Sep 2015) New Revision: 3995 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fitSfm.R pkg/FactorAnalytics/R/fitTsfm.R pkg/FactorAnalytics/R/zzz.R pkg/FactorAnalytics/man/Stock.df.Rd returnanalytics.Rproj Log: Add fitFfm for fitting fundamental factor models Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2015-09-15 06:23:49 UTC (rev 3994) +++ pkg/FactorAnalytics/DESCRIPTION 2015-09-16 13:22:44 UTC (rev 3995) @@ -1,8 +1,8 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version: 2.0.26 -Date: 2015-09-14 +Version: 2.0.27 +Date: 2015-09-16 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Description: Linear factor model fitting for asset returns (three major types- @@ -15,11 +15,13 @@ Depends: R (>= 3.0.0), xts (>= 0.9), - foreach (>= 1.4) + foreach (>= 1.4), + rrcov Imports: PerformanceAnalytics(>= 1.4), zoo, - corrplot, + corrplot, + robustbase, robust, leaps, lars, Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2015-09-15 06:23:49 UTC (rev 3994) +++ pkg/FactorAnalytics/NAMESPACE 2015-09-16 13:22:44 UTC (rev 3995) @@ -1,7 +1,9 @@ # Generated by roxygen2 (4.1.1): do not edit by hand +S3method(coef,ffm) S3method(coef,sfm) S3method(coef,tsfm) +S3method(fitted,ffm) S3method(fitted,sfm) S3method(fitted,tsfm) S3method(fmCov,sfm) @@ -26,6 +28,7 @@ S3method(print,summary.tsfmUpDn) S3method(print,tsfm) S3method(print,tsfmUpDn) +S3method(residuals,ffm) S3method(residuals,sfm) S3method(residuals,tsfm) S3method(summary,pafm) @@ -33,6 +36,7 @@ S3method(summary,tsfm) S3method(summary,tsfmUpDn) export(dCornishFisher) +export(fitFfm) export(fitSfm) export(fitTsfm) export(fitTsfmLagBeta) @@ -50,6 +54,7 @@ export(qCornishFisher) export(rCornishFisher) import(foreach) +import(rrcov) import(xts) import(zoo) importFrom(MASS,ginv) @@ -78,8 +83,12 @@ importFrom(parallel,detectCores) importFrom(parallel,makeCluster) importFrom(parallel,stopCluster) +importFrom(robust,covClassic) +importFrom(robust,covRob) importFrom(robust,lmRob) importFrom(robust,step.lmRob) +importFrom(robustbase,covOGK) +importFrom(robustbase,scaleTau2) importFrom(sandwich,vcovHAC.default) importFrom(sandwich,vcovHC.default) importFrom(sn,dst) Modified: pkg/FactorAnalytics/R/fitSfm.R =================================================================== --- pkg/FactorAnalytics/R/fitSfm.R 2015-09-15 06:23:49 UTC (rev 3994) +++ pkg/FactorAnalytics/R/fitSfm.R 2015-09-16 13:22:44 UTC (rev 3995) @@ -155,7 +155,7 @@ corr=FALSE, ...) { # record the call as an element to be returned - call <- match.call() + this.call <- match.call() # check input data type and coerce to xts; remove NAs R.xts <- na.omit(checkData(data, method="xts")) @@ -221,7 +221,7 @@ } # create list of return values. - input <- list(call=call, data=R.xts, asset.names=colnames(R.xts)) + input <- list(call=this.call, data=R.xts, asset.names=colnames(R.xts)) result <- c(result, input) class(result) <- "sfm" return(result) Modified: pkg/FactorAnalytics/R/fitTsfm.R =================================================================== --- pkg/FactorAnalytics/R/fitTsfm.R 2015-09-15 06:23:49 UTC (rev 3994) +++ pkg/FactorAnalytics/R/fitTsfm.R 2015-09-16 13:22:44 UTC (rev 3995) @@ -155,7 +155,7 @@ control=fitTsfm.control(...), ...) { # record the call as an element to be returned - call <- match.call() + this.call <- match.call() # set defaults and check input vailidity fit.method = fit.method[1] @@ -230,7 +230,7 @@ } else if (variable.selection == "lars") { result.lars <- SelectLars(dat.xts, asset.names, factor.names, lars.args, cv.lars.args, lars.criterion) - input <- list(call=call, data=dat.xts, asset.names=asset.names, + input <- list(call=this.call, data=dat.xts, asset.names=asset.names, factor.names=factor.names, mkt.name=mkt.name, fit.method=NULL, variable.selection=variable.selection) result <- c(result.lars, input) @@ -251,10 +251,14 @@ rownames(beta) <- asset.names # extract r2 and residual sd r2 <- sapply(reg.list, function(x) summary(x)$r.squared) - resid.sd <- sapply(reg.list, function(x) summary(x)$sigma) + if (fit.method=="DLS") { + resid.sd <- sapply(reg.list, function(x) sd(residuals(x))) + } else { + 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=dat.xts, + resid.sd=resid.sd, call=this.call, data=dat.xts, asset.names=asset.names, factor.names=factor.names, mkt.name=mkt.name, fit.method=fit.method, variable.selection=variable.selection) Modified: pkg/FactorAnalytics/R/zzz.R =================================================================== --- pkg/FactorAnalytics/R/zzz.R 2015-09-15 06:23:49 UTC (rev 3994) +++ pkg/FactorAnalytics/R/zzz.R 2015-09-16 13:22:44 UTC (rev 3995) @@ -1,15 +1,17 @@ #' @import xts #' @import zoo #' @import foreach +#' @import rrcov #' @importFrom PerformanceAnalytics checkData Return.cumulative -#' @importFrom robust lmRob step.lmRob +#' @importFrom robust lmRob step.lmRob covRob covClassic #' @importFrom leaps regsubsets #' @importFrom lars lars cv.lars #' @importFrom lmtest coeftest.default #' @importFrom sandwich vcovHC.default vcovHAC.default #' @importFrom MASS ginv #' @importFrom tseries tsbootstrap +#' @importFrom robustbase scaleTau2 covOGK #' @importFrom PerformanceAnalytics chart.TimeSeries chart.ACFplus #' chart.Histogram chart.QQPlot chart.Correlation Modified: pkg/FactorAnalytics/man/Stock.df.Rd =================================================================== --- pkg/FactorAnalytics/man/Stock.df.Rd 2015-09-15 06:23:49 UTC (rev 3994) +++ pkg/FactorAnalytics/man/Stock.df.Rd 2015-09-16 13:22:44 UTC (rev 3995) @@ -10,12 +10,18 @@ Date range: 1996-02-29 through 2003-12-31 } \details{ - ID variables: DATE, TICKER + Date variable: DATE - Continuous variables: RETURN, PRICE, VOLUME, SHARES.OUT, MARKET.EQUITY, + Stock ID: TICKER + + Stock return and price variables: RETURN, PRICE + + Numeric exposures: VOLUME, SHARES.OUT, MARKET.EQUITY, LTDEBT, NET.SALES, COMMON.EQUITY, NET.INCOME, STOCKHOLDERS.EQUITY, - LOG.MARKETCAP, LOG.PRICE, BOOK2MARKET + LOG.MARKETCAP, LOG.PRICE, BOOK2MARKET + Note: Numeric exposures are standardized as z-scores. + Categorical variables: GICS, GICS.INDUSTRY, GICS.SECTOR } \usage{ Modified: returnanalytics.Rproj =================================================================== --- returnanalytics.Rproj 2015-09-15 06:23:49 UTC (rev 3994) +++ returnanalytics.Rproj 2015-09-16 13:22:44 UTC (rev 3995) @@ -17,4 +17,4 @@ PackageInstallArgs: --no-multiarch --with-keep.source PackageBuildArgs: --resave-data PackageBuildBinaryArgs: --data-compress -PackageRoxygenize: rd,namespace +PackageRoxygenize: rd,namespace,vignette From noreply at r-forge.r-project.org Wed Sep 16 15:23:29 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 16 Sep 2015 15:23:29 +0200 (CEST) Subject: [Returnanalytics-commits] r3996 - in pkg/FactorAnalytics: R man Message-ID: <20150916132330.06E30187C14@r-forge.r-project.org> Author: pragnya Date: 2015-09-16 15:23:29 +0200 (Wed, 16 Sep 2015) New Revision: 3996 Added: pkg/FactorAnalytics/R/fitFfm.R pkg/FactorAnalytics/man/fitFfm.Rd Log: Add fitFfm Added: pkg/FactorAnalytics/R/fitFfm.R =================================================================== --- pkg/FactorAnalytics/R/fitFfm.R (rev 0) +++ pkg/FactorAnalytics/R/fitFfm.R 2015-09-16 13:23:29 UTC (rev 3996) @@ -0,0 +1,397 @@ +#' @title Fit a fundamental factor model using cross-sectional regression +#' +#' @description Fit a fundamental (cross-sectional) factor model using ordinary +#' least squares or robust regression. Fundamental factor models use observable +#' asset specific characteristics (or) fundamentals, like industry +#' classification, market capitalization, style classification (value, growth) +#' etc. to calculate the common risk factors. An object of class \code{"ffm"} +#' is returned. +#' +#' @details +#' Estimation method "LS" corresponds to ordinary least squares using +#' \code{\link[stats]{lm}} and "Rob" is robust regression using +#' \code{\link[robust]{lmRob}}. "WLS" is weighted least squares using estimates +#' of the residual variances from LS regression as weights (feasible GLS). +#' Similarly, "W-Rob" is weighted robust regression. +#' +#' \code{weight.var} specifies the variable (e.g. market-cap) used to weight +#' the exposures before converting them to z-scores in each time period. Default +#' option equally weights exposures of different assets each period. +#' +#' If \code{rob.scale=TRUE}, \code{\link[robust]{covRob}} is used to compute a +#' robust estimate of the factor covariance/correlation matrix, and, +#' \code{\link[robustbase]{scaleTau2}} is used to compute robust tau-estimates of +#' univariate scale for residuals during "WLS" or "W-Rob" regressions and for +#' standardizing numeric factor exposures into z-scores. +#' +#' At this time, the regression can contain only one character exposure +#' (industry, sector, country etc.), otherwise the exposure matrix will become +#' singular. Same is true of an intercept term. We hope to expand the function +#' to allow more than one dummy variable in the future. +#' +#' The original function was designed by Doug Martin and initially implemented +#' in S-PLUS by a number of University of Washington Ph.D. students: +#' Christopher Green, Eric Aldrich, and Yindeng Jiang. Guy Yollin ported the +#' function to R and Yi-An Chen modified that code. Sangeetha Srinivasan +#' re-factored, updated and expanded the functionalities and S3 methods. +#' +#' @param data data.frame of the balanced panel data containing the variables +#' \code{asset.var}, \code{ret.var}, \code{exposure.vars}, \code{date.var} and +#' optionally, \code{weight.var}. +#' @param asset.var character; name of the variable for asset names. +#' @param ret.var character; name of the variable for asset returns. +#' @param date.var character; name of the variable containing the dates +#' coercible to class \code{Date}. +#' @param exposure.vars vector; names of the variables containing the +#' fundamental factor exposures. +#' @param weight.var character; name of the variable containing the weights +#' used when standarizing factor exposures (converting exposures to z-scores). +#' Default is \code{NULL}. See Details. +#' @param fit.method method for estimating factor returns; one of "LS", "WLS" +#' "Rob" or "W-Rob". See details. Default is "LS". +#' @param rob.scale logical; If \code{TRUE}, robust estimates of covariance, +#' correlation and univariate scale are computed as appropriate (see Details). +#' Default is \code{FALSE}. +#' @param full.resid.cov logical; If \code{TRUE}, a full residual covariance +#' matrix is estimated. Otherwise, a diagonal residual covariance matrix is +#' estimated. Default is \code{FALSE}. +#' @param z.score logical; If \code{TRUE}, exposures will be converted to +#' z-scores; weights given by \code{weight.var}. Default is \code{FALSE}. +#' @param ... other arguments passed +#' +#' @return \code{fitFfm} returns an object of class \code{"ffm"} for which +#' \code{print}, \code{plot}, \code{predict} and \code{summary} methods exist. +#' +#' The generic accessor functions \code{coef}, \code{fitted} and +#' \code{residuals} extract various useful features of the fit object. +#' Additionally, \code{fmCov} computes the covariance matrix for asset returns +#' based on the fitted factor model. +#' +#' An object of class \code{"ffm"} is a list containing the following +#' components: +#' \item{asset.fit}{list of fitted objects for each asset. Each object is of +#' class \code{lm} if \code{fit.method="LS" or "WLS"}, or, class \code{lmRob} +#' if \code{fit.method="Rob" or "W-Rob"}.} +#' \item{beta}{N x K matrix of factor exposures for the last time period.} +#' \item{factor.returns}{xts object of K-factor returns (including intercept).} +#' \item{residuals}{xts object of residuals for N-assets.} +#' \item{r2}{length-T vector of R-squared values.} +#' \item{factor.cov}{N x N covariance matrix of the factor returns.} +#' \item{resid.cov}{N x N covariance matrix of residuals.} +#' \item{return.cov}{N x N return covariance estimated by the factor model, +#' using the factor exposures from the last time period.} +#' \item{factor.corr}{N x N correlation matrix of the factor returns.} +#' \item{resid.corr}{N x N correlation matrix of residuals.} +#' \item{return.corr}{N x N correlation matrix of asset returns.} +#' \item{resid.var}{length-N vector of residual variances.} +#' \item{call}{the matched function call.} +#' \item{data}{data frame object as input.} +#' \item{date.var}{date.var as input} +#' \item{ret.var}{ret.var as input} +#' \item{asset.var}{asset.var as input.} +#' \item{exposure.vars}{exposure.vars as input.} +#' \item{weight.var}{weight.var as input.} +#' \item{fit.method}{fit.method as input.} +#' \item{asset.names}{length-N vector of asset names.} +#' \item{factor.names}{length-K vector of factor.names.} +#' Where N is the number of assets, K is the number of factors (including the +#' intercept or dummy variables) and T is the number of time periods. +#' +#' @author Guy Yollin, Yi-An Chen and Sangeetha Srinivasan +#' +#' @references +#' Menchero, J. (2010). The Characteristics of Factor Portfolios. Journal of +#' Performance Measurement, 15(1), 52-62. +#' +#' Grinold, R. C., & Kahn, R. N. (2000). Active portfolio management (Second +#' Ed.). New York: McGraw-Hill. +#' +#' @seealso The \code{ffm} methods for generic functions: +#' \code{\link{plot.ffm}}, \code{\link{predict.ffm}}, +#' \code{\link{print.ffm}} and \code{\link{summary.ffm}}. +#' +#' And, the following extractor functions: \code{\link[stats]{coef}}, +#' \code{\link[stats]{fitted}}, \code{\link[stats]{residuals}}, +#' \code{\link{fmCov}}, \code{\link{fmSdDecomp}}, \code{\link{fmVaRDecomp}} +#' and \code{\link{fmEsDecomp}}. +#' +#' \code{\link{paFm}} for Performance Attribution. +#' +#' @examples +#' +#' # Load fundamental and return data +#' data(Stock.df) +#' +#' # fit a fundamental factor model +#' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") +#' fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", +#' date.var="DATE", exposure.vars=exposure.vars) +#' names(fit) +#' +#' # fit a BARRA Industry Factor Model +#' exposure.vars <- c("GICS.SECTOR") +#' fit1 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", +#' date.var="DATE", exposure.vars=exposure.vars, +#' fit.method="Rob", rob.scale=TRUE) +#' +#' # example with industry dummy included +#' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.INDUSTRY") +#' fit2 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", +#' date.var="DATE", exposure.vars=exposure.vars) +#' +#' @export + +fitFfm <- function(data, asset.var, ret.var, date.var, exposure.vars, + weight.var=NULL, fit.method=c("LS","WLS","Rob","W-Rob"), + rob.scale=FALSE, full.resid.cov=FALSE, z.score=FALSE, ...) { + + # record the call as an element to be returned + this.call <- match.call() + + # set defaults and check input validity + if (missing(data) || !is.data.frame(data)) { + stop("Invalid args: data must be a data.frame") + } + fit.method = fit.method[1] + if (!(fit.method %in% c("LS","WLS","Rob","W-Rob"))) { + stop("Invalid args: fit.method must be 'LS', 'WLS', 'Rob' or 'W-Rob'") + } + if (missing(asset.var) || !is.character(asset.var)) { + stop("Invalid args: asset.var must be a character string") + } + if (missing(date.var) || !is.character(date.var)) { + stop("Invalid args: date.var must be a character string") + } + if (missing(ret.var) || !is.character(ret.var)) { + stop("Invalid args: ret.var must be a character string") + } + if (missing(exposure.vars) || !is.character(exposure.vars)) { + stop("Invalid args: exposure.vars must be a character vector") + } + if (ret.var %in% exposure.vars) { + stop("Invalid args: ret.var can not also be an exposure") + } + if (!is.null(weight.var) && !is.character(weight.var)) { + stop("Invalid args: weight.var must be a character string") + } + if (!is.logical(rob.scale) || length(rob.scale) != 1) { + stop("Invalid args: control parameter 'rob.scale' must be logical") + } + if (!is.logical(full.resid.cov) || length(full.resid.cov) != 1) { + stop("Invalid args: control parameter 'full.resid.cov' must be logical") + } + if (!is.logical(z.score) || length(z.score) != 1) { + stop("Invalid args: control parameter 'z.score' must be logical") + } + + # ensure dates are in required format + data[[date.var]] <- as.Date(data[[date.var]]) + # extract unique time periods from data + time.periods <- unique(data[[date.var]]) + TP <- length(time.periods) + if (TP < 2) { + stop("Invalid args: at least 2 unique time periods are required to fit the + factor model") + } + + # order data.frame by date.var + data <- data[order(data[,date.var]),] + + # extract asset names from data + asset.names <- unique(data[[asset.var]]) + N <- length(asset.names) + + # check number & type of exposure; convert character exposures to dummy vars + which.numeric <- sapply(data[,exposure.vars,drop=FALSE], is.numeric) + exposures.num <- exposure.vars[which.numeric] + exposures.char <- exposure.vars[!which.numeric] + if (length(exposures.char) > 1) { + stop("Only one dummy variable can be included per regression at this time.") + } + + # convert numeric exposures to z-scores + if (z.score) { + if (!is.null(weight.var)) { + # weight exposures within each period using weight.var + w <- unlist(by(data=data, INDICES=data[[date.var]], + function(x) x[[weight.var]]/sum(x[[weight.var]]))) + } else { + w <- rep(1, nrow(data)) + } + # function to calculate z-scores for numeric exposures using weights w + z.score <- function (x, i, w, rob.scale) { + if (rob.scale) { + (x[[i]] - mean(w*x[[i]]))*1/scaleTau2(w*x[[i]]) + } else { + (x[[i]] - mean(w*x[[i]]))*1/sd(w*x[[i]]) + } + } + # calculate z-scores looping through all numeric exposures + for (i in exposures.num) { + std.expo.num <- by(data=data, INDICES=data[[date.var]], FUN=z.score, + i=i, w=w, rob.scale=rob.scale) + data[[i]] <- unlist(std.expo.num) + } + } + + # determine factor model formula to be passed to lm or lmRob + fm.formula <- paste(ret.var, "~", paste(exposure.vars, collapse="+")) + if (length(exposures.char)) { + fm.formula <- paste(fm.formula, "- 1") + data[, exposures.char] <- as.factor(data[,exposures.char]) + contrasts.list <- lapply(seq(length(exposures.char)), function(i) + function(n) contr.treatment(n, contrasts=FALSE)) + names(contrasts.list) <- exposures.char + } else { + contrasts.list <- NULL + } + # convert the pasted expression into a formula object + fm.formula <- as.formula(fm.formula) + + # estimate factor returns using LS or Robust regression + # returns a list of the fitted lm or lmRob objects for each time period + if (grepl("LS",fit.method)) { + reg.list <- by(data=data, INDICES=data[[date.var]], FUN=lm, + formula=fm.formula, contrasts=contrasts.list, + na.action=na.fail) + } else if (grepl("Rob",fit.method)) { + reg.list <- by(data=data, INDICES=data[[date.var]], FUN=lmRob, + formula=fm.formula, contrasts=contrasts.list, + mxr=200, mxf=200, mxs=200, na.action=na.fail) + } + + # compute residual variance for all assets for weighted regression + if (grepl("W",fit.method)) { + if (rob.scale) { + resid.var <- apply(sapply(reg.list, residuals), 1, scaleTau2)^2 + } else { + resid.var <- apply(sapply(reg.list, residuals), 1, var) + } + } + + # estimate factor returns using WLS or weighted-Robust regression + # returns a list of the fitted lm or lmRob objects for each time period + if (fit.method=="WLS") { + reg.list <- by(data=data, INDICES=data[[date.var]], FUN=lm, + formula=fm.formula, contrasts=contrasts.list, + na.action=na.fail, w=resid.var) + } else if (fit.method=="W-Rob") { + reg.list <- by(data=data, INDICES=data[[date.var]], FUN=lmRob, + formula=fm.formula, contrasts=contrasts.list, + mxr=200, mxf=200, mxs=200, na.action=na.fail, w=resid.var) + } + + ## Compute or Extract objects to be returned + + # number of factors including Intercept and dummy variables + if (length(exposures.char)) { + factor.names <- c(exposures.num, + paste(exposures.char,levels(data[,exposures.char]),sep="")) + } else { + factor.names <- c("(Intercept)", exposures.num) + } + K <- length(factor.names) + + # exposure matrix B or beta for the last time period - N x K + DATE=NULL # to avoid R CMD check NOTE about no visible binding for global var + beta <- model.matrix(fm.formula, data=subset(data, DATE==time.periods[TP])) + rownames(beta) <- asset.names + + # time series of factor returns = estimated coefficients in each period + factor.returns <- sapply(reg.list, function(x) { + temp <- coef(x) + temp[match(factor.names, names(temp))]}) + rownames(factor.returns) <- factor.names + factor.returns <- checkData(t(factor.returns)) # T x K + + # time series of residuals + residuals <- checkData(t(sapply(reg.list, residuals))) # T x N + names(residuals) <- asset.names + + # r-squared values for each time period + r2 <- sapply(reg.list, function(x) summary(x)$r.squared) + + # factor and residual covariances + if (rob.scale) { + if (kappa(na.exclude(coredata(factor.returns))) < 1e+10) { + factor.cov <- covRob(coredata(factor.returns), estim="pairwiseGK", + distance=FALSE, na.action=na.omit)$cov + } else { + cat("Covariance matrix of factor returns is singular.\n") + factor.cov <- covRob(coredata(factor.returns), distance=FALSE, + na.action=na.omit)$cov + } + resid.var <- apply(coredata(residuals), 2, scaleTau2, na.rm=T)^2 + if (full.resid.cov) { + resid.cov <- covOGK(coredata(residuals), sigmamu=scaleTau2, n.iter=1)$cov + } else { + resid.cov <- diag(resid.var) + } + } else { + factor.cov <- covClassic(coredata(factor.returns), distance=FALSE, + na.action=na.omit)$cov + resid.var <- apply(coredata(residuals), 2, var, na.rm=T) + if (full.resid.cov) { + resid.cov <- covClassic(coredata(residuals), distance=FALSE, + na.action=na.omit)$cov + } else { + resid.cov <- diag(resid.var) + } + } + + # return covariance estimated by the factor model + return.cov <- beta %*% factor.cov %*% t(beta) + resid.cov + + # factor, residual and return correlations + factor.corr <- cov2cor(factor.cov) + resid.corr <- cov2cor(resid.cov) + return.corr <- cov2cor(return.cov) + + # create list of return values. + result <- list(asset.fit=reg.list, beta=beta, factor.returns=factor.returns, + residuals=residuals, r2=r2, factor.cov=factor.cov, + resid.cov=resid.cov, return.cov=return.cov, + factor.corr=factor.corr, resid.corr=resid.corr, + return.corr=return.corr, resid.var=resid.var, call=this.call, + data=data, date.var=date.var, ret.var=ret.var, + asset.var=asset.var, exposure.vars=exposure.vars, + weight.var=weight.var, fit.method=fit.method, + asset.names=asset.names, factor.names=factor.names) + + class(result) <- "ffm" + return(result) +} + + +#' @param object a fit object of class \code{ffm} which is returned by +#' \code{fitFfm} + +#' @rdname fitFfm +#' @method coef ffm +#' @export + +coef.ffm <- function(object, ...) { + # these are the last period factor exposures + # already computed through fitFfm + return(object$beta) +} + +#' @rdname fitFfm +#' @method fitted ffm +#' @export + +fitted.ffm <- function(object, ...) { + # get fitted values for all assets in each time period + # transpose and convert into xts/zoo objects + fitted.xts <- checkData(t(sapply(object$asset.fit, fitted))) + names(fitted.xts) <- object$asset.names + return(fitted.xts) +} + +#' @rdname fitFfm +#' @method residuals ffm +#' @export + +residuals.ffm <- function(object, ...) { + return(object$residuals) +} Added: pkg/FactorAnalytics/man/fitFfm.Rd =================================================================== --- pkg/FactorAnalytics/man/fitFfm.Rd (rev 0) +++ pkg/FactorAnalytics/man/fitFfm.Rd 2015-09-16 13:23:29 UTC (rev 3996) @@ -0,0 +1,176 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/fitFfm.R +\name{fitFfm} +\alias{coef.ffm} +\alias{fitFfm} +\alias{fitted.ffm} +\alias{residuals.ffm} +\title{Fit a fundamental factor model using cross-sectional regression} +\usage{ +fitFfm(data, asset.var, ret.var, date.var, exposure.vars, weight.var = NULL, + fit.method = c("LS", "WLS", "Rob", "W-Rob"), rob.scale = FALSE, + full.resid.cov = FALSE, z.score = FALSE, ...) + +\method{coef}{ffm}(object, ...) + +\method{fitted}{ffm}(object, ...) + +\method{residuals}{ffm}(object, ...) +} +\arguments{ +\item{data}{data.frame of the balanced panel data containing the variables +\code{asset.var}, \code{ret.var}, \code{exposure.vars}, \code{date.var} and +optionally, \code{weight.var}.} + +\item{asset.var}{character; name of the variable for asset names.} + +\item{ret.var}{character; name of the variable for asset returns.} + +\item{date.var}{character; name of the variable containing the dates +coercible to class \code{Date}.} + +\item{exposure.vars}{vector; names of the variables containing the +fundamental factor exposures.} + +\item{weight.var}{character; name of the variable containing the weights +used when standarizing factor exposures (converting exposures to z-scores). +Default is \code{NULL}. See Details.} + +\item{fit.method}{method for estimating factor returns; one of "LS", "WLS" +"Rob" or "W-Rob". See details. Default is "LS".} + +\item{rob.scale}{logical; If \code{TRUE}, robust estimates of covariance, +correlation and univariate scale are computed as appropriate (see Details). +Default is \code{FALSE}.} + +\item{full.resid.cov}{logical; If \code{TRUE}, a full residual covariance +matrix is estimated. Otherwise, a diagonal residual covariance matrix is +estimated. Default is \code{FALSE}.} + +\item{z.score}{logical; If \code{TRUE}, exposures will be converted to +z-scores; weights given by \code{weight.var}. Default is \code{FALSE}.} + +\item{...}{other arguments passed} + +\item{object}{a fit object of class \code{ffm} which is returned by +\code{fitFfm}} +} +\value{ +\code{fitFfm} returns an object of class \code{"ffm"} for which +\code{print}, \code{plot}, \code{predict} and \code{summary} methods exist. + +The generic accessor functions \code{coef}, \code{fitted} and +\code{residuals} extract various useful features of the fit object. +Additionally, \code{fmCov} computes the covariance matrix for asset returns +based on the fitted factor model. + +An object of class \code{"ffm"} is a list containing the following +components: +\item{asset.fit}{list of fitted objects for each asset. Each object is of +class \code{lm} if \code{fit.method="LS" or "WLS"}, or, class \code{lmRob} +if \code{fit.method="Rob" or "W-Rob"}.} +\item{beta}{N x K matrix of factor exposures for the last time period.} +\item{factor.returns}{xts object of K-factor returns (including intercept).} +\item{residuals}{xts object of residuals for N-assets.} +\item{r2}{length-T vector of R-squared values.} +\item{factor.cov}{N x N covariance matrix of the factor returns.} +\item{resid.cov}{N x N covariance matrix of residuals.} +\item{return.cov}{N x N return covariance estimated by the factor model, +using the factor exposures from the last time period.} +\item{factor.corr}{N x N correlation matrix of the factor returns.} +\item{resid.corr}{N x N correlation matrix of residuals.} +\item{return.corr}{N x N correlation matrix of asset returns.} +\item{resid.var}{length-N vector of residual variances.} +\item{call}{the matched function call.} +\item{data}{data frame object as input.} +\item{date.var}{date.var as input} +\item{ret.var}{ret.var as input} +\item{asset.var}{asset.var as input.} +\item{exposure.vars}{exposure.vars as input.} +\item{weight.var}{weight.var as input.} +\item{fit.method}{fit.method as input.} +\item{asset.names}{length-N vector of asset names.} +\item{factor.names}{length-K vector of factor.names.} +Where N is the number of assets, K is the number of factors (including the +intercept or dummy variables) and T is the number of time periods. +} +\description{ +Fit a fundamental (cross-sectional) factor model using ordinary +least squares or robust regression. Fundamental factor models use observable +asset specific characteristics (or) fundamentals, like industry +classification, market capitalization, style classification (value, growth) +etc. to calculate the common risk factors. An object of class \code{"ffm"} +is returned. +} +\details{ +Estimation method "LS" corresponds to ordinary least squares using +\code{\link[stats]{lm}} and "Rob" is robust regression using +\code{\link[robust]{lmRob}}. "WLS" is weighted least squares using estimates +of the residual variances from LS regression as weights (feasible GLS). +Similarly, "W-Rob" is weighted robust regression. + +\code{weight.var} specifies the variable (e.g. market-cap) used to weight +the exposures before converting them to z-scores in each time period. Default +option equally weights exposures of different assets each period. + +If \code{rob.scale=TRUE}, \code{\link[robust]{covRob}} is used to compute a +robust estimate of the factor covariance/correlation matrix, and, +\code{\link[robustbase]{scaleTau2}} is used to compute robust tau-estimates of +univariate scale for residuals during "WLS" or "W-Rob" regressions and for +standardizing numeric factor exposures into z-scores. + +At this time, the regression can contain only one character exposure +(industry, sector, country etc.), otherwise the exposure matrix will become +singular. Same is true of an intercept term. We hope to expand the function +to allow more than one dummy variable in the future. + +The original function was designed by Doug Martin and initially implemented +in S-PLUS by a number of University of Washington Ph.D. students: +Christopher Green, Eric Aldrich, and Yindeng Jiang. Guy Yollin ported the +function to R and Yi-An Chen modified that code. Sangeetha Srinivasan +re-factored, updated and expanded the functionalities and S3 methods. +} +\examples{ +# Load fundamental and return data +data(Stock.df) + +# fit a fundamental factor model +exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") +fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", + date.var="DATE", exposure.vars=exposure.vars) +names(fit) + +# fit a BARRA Industry Factor Model +exposure.vars <- c("GICS.SECTOR") +fit1 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", + date.var="DATE", exposure.vars=exposure.vars, + fit.method="Rob", rob.scale=TRUE) + +# example with industry dummy included +exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.INDUSTRY") +fit2 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", + date.var="DATE", exposure.vars=exposure.vars) +} +\author{ +Guy Yollin, Yi-An Chen and Sangeetha Srinivasan +} +\references{ +Menchero, J. (2010). The Characteristics of Factor Portfolios. Journal of +Performance Measurement, 15(1), 52-62. + +Grinold, R. C., & Kahn, R. N. (2000). Active portfolio management (Second +Ed.). New York: McGraw-Hill. +} +\seealso{ +The \code{ffm} methods for generic functions: +\code{\link{plot.ffm}}, \code{\link{predict.ffm}}, +\code{\link{print.ffm}} and \code{\link{summary.ffm}}. + +And, the following extractor functions: \code{\link[stats]{coef}}, +\code{\link[stats]{fitted}}, \code{\link[stats]{residuals}}, +\code{\link{fmCov}}, \code{\link{fmSdDecomp}}, \code{\link{fmVaRDecomp}} +and \code{\link{fmEsDecomp}}. + +\code{\link{paFm}} for Performance Attribution. +} + From noreply at r-forge.r-project.org Mon Sep 21 08:57:49 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 21 Sep 2015 08:57:49 +0200 (CEST) Subject: [Returnanalytics-commits] r3997 - in pkg/FactorAnalytics: . R man Message-ID: <20150921065749.1F5DC18765E@r-forge.r-project.org> Author: pragnya Date: 2015-09-21 08:57:48 +0200 (Mon, 21 Sep 2015) New Revision: 3997 Added: pkg/FactorAnalytics/R/print.ffm.R pkg/FactorAnalytics/man/print.ffm.Rd Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fitFfm.R pkg/FactorAnalytics/R/print.sfm.r pkg/FactorAnalytics/R/print.tsfm.r pkg/FactorAnalytics/man/fitFfm.Rd pkg/FactorAnalytics/man/print.sfm.Rd pkg/FactorAnalytics/man/print.tsfm.Rd Log: Add print method for fitFfm; Fixed bug in the weighted regression method Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2015-09-16 13:23:29 UTC (rev 3996) +++ pkg/FactorAnalytics/DESCRIPTION 2015-09-21 06:57:48 UTC (rev 3997) @@ -1,8 +1,8 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version: 2.0.27 -Date: 2015-09-16 +Version: 2.0.28 +Date: 2015-09-21 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Description: Linear factor model fitting for asset returns (three major types- @@ -16,7 +16,7 @@ R (>= 3.0.0), xts (>= 0.9), foreach (>= 1.4), - rrcov + rrcov (>= 1.3) Imports: PerformanceAnalytics(>= 1.4), zoo, Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2015-09-16 13:23:29 UTC (rev 3996) +++ pkg/FactorAnalytics/NAMESPACE 2015-09-21 06:57:48 UTC (rev 3997) @@ -21,6 +21,7 @@ S3method(predict,sfm) S3method(predict,tsfm) S3method(predict,tsfmUpDn) +S3method(print,ffm) S3method(print,pafm) S3method(print,sfm) S3method(print,summary.sfm) Modified: pkg/FactorAnalytics/R/fitFfm.R =================================================================== --- pkg/FactorAnalytics/R/fitFfm.R 2015-09-16 13:23:29 UTC (rev 3996) +++ pkg/FactorAnalytics/R/fitFfm.R 2015-09-21 06:57:48 UTC (rev 3997) @@ -14,20 +14,27 @@ #' of the residual variances from LS regression as weights (feasible GLS). #' Similarly, "W-Rob" is weighted robust regression. #' -#' \code{weight.var} specifies the variable (e.g. market-cap) used to weight -#' the exposures before converting them to z-scores in each time period. Default -#' option equally weights exposures of different assets each period. +#' Standardizing style factor exposures: The exposures can be standardized into +#' z-scores using regular or robust (see \code{rob.stats}) measures of location +#' and scale. Further, \code{weight.var}, a variable such as market-cap, can be +#' used to compute the weighted mean exposure, and an equal-weighted standard +#' deviation of the exposures about the weighted mean. This may help avoid an +#' ill-conditioned covariance matrix. Default option equally weights exposures +#' of different assets each period. #' -#' If \code{rob.scale=TRUE}, \code{\link[robust]{covRob}} is used to compute a +#' If \code{rob.stats=TRUE}, \code{\link[robust]{covRob}} is used to compute a #' robust estimate of the factor covariance/correlation matrix, and, -#' \code{\link[robustbase]{scaleTau2}} is used to compute robust tau-estimates of -#' univariate scale for residuals during "WLS" or "W-Rob" regressions and for -#' standardizing numeric factor exposures into z-scores. +#' \code{\link[robustbase]{scaleTau2}} is used to compute robust tau-estimates +#' of univariate scale for residuals during "WLS" or "W-Rob" regressions. When +#' standardizing style exposures, the \code{\link[stats]{median}} and +#' \code{\link[stats]{mad}} are used for location and scale respectively. #' -#' At this time, the regression can contain only one character exposure -#' (industry, sector, country etc.), otherwise the exposure matrix will become -#' singular. Same is true of an intercept term. We hope to expand the function -#' to allow more than one dummy variable in the future. +#' At this time, the regression can contain only one dummy exposure (one of +#' industry, sector, country etc.) or intercept term, otherwise the exposure +#' matrix will become singular. We plan to expand the function to allow +#' specifying more than one dummy variable, and, dummy variable(s) in +#' combination with an intercept term in the future. (Ex: Country + Sector + +#' Intercept) #' #' The original function was designed by Doug Martin and initially implemented #' in S-PLUS by a number of University of Washington Ph.D. students: @@ -45,19 +52,19 @@ #' @param exposure.vars vector; names of the variables containing the #' fundamental factor exposures. #' @param weight.var character; name of the variable containing the weights -#' used when standarizing factor exposures (converting exposures to z-scores). -#' Default is \code{NULL}. See Details. +#' used when standarizing style factor exposures. Default is \code{NULL}. See +#' Details. #' @param fit.method method for estimating factor returns; one of "LS", "WLS" #' "Rob" or "W-Rob". See details. Default is "LS". -#' @param rob.scale logical; If \code{TRUE}, robust estimates of covariance, -#' correlation and univariate scale are computed as appropriate (see Details). -#' Default is \code{FALSE}. +#' @param rob.stats logical; If \code{TRUE}, robust estimates of covariance, +#' correlation, location and univariate scale are computed as appropriate (see +#' Details). Default is \code{FALSE}. #' @param full.resid.cov logical; If \code{TRUE}, a full residual covariance #' matrix is estimated. Otherwise, a diagonal residual covariance matrix is #' estimated. Default is \code{FALSE}. -#' @param z.score logical; If \code{TRUE}, exposures will be converted to +#' @param z.score logical; If \code{TRUE}, style exposures will be converted to #' z-scores; weights given by \code{weight.var}. Default is \code{FALSE}. -#' @param ... other arguments passed +#' @param ... potentially further arguments passed. #' #' @return \code{fitFfm} returns an object of class \code{"ffm"} for which #' \code{print}, \code{plot}, \code{predict} and \code{summary} methods exist. @@ -94,8 +101,9 @@ #' \item{fit.method}{fit.method as input.} #' \item{asset.names}{length-N vector of asset names.} #' \item{factor.names}{length-K vector of factor.names.} +#' \item{time.periods}{length-T vector of dates.} #' Where N is the number of assets, K is the number of factors (including the -#' intercept or dummy variables) and T is the number of time periods. +#' intercept or dummy variables) and T is the number of unique time periods. #' #' @author Guy Yollin, Yi-An Chen and Sangeetha Srinivasan #' @@ -132,10 +140,10 @@ #' exposure.vars <- c("GICS.SECTOR") #' fit1 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", #' date.var="DATE", exposure.vars=exposure.vars, -#' fit.method="Rob", rob.scale=TRUE) +#' fit.method="Rob", rob.stats=TRUE) #' -#' # example with industry dummy included -#' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.INDUSTRY") +#' # example with sector dummy included +#' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.SECTOR") #' fit2 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", #' date.var="DATE", exposure.vars=exposure.vars) #' @@ -143,7 +151,7 @@ fitFfm <- function(data, asset.var, ret.var, date.var, exposure.vars, weight.var=NULL, fit.method=c("LS","WLS","Rob","W-Rob"), - rob.scale=FALSE, full.resid.cov=FALSE, z.score=FALSE, ...) { + rob.stats=FALSE, full.resid.cov=FALSE, z.score=FALSE, ...) { # record the call as an element to be returned this.call <- match.call() @@ -174,8 +182,8 @@ if (!is.null(weight.var) && !is.character(weight.var)) { stop("Invalid args: weight.var must be a character string") } - if (!is.logical(rob.scale) || length(rob.scale) != 1) { - stop("Invalid args: control parameter 'rob.scale' must be logical") + if (!is.logical(rob.stats) || length(rob.stats) != 1) { + stop("Invalid args: control parameter 'rob.stats' must be logical") } if (!is.logical(full.resid.cov) || length(full.resid.cov) != 1) { stop("Invalid args: control parameter 'full.resid.cov' must be logical") @@ -218,18 +226,10 @@ } else { w <- rep(1, nrow(data)) } - # function to calculate z-scores for numeric exposures using weights w - z.score <- function (x, i, w, rob.scale) { - if (rob.scale) { - (x[[i]] - mean(w*x[[i]]))*1/scaleTau2(w*x[[i]]) - } else { - (x[[i]] - mean(w*x[[i]]))*1/sd(w*x[[i]]) - } - } # calculate z-scores looping through all numeric exposures for (i in exposures.num) { std.expo.num <- by(data=data, INDICES=data[[date.var]], FUN=z.score, - i=i, w=w, rob.scale=rob.scale) + i=i, w=w, rob.stats=rob.stats) data[[i]] <- unlist(std.expo.num) } } @@ -262,23 +262,30 @@ # compute residual variance for all assets for weighted regression if (grepl("W",fit.method)) { - if (rob.scale) { + if (rob.stats) { resid.var <- apply(sapply(reg.list, residuals), 1, scaleTau2)^2 } else { resid.var <- apply(sapply(reg.list, residuals), 1, var) } + # add column of weights to data replicating resid.var for each period + data <- cbind(data, W=resid.var) } # estimate factor returns using WLS or weighted-Robust regression # returns a list of the fitted lm or lmRob objects for each time period if (fit.method=="WLS") { - reg.list <- by(data=data, INDICES=data[[date.var]], FUN=lm, - formula=fm.formula, contrasts=contrasts.list, - na.action=na.fail, w=resid.var) + reg.list <- by(data=data, INDICES=data[[date.var]], + FUN=function(x) { + lm(data=x, formula=fm.formula, contrasts=contrasts.list, + na.action=na.fail, weights=~W) + }) } else if (fit.method=="W-Rob") { - reg.list <- by(data=data, INDICES=data[[date.var]], FUN=lmRob, - formula=fm.formula, contrasts=contrasts.list, - mxr=200, mxf=200, mxs=200, na.action=na.fail, w=resid.var) + reg.list <- by(data=data, INDICES=data[[date.var]], + FUN=function(x) { + lmRob(data=x, formula=fm.formula, contrasts=contrasts.list, + na.action=na.fail, weights=~W, + mxr=200, mxf=200, mxs=200) + }) } ## Compute or Extract objects to be returned @@ -293,7 +300,7 @@ K <- length(factor.names) # exposure matrix B or beta for the last time period - N x K - DATE=NULL # to avoid R CMD check NOTE about no visible binding for global var + DATE=NULL # to avoid R CMD check's NOTE: no visible binding for global var beta <- model.matrix(fm.formula, data=subset(data, DATE==time.periods[TP])) rownames(beta) <- asset.names @@ -301,6 +308,10 @@ factor.returns <- sapply(reg.list, function(x) { temp <- coef(x) temp[match(factor.names, names(temp))]}) + # simplify factor.names for dummy variables + if (length(exposures.char)) { + factor.names <- c(exposures.num, levels(data[,exposures.char])) + } rownames(factor.returns) <- factor.names factor.returns <- checkData(t(factor.returns)) # T x K @@ -312,7 +323,7 @@ r2 <- sapply(reg.list, function(x) summary(x)$r.squared) # factor and residual covariances - if (rob.scale) { + if (rob.stats) { if (kappa(na.exclude(coredata(factor.returns))) < 1e+10) { factor.cov <- covRob(coredata(factor.returns), estim="pairwiseGK", distance=FALSE, na.action=na.omit)$cov @@ -356,13 +367,31 @@ data=data, date.var=date.var, ret.var=ret.var, asset.var=asset.var, exposure.vars=exposure.vars, weight.var=weight.var, fit.method=fit.method, - asset.names=asset.names, factor.names=factor.names) + asset.names=asset.names, factor.names=factor.names, + time.periods=time.periods) class(result) <- "ffm" return(result) } +### function to calculate z-scores for numeric exposure i using weights w +## x is a data.frame object, i is a character string and w has same length as x +# rob.stats is a logical argument to compute robust location and scale + +z.score <- function (x, i, w, rob.stats) { + if (rob.stats) { + x_bar <- median(w*x[[i]]) + (x[[i]] - x_bar)/mad(x[[i]], center=x_bar) + } else { + x_bar <- mean(w*x[[i]]) + n <- length(x[[i]]) + # use equal weighted squared deviation about the weighted mean + (x[[i]] - x_bar)/sqrt((x[[i]]-x_bar)^2/(n-1)) + } +} + + #' @param object a fit object of class \code{ffm} which is returned by #' \code{fitFfm} Added: pkg/FactorAnalytics/R/print.ffm.R =================================================================== --- pkg/FactorAnalytics/R/print.ffm.R (rev 0) +++ pkg/FactorAnalytics/R/print.ffm.R 2015-09-21 06:57:48 UTC (rev 3997) @@ -0,0 +1,43 @@ +#' @title Prints a fitted fundamental factor model +#' +#' @description S3 \code{print} method for object of class \code{ffm}. Prints +#' the call, factor model dimension and summary statistics for the estimated +#' factor returns, cross-sectional r-squared values and residual variances +#' from the fitted object. +#' +#' @param x an object of class \code{ffm} produced by \code{fitFfm}. +#' @param digits an integer value, to indicate the required number of +#' significant digits. Default is 3. +#' @param ... optional arguments passed to the \code{print} method. +#' +#' @author Yi-An Chen and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitFfm}}, \code{\link{summary.ffm}} +#' +#' @examples +#' data(Stock.df) +#' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") +#' fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", +#' date.var="DATE", exposure.vars=exposure.vars) +#' print(fit) +#' +#' @method print ffm +#' @export +#' + +print.ffm <- function(x, digits=max(3, .Options$digits - 3), ...){ + if(!is.null(cl <- x$call)){ + cat("\nCall:\n") + dput(cl) + } + cat("\nModel dimensions:\n") + tmp <- c(dim(t(x$beta)), length(x$time.periods)) + names(tmp) <- c("Factors", "Assets", "Periods") + print(tmp) + cat("\nFactor returns across periods:\n") + print(summary(coredata(x$factor.returns)), digits=digits, ...) + cat("\nR-squared values across periods:\n") + print(summary(x$r2), digits=digits, ...) + cat("\nResidual Variances across assets:\n") + print(summary(x$resid.var), digits=digits, ...) +} Modified: pkg/FactorAnalytics/R/print.sfm.r =================================================================== --- pkg/FactorAnalytics/R/print.sfm.r 2015-09-16 13:23:29 UTC (rev 3996) +++ pkg/FactorAnalytics/R/print.sfm.r 2015-09-21 06:57:48 UTC (rev 3997) @@ -1,8 +1,9 @@ -#' @title Prints out a fitted statictical factor model object +#' @title Prints a fitted statistical factor model #' #' @description S3 \code{print} method for object of class \code{sfm}. Prints -#' the call, factor model dimension, factor loadings, r-squared and residual -#' volatilities from the fitted object. +#' the call, factor model dimensions and summary statistics for the estimated +#' factor loadings, r-squared values and residual volatilities from the fitted +#' object. #' #' @param x an object of class \code{sfm} produced by \code{fitSfm}. #' @param digits an integer value, to indicate the required number of Modified: pkg/FactorAnalytics/R/print.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/print.tsfm.r 2015-09-16 13:23:29 UTC (rev 3996) +++ pkg/FactorAnalytics/R/print.tsfm.r 2015-09-21 06:57:48 UTC (rev 3997) @@ -1,46 +1,46 @@ -#' @title Prints out a fitted time series factor model object -#' -#' @description S3 \code{print} method for object of class \code{tsfm}. Prints -#' the call, factor model dimension, regression coefficients, r-squared and -#' residual volatilities from the fitted object. -#' -#' @param x an object of class \code{tsfm} produced by \code{fitTsfm}. -#' @param digits an integer value, to indicate the required number of -#' significant digits. Default is 3. -#' @param ... optional arguments passed to the \code{print} method. -#' -#' @author Yi-An Chen and Sangeetha Srinivasan -#' -#' @seealso \code{\link{fitTsfm}}, \code{\link{summary.tsfm}} -#' -#' @examples -#' data(managers) -#' fit <- fitTsfm(asset.names=colnames(managers[,(1:6)]), -#' factor.names=colnames(managers[,7:9]), -#' mkt.name="SP500.TR", data=managers) -#' print(fit) -#' -#' @method print tsfm -#' @export -#' - -print.tsfm <- function(x, digits=max(3, .Options$digits - 3), ...){ - if(!is.null(cl <- x$call)){ - cat("\nCall:\n") - dput(cl) - } - cat("\nModel dimensions:\n") - tmp <- c(dim(t(x$beta)), nrow(x$data)) - names(tmp) <- c("Factors", "Assets", "Periods") - print(tmp) - cat("\nRegression Alphas:\n") - print(t(x$alpha), digits=digits, ...) - cat("\nFactor Betas:\n") - B <- as.matrix(t(x$beta)) - if (x$variable.selection=="lars") { B[B==0] <- NA } - print(B, digits=digits, na.print=".", ...) - cat("\nR-squared values:\n") - print(x$r2, digits=digits, ...) - cat("\nResidual Volatilities:\n") - print(x$resid.sd, digits=digits, ...) -} +#' @title Prints a fitted time series factor model +#' +#' @description S3 \code{print} method for object of class \code{tsfm}. Prints +#' the call, factor model dimension, regression coefficients, r-squared and +#' residual volatilities from the fitted object. +#' +#' @param x an object of class \code{tsfm} produced by \code{fitTsfm}. +#' @param digits an integer value, to indicate the required number of +#' significant digits. Default is 3. +#' @param ... optional arguments passed to the \code{print} method. +#' +#' @author Yi-An Chen and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitTsfm}}, \code{\link{summary.tsfm}} +#' +#' @examples +#' data(managers) +#' fit <- fitTsfm(asset.names=colnames(managers[,(1:6)]), +#' factor.names=colnames(managers[,7:9]), +#' mkt.name="SP500.TR", data=managers) +#' print(fit) +#' +#' @method print tsfm +#' @export +#' + +print.tsfm <- function(x, digits=max(3, .Options$digits - 3), ...){ + if(!is.null(cl <- x$call)){ + cat("\nCall:\n") + dput(cl) + } + cat("\nModel dimensions:\n") + tmp <- c(dim(t(x$beta)), nrow(x$data)) + names(tmp) <- c("Factors", "Assets", "Periods") + print(tmp) + cat("\nRegression Alphas:\n") + print(t(x$alpha), digits=digits, ...) + cat("\nFactor Betas:\n") + B <- as.matrix(t(x$beta)) + if (x$variable.selection=="lars") { B[B==0] <- NA } + print(B, digits=digits, na.print=".", ...) + cat("\nR-squared values:\n") + print(x$r2, digits=digits, ...) + cat("\nResidual Volatilities:\n") + print(x$resid.sd, digits=digits, ...) +} Modified: pkg/FactorAnalytics/man/fitFfm.Rd =================================================================== --- pkg/FactorAnalytics/man/fitFfm.Rd 2015-09-16 13:23:29 UTC (rev 3996) +++ pkg/FactorAnalytics/man/fitFfm.Rd 2015-09-21 06:57:48 UTC (rev 3997) @@ -8,7 +8,7 @@ \title{Fit a fundamental factor model using cross-sectional regression} \usage{ fitFfm(data, asset.var, ret.var, date.var, exposure.vars, weight.var = NULL, - fit.method = c("LS", "WLS", "Rob", "W-Rob"), rob.scale = FALSE, + fit.method = c("LS", "WLS", "Rob", "W-Rob"), rob.stats = FALSE, full.resid.cov = FALSE, z.score = FALSE, ...) \method{coef}{ffm}(object, ...) @@ -33,24 +33,24 @@ fundamental factor exposures.} \item{weight.var}{character; name of the variable containing the weights -used when standarizing factor exposures (converting exposures to z-scores). -Default is \code{NULL}. See Details.} +used when standarizing style factor exposures. Default is \code{NULL}. See +Details.} \item{fit.method}{method for estimating factor returns; one of "LS", "WLS" "Rob" or "W-Rob". See details. Default is "LS".} -\item{rob.scale}{logical; If \code{TRUE}, robust estimates of covariance, -correlation and univariate scale are computed as appropriate (see Details). -Default is \code{FALSE}.} +\item{rob.stats}{logical; If \code{TRUE}, robust estimates of covariance, +correlation, location and univariate scale are computed as appropriate (see +Details). Default is \code{FALSE}.} \item{full.resid.cov}{logical; If \code{TRUE}, a full residual covariance matrix is estimated. Otherwise, a diagonal residual covariance matrix is estimated. Default is \code{FALSE}.} -\item{z.score}{logical; If \code{TRUE}, exposures will be converted to +\item{z.score}{logical; If \code{TRUE}, style exposures will be converted to z-scores; weights given by \code{weight.var}. Default is \code{FALSE}.} -\item{...}{other arguments passed} +\item{...}{potentially further arguments passed.} \item{object}{a fit object of class \code{ffm} which is returned by \code{fitFfm}} @@ -91,8 +91,9 @@ \item{fit.method}{fit.method as input.} \item{asset.names}{length-N vector of asset names.} \item{factor.names}{length-K vector of factor.names.} +\item{time.periods}{length-T vector of dates.} Where N is the number of assets, K is the number of factors (including the -intercept or dummy variables) and T is the number of time periods. +intercept or dummy variables) and T is the number of unique time periods. } \description{ Fit a fundamental (cross-sectional) factor model using ordinary @@ -109,20 +110,27 @@ of the residual variances from LS regression as weights (feasible GLS). Similarly, "W-Rob" is weighted robust regression. -\code{weight.var} specifies the variable (e.g. market-cap) used to weight -the exposures before converting them to z-scores in each time period. Default -option equally weights exposures of different assets each period. +Standardizing style factor exposures: The exposures can be standardized into +z-scores using regular or robust (see \code{rob.stats}) measures of location +and scale. Further, \code{weight.var}, a variable such as market-cap, can be +used to compute the weighted mean exposure, and an equal-weighted standard +deviation of the exposures about the weighted mean. This may help avoid an +ill-conditioned covariance matrix. Default option equally weights exposures +of different assets each period. -If \code{rob.scale=TRUE}, \code{\link[robust]{covRob}} is used to compute a +If \code{rob.stats=TRUE}, \code{\link[robust]{covRob}} is used to compute a robust estimate of the factor covariance/correlation matrix, and, -\code{\link[robustbase]{scaleTau2}} is used to compute robust tau-estimates of -univariate scale for residuals during "WLS" or "W-Rob" regressions and for -standardizing numeric factor exposures into z-scores. +\code{\link[robustbase]{scaleTau2}} is used to compute robust tau-estimates +of univariate scale for residuals during "WLS" or "W-Rob" regressions. When +standardizing style exposures, the \code{\link[stats]{median}} and +\code{\link[stats]{mad}} are used for location and scale respectively. -At this time, the regression can contain only one character exposure -(industry, sector, country etc.), otherwise the exposure matrix will become -singular. Same is true of an intercept term. We hope to expand the function -to allow more than one dummy variable in the future. +At this time, the regression can contain only one dummy exposure (one of +industry, sector, country etc.) or intercept term, otherwise the exposure +matrix will become singular. We plan to expand the function to allow +specifying more than one dummy variable, and, dummy variable(s) in +combination with an intercept term in the future. (Ex: Country + Sector + +Intercept) The original function was designed by Doug Martin and initially implemented in S-PLUS by a number of University of Washington Ph.D. students: @@ -144,10 +152,10 @@ exposure.vars <- c("GICS.SECTOR") fit1 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", date.var="DATE", exposure.vars=exposure.vars, - fit.method="Rob", rob.scale=TRUE) + fit.method="Rob", rob.stats=TRUE) -# example with industry dummy included -exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.INDUSTRY") +# example with sector dummy included +exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.SECTOR") fit2 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", date.var="DATE", exposure.vars=exposure.vars) } Added: pkg/FactorAnalytics/man/print.ffm.Rd =================================================================== --- pkg/FactorAnalytics/man/print.ffm.Rd (rev 0) +++ pkg/FactorAnalytics/man/print.ffm.Rd 2015-09-21 06:57:48 UTC (rev 3997) @@ -0,0 +1,36 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/print.ffm.R +\name{print.ffm} +\alias{print.ffm} +\title{Prints a fitted fundamental factor model} +\usage{ +\method{print}{ffm}(x, digits = max(3, .Options$digits - 3), ...) +} +\arguments{ +\item{x}{an object of class \code{ffm} produced by \code{fitFfm}.} + +\item{digits}{an integer value, to indicate the required number of +significant digits. Default is 3.} + +\item{...}{optional arguments passed to the \code{print} method.} +} +\description{ +S3 \code{print} method for object of class \code{ffm}. Prints +the call, factor model dimension and summary statistics for the estimated +factor returns, cross-sectional r-squared values and residual variances +from the fitted object. +} +\examples{ +data(Stock.df) +exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") +fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", + date.var="DATE", exposure.vars=exposure.vars) +print(fit) +} +\author{ +Yi-An Chen and Sangeetha Srinivasan +} +\seealso{ +\code{\link{fitFfm}}, \code{\link{summary.ffm}} +} + Modified: pkg/FactorAnalytics/man/print.sfm.Rd =================================================================== --- pkg/FactorAnalytics/man/print.sfm.Rd 2015-09-16 13:23:29 UTC (rev 3996) +++ pkg/FactorAnalytics/man/print.sfm.Rd 2015-09-21 06:57:48 UTC (rev 3997) @@ -2,7 +2,7 @@ % Please edit documentation in R/print.sfm.r \name{print.sfm} \alias{print.sfm} -\title{Prints out a fitted statictical factor model object} +\title{Prints a fitted statistical factor model} \usage{ \method{print}{sfm}(x, digits = max(3, .Options$digits - 3), ...) } @@ -16,8 +16,9 @@ } \description{ S3 \code{print} method for object of class \code{sfm}. Prints -the call, factor model dimension, factor loadings, r-squared and residual -volatilities from the fitted object. +the call, factor model dimensions and summary statistics for the estimated +factor loadings, r-squared values and residual volatilities from the fitted +object. } \examples{ data(StockReturns) Modified: pkg/FactorAnalytics/man/print.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/print.tsfm.Rd 2015-09-16 13:23:29 UTC (rev 3996) +++ pkg/FactorAnalytics/man/print.tsfm.Rd 2015-09-21 06:57:48 UTC (rev 3997) @@ -2,7 +2,7 @@ % Please edit documentation in R/print.tsfm.r \name{print.tsfm} \alias{print.tsfm} -\title{Prints out a fitted time series factor model object} +\title{Prints a fitted time series factor model} \usage{ \method{print}{tsfm}(x, digits = max(3, .Options$digits - 3), ...) }