[Returnanalytics-commits] r3486 - in pkg/FactorAnalytics: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 29 09:26:18 CEST 2014
Author: pragnya
Date: 2014-07-29 09:26:18 +0200 (Tue, 29 Jul 2014)
New Revision: 3486
Modified:
pkg/FactorAnalytics/DESCRIPTION
pkg/FactorAnalytics/R/covFm.R
pkg/FactorAnalytics/R/fitTsfm.R
pkg/FactorAnalytics/R/fitTsfm.control.R
pkg/FactorAnalytics/R/paFm.r
pkg/FactorAnalytics/R/plot.tsfm.r
pkg/FactorAnalytics/R/summary.tsfm.r
pkg/FactorAnalytics/man/covFm.Rd
pkg/FactorAnalytics/man/fitTsfm.Rd
pkg/FactorAnalytics/man/fitTsfm.control.Rd
pkg/FactorAnalytics/man/plot.tsfm.Rd
Log:
Update, edit and expand plot.tsfm. Fixed a few related issues in fitTsfm
Modified: pkg/FactorAnalytics/DESCRIPTION
===================================================================
--- pkg/FactorAnalytics/DESCRIPTION 2014-07-27 17:46:59 UTC (rev 3485)
+++ pkg/FactorAnalytics/DESCRIPTION 2014-07-29 07:26:18 UTC (rev 3486)
@@ -1,8 +1,8 @@
Package: factorAnalytics
Type: Package
Title: Factor Analytics
-Version: 1.0
-Date: 2014-06-18
+Version: 2.0.0.99
+Date: 2014-07-21
Author: Eric Zivot, Yi-An Chen and Sangeetha Srinivasan
Maintainer: Sangeetha Srinivasan <sangee at uw.edu>
Description: An R package for the estimation and risk analysis of linear factor
@@ -21,12 +21,12 @@
leaps,
lars,
lmtest,
- PerformanceAnalytics,
+ PerformanceAnalytics (>= 1.1.0),
sn,
tseries,
strucchange,
- ellipse,
- doParallel
+ ellipse
+Imports: corrplot
Suggests:
testthat, quantmod
LazyLoad: yes
Modified: pkg/FactorAnalytics/R/covFm.R
===================================================================
--- pkg/FactorAnalytics/R/covFm.R 2014-07-27 17:46:59 UTC (rev 3485)
+++ pkg/FactorAnalytics/R/covFm.R 2014-07-29 07:26:18 UTC (rev 3486)
@@ -19,7 +19,13 @@
#' where, B is the \code{N x K} matrix of factor betas and \code{D} is a
#' diagonal matrix with \code{sig(i)^2} along the diagonal.
#'
+#' Though method for handling NAs and the method for computing covariance can
+#' be specified via the \dots arguments. As a reasonable default,
+#' \code{use="pairwise.complete.obs"} is used, which restricts the method to
+#' "pearson".
+#'
#' @param object fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.
+#' @param ... optional arguments passed to \code{\link[stats]{cov}}.
#'
#' @return The computed \code{N x N} covariance matrix for asset returns based
#' on the fitted factor model.
@@ -72,6 +78,6 @@
#' @rdname covFm
#' @export
-covFm <- function(object){
+covFm <- function(object, ...){
UseMethod("covFm")
}
Modified: pkg/FactorAnalytics/R/fitTsfm.R
===================================================================
--- pkg/FactorAnalytics/R/fitTsfm.R 2014-07-27 17:46:59 UTC (rev 3485)
+++ pkg/FactorAnalytics/R/fitTsfm.R 2014-07-29 07:26:18 UTC (rev 3486)
@@ -41,20 +41,23 @@
#' volatility, and \code{market.sqd = (Rm-Rf)^2} is added as a factor in the
#' regression. Option "both" adds both of these factors.
#'
+#' \subsection{Data Processing}{
+#'
#' Note about NAs: Before model fitting, incomplete cases are removed for
#' every asset (return data combined with respective factors' return data)
#' using \code{\link[stats]{na.omit}}. Otherwise, all observations in
#' \code{data} are included.
#'
-#' Note about spaces in asset/factor names: Spaces in column names of the data
-#' object will be converetd to periods as the function works with \code{xts}
-#' objects internally and hence column names can't be retained as such.
+#' Note about \code{asset.names} and \code{factor.names}: Spaces in column
+#' names of \code{data} will be converted to periods as \code{fitTsfm} works
+#' with \code{xts} objects internally and colnames won't be left as they are.
+#' }
#'
#' @param asset.names vector containing names of assets, whose returns or
#' excess returns are the dependent variable.
#' @param factor.names vector containing names of the macroeconomic factors.
#' @param mkt.name name of the column for market excess returns (Rm-Rf).
-#' Is required only if \code{add.up.market} or \code{add.market.sqd}
+#' Is required if \code{mkt.timing} or \code{add.market.sqd}
#' are \code{TRUE}. Default is NULL.
#' @param rf.name name of the column of risk free rate variable to calculate
#' excess returns for all assets (in \code{asset.names}) and factors (in
@@ -216,6 +219,8 @@
# convert data into an xts object and hereafter work with xts objects
data.xts <- checkData(data)
+ # convert index to 'Date' format for uniformity
+ time(data.xts) <- as.Date(time(data.xts))
# extract columns to be used in the time series regression
dat.xts <- merge(data.xts[,asset.names], data.xts[,factor.names])
@@ -233,14 +238,14 @@
# opt add mkt-timing factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2
if (!is.null(mkt.timing)) {
- if(mkt.timing=="HM" | mkt.timing=="both") {
+ if(mkt.timing=="HM" || mkt.timing=="both") {
up.market <- data.xts[,mkt.name]
up.market [up.market < 0] <- 0
dat.xts <- merge.xts(dat.xts,up.market)
colnames(dat.xts)[dim(dat.xts)[2]] <- "up.market"
factor.names <- c(factor.names, "up.market")
}
- if(mkt.timing=="TM" | mkt.timing=="both") {
+ if(mkt.timing=="TM" || mkt.timing=="both") {
market.sqd <- data.xts[,mkt.name]^2
dat.xts <- merge(dat.xts, market.sqd)
colnames(dat.xts)[dim(dat.xts)[2]] <- "market.sqd"
@@ -268,7 +273,7 @@
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,
- factor.names=factor.names, fit.method=fit.method,
+ factor.names=factor.names, fit.method=NULL,
variable.selection=variable.selection)
result <- c(result.lars, input)
class(result) <- "tsfm"
@@ -313,9 +318,7 @@
if (fit.method == "OLS") {
reg.list[[i]] <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args))
} else if (fit.method == "DLS") {
- if(!"weights" %in% names(lm.args)) {
- lm.args$weights <- WeightsDLS(nrow(reg.xts), decay)
- }
+ lm.args$weights <- WeightsDLS(nrow(reg.xts), decay)
reg.list[[i]] <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args))
} else if (fit.method == "Robust") {
reg.list[[i]] <- do.call(lmRob, c(list(fm.formula,data=reg.xts),
@@ -346,9 +349,7 @@
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))
} else if (fit.method == "DLS") {
- if(!"weights" %in% names(lm.args)) {
- lm.args$weights <- WeightsDLS(nrow(reg.xts), decay)
- }
+ 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))
} else if (fit.method == "Robust") {
@@ -377,7 +378,7 @@
# formula to pass to lm or lmRob
fm.formula <- as.formula(paste(i," ~ ."))
- if (fit.method == "DLS" && !"weights" %in% names(regsubsets.args)) {
+ if (fit.method=="DLS" && !"weights" %in% names(regsubsets.args)) {
regsubsets.args$weights <- WeightsDLS(nrow(reg.xts), decay)
}
@@ -392,9 +393,7 @@
if (fit.method == "OLS") {
reg.list[[i]] <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args))
} else if (fit.method == "DLS") {
- if(!"weights" %in% names(lm.args)) {
- lm.args$weights <- WeightsDLS(nrow(reg.xts), decay)
- }
+ lm.args$weights <- WeightsDLS(nrow(reg.xts), decay)
reg.list[[i]] <- do.call(lm, c(list(fm.formula,data=reg.xts),lm.args))
} else if (fit.method == "Robust") {
reg.list[[i]] <- do.call(lmRob, c(list(fm.formula,data=reg.xts),
@@ -424,38 +423,45 @@
for (i in asset.names) {
# completely remove NA cases
reg.xts <- na.omit(dat.xts[, c(i, factor.names)])
-
# convert to matrix
reg.mat <- as.matrix(reg.xts)
# fit lars regression model
- lars.fit <- do.call(lars, c(list(x=reg.mat[,-1],y=reg.mat[,i]),lars.args))
+ lars.fit <-
+ do.call(lars, c(list(x=reg.mat[,factor.names],y=reg.mat[,i]),lars.args))
lars.sum <- summary(lars.fit)
- cv.error <-
- do.call(cv.lars, c(list(x=reg.mat[,-1],y=reg.mat[,i],plot.it=FALSE,
- mode="step"),cv.lars.args))
+ lars.cv <- do.call(cv.lars, c(list(x=reg.mat[,factor.names],y=reg.mat[,i],
+ mode="step"),cv.lars.args))
+ # including plot.it=FALSE to cv.lars strangely gives an error: "Argument s
+ # out of range". And, specifying index=seq(nrow(lars.fit$beta)-1) resolves
+ # the issue, but care needs to be taken for small N
# get the step that minimizes the "Cp" statistic or
# the K-fold "cv" mean-squared prediction error
- if (lars.criterion == "Cp") {
- s <- which.min(lars.sum$Cp)
+ if (lars.criterion=="Cp") {
+ s <- which.min(lars.sum$Cp)-1 # 2nd row is "step 1"
} else {
- s <- which.min(cv.error$cv)
+ s <- which.min(lars.cv$cv)-1
}
-
# get factor model coefficients & fitted values at the step obtained above
coef.lars <- predict(lars.fit, s=s, type="coef", mode="step")
- fitted.lars <- predict(lars.fit, reg.xts[,-1], s=s, type="fit",mode="step")
+ fitted.lars <- predict(lars.fit, reg.mat[,factor.names], s=s, type="fit",
+ mode="step")
fitted.list[[i]] <- xts(fitted.lars$fit, index(reg.xts))
# extract and assign the results
asset.fit[[i]] = lars.fit
- alpha[i] <- (fitted.lars$fit - reg.xts[,-1]%*%coef.lars$coefficients)[1]
+ alpha[i] <- (fitted.lars$fit -
+ reg.xts[,factor.names]%*%coef.lars$coefficients)[1]
beta.names <- names(coef.lars$coefficients)
beta[i, beta.names] <- coef.lars$coefficients
- r2[i] <- lars.fit$R2[s]
- resid.sd[i] <- sqrt(lars.sum$Rss[s]/(nrow(reg.xts)-s))
+ r2[i] <- lars.fit$R2[s+1]
+ resid.sd[i] <- sqrt(lars.sum$Rss[s+1]/(nrow(reg.xts)-lars.sum$Df[s+1]))
}
- fitted.xts <- do.call(merge, fitted.list)
+ if (length(asset.names)>1) {
+ fitted.xts <- do.call(merge, fitted.list)
+ } else {
+ fitted.xts <- fitted.list[[1]]
+ }
results.lars <- list(asset.fit=asset.fit, alpha=alpha, beta=beta, r2=r2,
resid.sd=resid.sd, fitted=fitted.xts)
# As a special case for variable.selection="lars", fitted values are also
@@ -464,7 +470,8 @@
}
-### calculate weights for "DLS"
+### calculate exponentially decaying weights for fit.method="DLS"
+## t = number of observations; d = decay factor
#
WeightsDLS <- function(t,d) {
# more weight given to more recent observations
@@ -474,6 +481,7 @@
}
### make a data frame (padded with NAs) from unequal vectors with named rows
+## l = list of unequal vectors
#
makePaddedDataFrame <- function(l) {
DF <- do.call(rbind, lapply(lapply(l, unlist), "[",
@@ -491,8 +499,10 @@
#' @method coef tsfm
#' @export
-coef.tsfm <- function(object,...) {
+coef.tsfm <- function(object, ...) {
if (object$variable.selection=="lars") {
+ # generic method 'coef' does not exist for "lars" fit objects
+ # so, use cbind to form coef matrix
coef.mat <- cbind(object$alpha, object$beta)
colnames(coef.mat)[1] <- "(Intercept)"
} else {
@@ -505,18 +515,26 @@
#' @method fitted tsfm
#' @export
-fitted.tsfm <- function(object,...) {
+fitted.tsfm <- function(object, ...) {
if (object$variable.selection=="lars") {
+ # generic method 'fitted' does not exist for "lars" fit objects
+ # so, use fitted values returned by 'fitTsfm'
fitted.xts <- object$fitted
} else {
- # get fitted values from each linear factor model fit
- # and convert them into xts/zoo objects
- fitted.list = sapply(object$asset.fit,
- 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)
+ if (length(object$asset.names)>1) {
+ # get fitted values from each linear factor model fit
+ # and convert them into xts/zoo objects
+ fitted.list = sapply(object$asset.fit,
+ 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)
+ } else {
+ fitted.xts <- checkData(fitted(object$asset.fit[[1]],...))
+ colnames(fitted.xts) <- object$asset.names
+ }
}
+ time(fitted.xts) <- as.Date(time(fitted.xts))
return(fitted.xts)
}
@@ -525,18 +543,26 @@
#' @method residuals tsfm
#' @export
-residuals.tsfm <- function(object ,...) {
+residuals.tsfm <- function(object, ...) {
if (object$variable.selection=="lars") {
+ # generic method 'residuals' does not exist for "lars" fit objects
+ # so, calculate them from the actual and fitted values
residuals.xts <- object$data[,object$asset.names] - object$fitted
} else {
- # get residuals from each linear factor model fit
- # and convert them into xts/zoo objects
- residuals.list = sapply(object$asset.fit,
- 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)
+ if (length(object$asset.names)>1) {
+ # get residuals from each linear factor model fit
+ # and convert them into xts/zoo objects
+ residuals.list = sapply(object$asset.fit,
+ 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)
+ } else {
+ residuals.xts <- checkData(residuals(object$asset.fit[[1]],...))
+ colnames(residuals.xts) <- object$asset.names
+ }
}
+ time(residuals.xts) <- as.Date(time(residuals.xts))
return(residuals.xts)
}
@@ -544,7 +570,7 @@
#' @method covFm tsfm
#' @export
-covFm.tsfm <- function(object) {
+covFm.tsfm <- function(object, ...) {
# check input object validity
if (!inherits(object, c("tsfm", "sfm", "ffm"))) {
@@ -555,10 +581,11 @@
beta <- as.matrix(object$beta)
beta[is.na(beta)] <- 0
sig2.e = object$resid.sd^2
- factor <- as.matrix(object$data[, colnames(object$beta)])
+ factor <- as.matrix(object$data[, object$factor.names])
+ if (!exists("use")) {use="pairwise.complete.obs"}
# factor covariance matrix
- factor.cov = var(factor, use="na.or.complete")
+ factor.cov = cov(factor, use=use, ...)
# residual covariance matrix D
if (length(sig2.e) > 1) {
Modified: pkg/FactorAnalytics/R/fitTsfm.control.R
===================================================================
--- pkg/FactorAnalytics/R/fitTsfm.control.R 2014-07-27 17:46:59 UTC (rev 3485)
+++ pkg/FactorAnalytics/R/fitTsfm.control.R 2014-07-29 07:26:18 UTC (rev 3486)
@@ -4,18 +4,22 @@
#' All control parameters that are not passed to this function are set to
#' default values.
#'
-#' @details This control function is primarily used to pass optional arguments
-#' to \code{\link[stats]{lm}}, \code{\link[robust]{lmRob}},
+#' @details This control function is used to process optional arguments passed
+#' via \code{...} to \code{fitTsfm}. These arguments are validated and defaults
+#' are set if necessary before being passed internally to one of the following
+#' functions: \code{\link[stats]{lm}}, \code{\link[robust]{lmRob}},
#' \code{\link[stats]{step}}, \code{\link[leaps]{regsubsets}},
-#' \code{\link[lars]{lars}} and \code{\link[lars]{cv.lars}} within
-#' \code{fitTsfm}. See their respective help files for more details. The
-#' arguments to each of these functions are listed approximately in the same
-#' order for user convenience.
+#' \code{\link[lars]{lars}} and \code{\link[lars]{cv.lars}}. See their
+#' respective help files for more details. The arguments to each of these
+#' functions are listed above in approximately the same order for user
+#' convenience.
#'
#' The scalar \code{decay} is used by \code{\link{fitTsfm}} to compute
-#' exponentially decaying weights for \code{fit.method="DLS"}. Optionally, one
+#' exponentially decaying weights for \code{fit.method="DLS"}. Alternately, one
#' can directly specify \code{weights}, a weights vector, to be used with
-#' "OLS" or "Robust".
+#' "OLS" or "Robust". Especially when fitting multiple assets, care should be
+#' taken to ensure that the length of the weights vector matches the number of
+#' observations (excluding cases ignored due to NAs).
#'
#' \code{lars.criterion} selects the criterion (one of "Cp" or "cv") to
#' determine the best fitted model for \code{variable.selection="lars"}. The
@@ -29,10 +33,9 @@
#' @param weights an optional vector of weights to be used in the fitting
#' process for \code{fit.method="OLS","Robust"}, or
#' \code{variable.selection="subsets"}. Should be \code{NULL} or a numeric
-#' vector. If non-\code{NULL}, weighted least squares is performed with weights
-#' given by \code{weights} (i.e., minimizing sum(w*e^2)). The length of
-#' \code{weights} must be the same as the number of observations. The weights
-#' must be nonnegative and strongly recommended to be strictly positive.
+#' vector. The length of \code{weights} must be the same as the number of
+#' observations. The weights must be nonnegative and it is strongly
+#' recommended that they be strictly positive.
#' @param model,x,y,qr logicals passed to \code{lm} for
#' \code{fit.method="OLS"}. If \code{TRUE} the corresponding components of the
#' fit (the model frame, the model matrix, the response, the QR decomposition)
@@ -179,7 +182,6 @@
if (!is.logical(normalize) || length(normalize) != 1) {
stop("Invalid argument: control parameter 'normalize' must be logical")
}
- lars.criterion <- lars.criterion[1] # default is "Cp"
if (!(lars.criterion %in% c("Cp","cv"))) {
stop("Invalid argument: lars.criterion must be 'Cp' or 'cv'.")
}
Modified: pkg/FactorAnalytics/R/paFm.r
===================================================================
--- pkg/FactorAnalytics/R/paFm.r 2014-07-27 17:46:59 UTC (rev 3485)
+++ pkg/FactorAnalytics/R/paFm.r 2014-07-29 07:26:18 UTC (rev 3486)
@@ -90,7 +90,7 @@
# specific returns
spec.ret.xts <- actual.xts -
- xts(as.matrix(fit.lm$model[, -1])%*%as.matrix(fit.lm$coef[-1]),
+ xts(as.matrix(fit.lm$model[, factorNames])%*%as.matrix(fit.lm$coef[-1]),
dates)
cum.spec.ret[k,1] <- cum.ret - Return.cumulative(actual.xts - spec.ret.xts)
attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts)
Modified: pkg/FactorAnalytics/R/plot.tsfm.r
===================================================================
--- pkg/FactorAnalytics/R/plot.tsfm.r 2014-07-27 17:46:59 UTC (rev 3485)
+++ pkg/FactorAnalytics/R/plot.tsfm.r 2014-07-29 07:26:18 UTC (rev 3486)
@@ -3,31 +3,48 @@
#' @description Generic \code{plot} method for object of class \code{tsfm}.
#' Plots chosen characteristic(s) for one or more assets.
#'
+#' @details
+#' If the plot type argument is not specified, a menu prompts for user input
+#' and the corresponding plot is output. And, the menu is repeated for
+#' user convenience in plotting multiple characteristics. Selecting '0' from
+#' the menu exits the current \code{plot.tsfm} call. Alternately, setting
+#' \code{loop=FALSE} will exit after plotting any one chosen characteristic.
+#'
+#' For group plots (the default), the first \code{max.show} assets are plotted.
+#' For individual plots, \code{asset.name} is necessary if multiple assets
+#' were modeled in \code{x} and \code{plot.single=TRUE}. However, if the
+#' \code{fitTsfm} object \code{x} only contains one asset's factor model fit,
+#' \code{plot.tsfm} can infer this automatically, without user input.
+#'
+#' CUSUM plots (individual asset plot options 10, 11 and 12) are applicable
+#' only for \code{fit.method="OLS"}.
+#'
+#' Rolling estimates (individual asset plot option 13) is not applicable for
+#' \code{variable.slection="lars"}.
+#'
#' @param x an object of class \code{tsfm} produced by \code{fitTsfm}.
-#' @param colorset a vector of colors for the bars or bar components. Argument
-#' is used by \code{\link[graphics]{barplot}}. Default is c(1:12).
-#' @param legend.loc places a legend into one of nine locations on the chart:
-#' bottomright, bottom, bottomleft, left, topleft, top, topright, right, or
-#' center. Argument is used by
-#' \code{\link[PerformanceAnalytics]{chart.TimeSeries}}. Default is \code{NULL}.
-#' @param which.plot a number to indicate the type of group plot for multiple
-#' assets. Default is NULL; which brings up the following menu: \cr
-#' 1 = "Actual and Fitted asset returns", \cr
-#' 2 = "R-squared", \cr
-#' 3 = "Residual Volatility",\cr
-#' 4 = "Factor Model Correlation",\cr
-#' 5 = "Factors' Contribution to SD",\cr
-#' 6 = "Factors' Contribution to ES",\cr
-#' 7 = "Factors' Contribution to VaR"
-#' @param max.show maximum number of assets in a plot. Default is 6.
-#' @param plot.single a logical value. If \code{TRUE}, plots an individual
-#' asset's linear factor model trait selected by \code{which.plot.single}.
-#' Default is \code{FALSE}.
+#' @param which.plot.group a number to indicate the type of group plot for
+#' multiple assets. If \code{NULL} (default), the following menu appears: \cr
+#' 1 = Factor model coefficients: Alpha, \cr
+#' 2 = Factor model coefficients: Betas, \cr
+#' 3 = Actual and Fitted asset returns, \cr
+#' 4 = R-squared, \cr
+#' 5 = Residual Volatility,\cr
+#' 6 = Factor Model Residual Correlation \cr
+#' 7 = Factor Model Correlation,\cr
+#' 8 = Factor Contribution to SD,\cr
+#' 9 = Factor Contribution to ES,\cr
+#' 10 = Factor Contribution to VaR
+#' @param max.show maximum number of assets in a given plot. Default is 6.
+#' @param plot.single a logical value. \code{TRUE} plots the characteristics of
+#' an individual asset's factor model. The type of plot is given by
+#' \code{which.plot.single}. Default is \code{FALSE}.
#' @param asset.name name of the individual asset to be plotted. Is necessary
-#' if \code{plot.single=TRUE}
+#' if multiple assets factor model fits exist in \code{x} and
+#' \code{plot.single=TRUE}.
#' @param which.plot.single a number to indicate the type of group plot for an
-#' individual asset. Default is NULL; which brings up the following menu: \cr
-#' 1 = Time series plot of actual and fitted factor returns,\cr
+#' individual asset. If \code{NULL} (default), the following menu appears: \cr
+#' 1 = Time series plot of actual and fitted asset returns,\cr
#' 2 = Time series plot of residuals with standard error bands, \cr
#' 3 = Time series plot of squared residuals, \cr
#' 4 = Time series plot of absolute residuals,\cr
@@ -36,19 +53,47 @@
#' 7 = SACF and PACF of absolute residuals,\cr
#' 8 = Histogram of residuals with normal curve overlayed,\cr
#' 9 = Normal qq-plot of residuals,\cr
-#' 10= CUSUM plot of recursive residuals,\cr
-#' 11= CUSUM plot of OLS residuals,\cr
-#' 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr
-#' 13= Rolling estimates over a 24-period observation window
+#' 10 = CUSUM test-Recursive residuals,\cr
+#' 11 = CUSUM test-OLS residuals,\cr
+#' 12 = Recursive estimates (RE) test of OLS regression coefficients,\cr
+#' 13 = Rolling estimates over a 24-period observation window
+#' @param colorset color palette to use for all the plots. Default is
+#' \code{c(1:12)}. The 1st element will be used for individual time series
+#' plots or the 1st series plotted, the 2nd element for the 2nd object in the
+#' plot and so on.
+#' @param legend.loc places a legend into one of nine locations on the chart:
+#' "bottomright", "bottom", "bottomleft", "left", "topleft", "top", "topright",
+#' "right", or "center". Default is "bottomright". Use \code{legend.loc=NULL}
+#' to suppress the legend.
+#' @param las one of {0, 1, 2, 3} to set the direction of axis labels, same as
+#' in \code{plot}. Default here is 1.
#' @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 passed to or from other methods.
+#' @param loop logical to indicate if the plot menu should be repeated. Default
+#' is \code{TRUE}.
+#' @param ... further arguments to be passed to other plotting functions.
#'
#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan
#'
-#' @seealso \code{\link{fitTsfm}}, \code{\link{summary.tsfm}}
+#' @seealso \code{\link{fitTsfm}} and \code{\link{summary.tsfm}} for details
+#' about the time series factor model fit, extractor functions and summary
+#' statistics.
#'
+#' \code{\link[strucchange]{efp}} for CUSUM tests.
+#'
+#' \code{\link[xts]{plot.xts}},
+#' \code{\link[PerformanceAnalytics]{chart.TimeSeries}},
+#' \code{\link[PerformanceAnalytics]{chart.ACFplus}},
+#' \code{\link[PerformanceAnalytics]{chart.Histogram}},
+#' \code{\link[PerformanceAnalytics]{chart.QQPlot}},
+#' \code{\link[graphics]{barplot}} and
+#' \code{\link[ellipse]{plotcorr}} for plotting methods used.
+#'
+#' \code{\link{factorModelSDDecomposition}},
+#' \code{\link{factorModelEsDecomposition}},
+#' \code{\link{factorModelVaRDecomposition}} for factor model risk measures.
+#'
#' @examples
#'
#' \dontrun{
@@ -57,7 +102,7 @@
#' fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]),
#' factor.names=colnames(managers[,(7:8)]),
#' rf.name="US 3m TR", data=managers)
-#' # plot all assets and show only the first 4 assets.
+#' # plot the 1st 4 assets fitted above.
#' plot(fit.macro, max.show=4)
#' # plot of an individual asset, "HAM1"
#' plot(fit.macro, plot.single=TRUE, asset.name="HAM1")
@@ -66,413 +111,398 @@
#' @method plot tsfm
#' @export
-plot.tsfm <- function(x, colorset=c(1:12), legend.loc=NULL, which.plot=NULL,
- max.show=6, plot.single=FALSE, asset.name,
- which.plot.single=NULL, VaR.method = "historical", ...){
+plot.tsfm <- function(x, which.plot.group=NULL, max.show=6, plot.single=FALSE,
+ asset.name, which.plot.single=NULL, colorset=(1:12),
+ legend.loc="bottomright", las=1,
+ VaR.method="historical", loop=TRUE, ...) {
- # get all the arguments specified by their full names
- call <- match.call()
-
if (plot.single==TRUE) {
- if (!exists("asset.name")) {
- stop("Missing input: asset.name is required if plot.single is TRUE.")
+ if (missing(asset.name) && length(x$asset.names)>1) {
+ stop("Missing input: 'asset.name' is required if plot.single is TRUE and
+ multiple assets factor model fits exist in 'x'.")
+ } else if (length(x$asset.names)==1) {
+ i <- x$asset.names[1]
+ } else {
+ i <- asset.name
}
+ # extract info from the fitTsfm object
+ plotData <- merge.xts(x$data[,i], fitted(x)[,i])
+ colnames(plotData) <- c("Actual","Fitted")
+ Residuals <- residuals(x)[,i]
+ fit <- x$asset.fit[[i]]
+ par(las=las) # default horizontal axis labels
- # extract the lm, lmRob or lars fit object for that asset
- fit.lm = x$asset.fit[[asset.name]]
-
- if (x$variable.selection == "none") {
-
- ## extract information from lm object
-
- factorNames = colnames(fit.lm$model)[-1]
- fit.formula = as.formula(paste(asset.name,"~", paste(factorNames, collapse="+"), sep=" "))
- residuals.z = zoo(residuals(fit.lm), as.Date(names(residuals(fit.lm))))
- fitted.z = zoo(fitted(fit.lm), as.Date(names(fitted(fit.lm))))
- actual.z = zoo(fit.lm$model[,1], as.Date(rownames(fit.lm$model)))
- tmp.summary = summary(fit.lm)
-
-
+ # plot selection
+ repeat {
if (is.null(which.plot.single)) {
- which.plot.single <- menu(c("Time series plot of actual and fitted values",
- "time series plot of residuals with standard error bands",
- "time series plot of squared residuals",
- "time series plot of absolute residuals",
- "SACF and PACF of residuals",
- "SACF and PACF of squared residuals",
- "SACF and PACF of absolute residuals",
- "histogram of residuals with normal curve overlayed",
- "normal qq-plot of residuals",
- "CUSUM plot of recursive residuals",
- "CUSUM plot of OLS residuals",
- "CUSUM plot of recursive estimates relative to full sample estimates",
- "rolling estimates over a 24-period observation window"),
- title="\nMake a plot selection (or 0 to exit):\n")
+ which.plot.single <-
+ menu(c("Time series plot of actual and fitted asset returns",
+ "Time series plot of residuals with standard error bands",
+ "Time series plot of squared residuals",
+ "Time series plot of absolute residuals",
+ "SACF and PACF of residuals",
+ "SACF and PACF of squared residuals",
+ "SACF and PACF of absolute residuals",
+ "Histogram of residuals with normal curve overlayed",
+ "Normal qq-plot of residuals",
+ "CUSUM test-Recursive residuals",
+ "CUSUM test-OLS residuals",
+ "Recursive estimates (RE) test of OLS regression coefficients",
+ "Rolling estimates over a 24-period observation window"),
+ title="\nMake a plot selection (or 0 to exit):")
}
+ par(las=las) # default horizontal axis labels
+
switch(which.plot.single,
"1L" = {
- ## time series plot of actual and fitted values
- plot(actual.z, main=asset.name, ylab="Monthly performance", lwd=2, col="black")
- lines(fitted.z, lwd=2, col="blue")
- abline(h=0)
- legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","blue"))
- },
-
- "2L" = {
+ ## time series plot of actual and fitted asset returns
+ chart.TimeSeries(plotData, main=paste("Returns:",i),
+ colorset=colorset, xlab="",
+ ylab="Actual and fitted asset returns",
+ legend.loc=legend.loc, pch=NULL, las=las, ...)
+ }, "2L" = {
## time series plot of residuals with standard error bands
- plot(residuals.z, main=asset.name, ylab="Monthly performance", lwd=2, col="black")
- abline(h=0)
- abline(h=2*tmp.summary$sigma, lwd=2, lty="dotted", col="red")
- abline(h=-2*tmp.summary$sigma, lwd=2, lty="dotted", col="red")
- legend(x="bottomleft", legend=c("Residual", "+/ 2*SE"), lwd=2,
- lty=c("solid","dotted"), col=c("black","red"))
- },
- "3L" = {
+ if(!exists("lwd")) {lwd=2}
+ if(!exists("lty")) {lty="solid"}
+ chart.TimeSeries(Residuals, main=paste("Residuals:",i), lty=lty,
+ colorset=colorset, xlab="",
+ ylab="Residuals", lwd=lwd, las=las, ...)
+ abline(h=1.96*x$resid.sd[i], lwd=lwd, lty="dotted", col="red")
+ abline(h=-1.96*x$resid.sd[i], lwd=lwd, lty="dotted", col="red")
+ legend(x=legend.loc, lty=c(lty,"dotted"),
+ col=c(colorset[1],"red"), lwd=lwd,
+ legend=c("Residuals",expression("\u00b1 1.96"*sigma)))
+ }, "3L" = {
## time series plot of squared residuals
- plot(residuals.z^2, main=asset.name, ylab="Squared residual", lwd=2, col="black")
- abline(h=0)
- legend(x="topleft", legend="Squared Residuals", lwd=2, col="black")
- },
- "4L" = {
+ if (!is.null(legend.loc)) {legend.loc="topright"}
+ chart.TimeSeries(Residuals^2, colorset=colorset, xlab="",
+ ylab=" Squared Residuals",
+ main=paste("Squared Residuals:",i),
+ legend.loc=legend.loc, pch=NULL, las=las, ...)
+ }, "4L" = {
## time series plot of absolute residuals
- plot(abs(residuals.z), main=asset.name, ylab="Absolute residual", lwd=2, col="black")
- abline(h=0)
- legend(x="topleft", legend="Absolute Residuals", lwd=2, col="black")
- },
- "5L" = {
+ if (!is.null(legend.loc)) {legend.loc="topright"}
+ chart.TimeSeries(abs(Residuals), colorset=colorset, xlab="",
+ ylab="Absolute Residuals",
+ main=paste("Absolute Residuals:",i),
+ legend.loc=legend.loc, pch=NULL, las=las, ...)
+ }, "5L" = {
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3486
More information about the Returnanalytics-commits
mailing list