[Returnanalytics-commits] r3442 - in pkg/FactorAnalytics: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jun 26 09:54:15 CEST 2014
Author: pragnya
Date: 2014-06-26 09:54:15 +0200 (Thu, 26 Jun 2014)
New Revision: 3442
Added:
pkg/FactorAnalytics/man/.Rapp.history
pkg/FactorAnalytics/man/plot.TSFM.Rd
pkg/FactorAnalytics/man/predict.tsfm.Rd
pkg/FactorAnalytics/man/print.tsfm.Rd
pkg/FactorAnalytics/man/summary.tsfm.Rd
Removed:
pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd
pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd
pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd
pkg/FactorAnalytics/man/summary.TimeSeriesFactorModel.Rd
Modified:
pkg/FactorAnalytics/NAMESPACE
pkg/FactorAnalytics/R/fitTSFM.R
pkg/FactorAnalytics/R/plot.tsfm.r
pkg/FactorAnalytics/R/predict.tsfm.r
pkg/FactorAnalytics/R/print.tsfm.r
pkg/FactorAnalytics/R/summary.tsfm.r
pkg/FactorAnalytics/R/tsfm.r
pkg/FactorAnalytics/man/fitTSFM.Rd
Log:
Edits to the S3 methods for class tsfm and their documentation.
Modified: pkg/FactorAnalytics/NAMESPACE
===================================================================
--- pkg/FactorAnalytics/NAMESPACE 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/NAMESPACE 2014-06-26 07:54:15 UTC (rev 3442)
@@ -2,18 +2,14 @@
S3method(plot,FundamentalFactorModel)
S3method(plot,StatFactorModel)
-S3method(plot,TimeSeriesFactorModel)
S3method(plot,pafm)
S3method(predict,FundamentalFactorModel)
S3method(predict,StatFactorModel)
-S3method(predict,TimeSeriesFactorModel)
S3method(print,FundamentalFactorModel)
S3method(print,StatFactorModel)
-S3method(print,TimeSeriesFactorModel)
S3method(print,pafm)
S3method(summary,FundamentalFactorModel)
S3method(summary,StatFactorModel)
-S3method(summary,TimeSeriesFactorModel)
S3method(summary,pafm)
export(dCornishFisher)
export(factorModelCovariance)
@@ -26,5 +22,9 @@
export(fitTSFM)
export(pCornishFisher)
export(paFM)
+export(plot.TSFM)
+export(predict.tsfm)
+export(print.tsfm)
export(qCornishFisher)
export(rCornishFisher)
+export(summary.tsfm)
Modified: pkg/FactorAnalytics/R/fitTSFM.R
===================================================================
--- pkg/FactorAnalytics/R/fitTSFM.R 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/R/fitTSFM.R 2014-06-26 07:54:15 UTC (rev 3442)
@@ -111,6 +111,7 @@
#' @family Factor Models
#'
#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan.
+#'
#' @references
#' \enumerate{
#' \item Christopherson, Carino and Ferson (2009). Portfolio Performance
@@ -125,6 +126,10 @@
#' Journal of Business, Vol 54, No 4.
#' }
#'
+#' @seealso \code{\link{summary.tsfm}}, \code{\link{plot.tsfm}},
+#' \code{\link{predict.tsfm}}, \code{\link{coef.tsfm}},
+#' \code{\link{fitted.tsfm}}, \code{\link{residuals.tsfm}}
+#'
#' @examples
#' \dontrun{
#' # load data from the database
@@ -152,7 +157,7 @@
"seqrep"),
nvmax=8, force.in=NULL, num.factors.subset=1,
add.up.market=FALSE, add.market.sqd=FALSE,
- decay=0.95, lars.criterion="Cp", ...) {
+ decay=0.95, lars.criterion="Cp", ...){
# get all the arguments specified by their full names
call <- match.call()
@@ -280,14 +285,14 @@
# fit based on time series regression method chosen
if (fit.method == "OLS") {
reg.list[[i]] <- step(lm(fm.formula, data=reg.xts), direction=direction,
- steps=steps, k=k, trace=0)
+ steps=steps, k=k, trace=0)
} else if (fit.method == "DLS") {
w <- WeightsDLS(nrow(reg.xts), decay)
reg.list[[i]] <- step(lm(fm.formula, data=reg.xts, weights=w),
- direction=direction, steps=steps, k=k, trace=0)
+ direction=direction, steps=steps, k=k, trace=0)
} else if (fit.method == "Robust") {
reg.list[[i]] <- step.lmRob(lmRob(fm.formula, data=reg.df), trace=FALSE,
- direction=direction, steps=steps, k=k)
+ direction=direction, steps=steps, k=k)
} else {
stop("Invalid argument: fit.method must be 'OLS', 'DLS' or 'Robust'")
}
@@ -422,7 +427,7 @@
### Format and add optional factors "up.market" and "market.sqd"
#
MarketFactors <- function(dat.xts, reg.xts, market.name,
- add.up.market, add.market.sqd) {
+ add.up.market, add.market.sqd){
if(add.up.market == TRUE) {
# up.market = max(0,Rm-Rf)
up.market <- apply(dat.xts[,market.name],1,max,0)
Modified: pkg/FactorAnalytics/R/plot.tsfm.r
===================================================================
--- pkg/FactorAnalytics/R/plot.tsfm.r 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/R/plot.tsfm.r 2014-06-26 07:54:15 UTC (rev 3442)
@@ -1,27 +1,35 @@
-#' plot TimeSeriesFactorModel object.
+#' @title Plots from a fitted time series factor model
#'
-#' Generic function of plot method for fitTimeSeriesFactorModel. Either plot
-#' all assets or choose a single asset to plot.
+#' @description S3 \code{plot} method for object of class \code{tsfm}. Plots
+#' selected characteristics for one or more assets.
#'
-#'
-#' @param x fit object created by \code{fitTimeSeriesFactorModel}.
-#' @param colorset Defualt colorset the same as \code{barplot}.
-#' @param legend.loc Plot legend or not. Defualt is \code{NULL}.
-#' @param which.plot Integer indicates which plot to create: "none" will
-#' create a menu to choose. Defualt is none.\cr
-#' 1 = "Fitted factor returns", \cr
-#' 2 = "R square", \cr
-#' 3 = "Variance of Residuals",\cr
+#' @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 or "none" to indicate which type of group plot to
+#' create for multiple assets. Default is "none"; which brings up the following
+#' menu to select a type. \cr
+#' 1 = "Fitted asset returns", \cr
+#' 2 = "R-squared", \cr
+#' 3 = "Residual Volatility",\cr
#' 4 = "FM Correlation",\cr
-#' 5 = "Factor Contributions to SD",\cr
-#' 6 = "Factor Contributions to ES",\cr
-#' 7 = "Factor Contributions to VaR"
-#' @param max.show Maximum assets to plot. Default is 6.
-#' @param plot.single Plot a single asset of lm class. Defualt is \code{FALSE}.
-#' @param asset.name Name of the asset to be plotted.
-#' @param which.plot.single Integer indicates which plot to create: "none"
-#' will create a menu to choose. Defualt is none.\cr
-#' 1 = time series plot of actual and fitted values,\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 asset.name name of the individual asset to be plotted. Is necessary
+#' if \code{plot.single=TRUE}
+#' @param which.plot.single a number or "none" to indicate which type of group
+#' plot to create for multiple assets. Default is "none"; which brings up the
+#' following menu to select a type.\cr
+#' 1 = time series plot of actual and fitted factor 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
@@ -33,33 +41,39 @@
#' 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 24 month window.
-#' @param VaR.method Character, method for computing VaR. Valid choices are
-#' either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR}
-#' in the PerformanceAnalytics package. Default is "historical".
+#' 13= rolling estimates over an observation window of length 24.
+#' @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.
-#' @author Eric Zivot and Yi-An Chen.
+#'
+#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan
+#'
+#' @seealso \code{\link{fitTSFM}}
+#'
#' @examples
#'
#' \dontrun{
#' # load data from the database
#' data(managers.df)
-#' fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
-#' factors.names=c("EDHEC.LS.EQ","SP500.TR"),
-#' data=managers.df,fit.method="OLS")
-#' # plot of all assets and show only first 4 assets.
+#' fit.macro <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]),
+#' factor.names=c("EDHEC.LS.EQ","SP500.TR"),
+#' data=managers.df,fit.method="OLS")
+#' # plot all assets and show only the first 4 assets.
#' plot(fit.macro,max.show=4)
-#' # single plot of HAM1 asset
+#' # plot of an individual asset, "HAM1"
#' plot(fit.macro, plot.single=TRUE, asset.name="HAM1")
#' }
-#' @method plot TimeSeriesFactorModel
+#'
#' @export
-plot.TimeSeriesFactorModel <-
- function(x,colorset=c(1:12),legend.loc=NULL,
- which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"),max.show=6,
- plot.single=FALSE, asset.name,which.plot.single=c("none","1L","2L","3L","4L","5L","6L",
- "7L","8L","9L","10L","11L","12L","13L"),
- VaR.method = "historical", ...) {
+
+plot.TSFM <-
+ function(x, colorset=c(1:12), legend.loc=NULL,
+ which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"), max.show=6,
+ plot.single=FALSE, asset.name,
+ which.plot.single=c("none","1L","2L","3L","4L","5L","6L","7L","8L",
+ "9L","10L","11L","12L","13L"),
+ VaR.method = "historical", ...){
if (plot.single==TRUE) {
## inputs:
@@ -80,7 +94,7 @@
## 10 CUSUM plot of recursive residuals
## 11 CUSUM plot of OLS residuals
## 12 CUSUM plot of recursive estimates relative to full sample estimates
- ## 13 rolling estimates over 24 month window
+ ## 13 rolling estimates over an observation window of length 24
which.plot.single<-which.plot.single[1]
if (missing(asset.name) == TRUE) {
stop("Neet to specify an asset to plot if plot.single is TRUE.")
@@ -113,7 +127,7 @@
"CUSUM plot of recursive residuals",
"CUSUM plot of OLS residuals",
"CUSUM plot of recursive estimates relative to full sample estimates",
- "rolling estimates over 24 month window"),
+ "rolling estimates over an observation window of length 24"),
title="\nMake a plot selection (or 0 to exit):\n")
switch(which.plot.single,
"1L" = {
@@ -304,13 +318,13 @@
which.plot<-which.plot[1]
if(which.plot=='none')
- which.plot<-menu(c("Fitted factor returns",
- "R square",
- "Variance of Residuals",
+ which.plot<-menu(c("Fitted asset returns",
+ "R-squared",
+ "Residual Volatility",
"FM Correlation",
- "Factor Contributions to SD",
- "Factor Contributions to ES",
- "Factor Contributions to VaR"),
+ "Factors' Contribution to SD",
+ "Factors' Contribution to ES",
+ "Factors' Contribution to VaR"),
title="Factor Analytics Plot \nMake a plot selection (or 0 to exit):\n")
@@ -354,7 +368,7 @@
barplot(x$r2)
},
"3L" = {
- barplot(x$resid.variance)
+ barplot(x$resid.sd)
},
"4L" = {
@@ -380,7 +394,7 @@
cr.sd = sapply(factor.sd.decomp.list, getCSD)
rownames(cr.sd) = c(factor.names, "residual")
# create stacked barchart
- barplot(cr.sd, main="Factor Contributions to SD",
+ barplot(cr.sd, main="Factors' Contribution to SD",
legend.text=T, args.legend=list(x="topleft"))
},
@@ -428,7 +442,7 @@
# report as positive number
cr.etl = sapply(factor.es.decomp.list, getCETL)
rownames(cr.etl) = c(factor.names, "residual")
- barplot(cr.etl, main="Factor Contributions to ES",
+ barplot(cr.etl, main="Factors' Contribution to ES",
legend.text=T, args.legend=list(x="topleft"))
},
"7L" ={
@@ -476,7 +490,7 @@
# report as positive number
cr.VaR = sapply(factor.VaR.decomp.list, getCVaR)
rownames(cr.VaR) = c(factor.names, "residual")
- barplot(cr.VaR, main="Factor Contributions to VaR",
+ barplot(cr.VaR, main="Factors' Contribution to VaR",
legend.text=T, args.legend=list(x="topleft"))
},
invisible()
Modified: pkg/FactorAnalytics/R/predict.tsfm.r
===================================================================
--- pkg/FactorAnalytics/R/predict.tsfm.r 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/R/predict.tsfm.r 2014-06-26 07:54:15 UTC (rev 3442)
@@ -1,43 +1,50 @@
-#' predict method for TimeSeriesModel object.
+#' @title Predicts asset returns based on a fitted time series factor model
#'
-#' Generic function of predict method for fitTimeSeriesFactorModel. It utilizes
-#' function \code{predict.lm}.
+#' @description S3 \code{predict} method for object of class \code{tsfm}. It
+#' calls the \code{predict} method for fitted objects of class \code{lm},
+#' \code{lmRob} or \code{lars} as appropriate.
#'
-#' @param object A fit object created by fitTimeSeiresFactorModel.
-#' @param newdata A vector, matrix, data.frame, xts, timeSeries or zoo object to be coerced.
-#' @param ... Any other arguments used in \code{predict.lm}, such as \code{newdata} and
-#' \code{fit.se}.
-#' @author Yi-An Chen.
+#' @param object an object of class \code{\link[stats]{tsfm}} produced by
+#' \code{fitTSFM}.
+#' @param newdata a vector, matrix, data.frame, xts, timeSeries or zoo object
+#' containing the variables with which to predict.
+#' @param ... optional arguments passed to \code{predict.lm} or
+#' \code{\link[robust]{predict.lmRob}}, such as \code{se.fit}, or, to
+#' \code{\link[lars]{predict.lars}} such as \code{mode}.
#'
+#' @author Yi-An Chen and Sangeetha Srinivasan
+#'
+#' @seealso \code{\link{fitTSFM}}
+#'
#' @examples
-#'
#' # load data from the database
#' data(managers.df)
#' ret.assets = managers.df[,(1:6)]
#' # fit the factor model with OLS
-#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
-#' factors.names=c("EDHEC.LS.EQ","SP500.TR"),
-#' data=managers.df,fit.method="OLS")
+#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]),
+#' factor.names=c("EDHEC.LS.EQ","SP500.TR"),
+#' data=managers.df, fit.method="OLS")
#'
#' pred.fit <- predict(fit)
#' newdata <- data.frame(EDHEC.LS.EQ = rnorm(n=120), SP500.TR = rnorm(n=120) )
#' rownames(newdata) <- rownames(fit$data)
-#' pred.fit2 <- predict(fit,newdata,interval="confidence")
+#' pred.fit2 <- predict(fit, newdata, interval="confidence")
#'
-#' @method predict TimeSeriesFactorModel
+#' @return \code{predict.tsfm} produces a vector or a matrix of predictions.
+#'
#' @export
#'
-predict.TimeSeriesFactorModel <- function(object,newdata = NULL,...){
-
- if (missing(newdata) || is.null(newdata) ) {
- lapply(object$asset.fit, predict,...)
- } else {
- newdata <- checkData(newdata,method = "data.frame")
- lapply(object$asset.fit, predict ,newdata,... )
- }
+predict.tsfm <- function(object, newdata = NULL, ...){
+
+ if (missing(newdata) || is.null(newdata)) {
+ lapply(object$asset.fit, predict, ...)
+ } else {
+ newdata <- checkData(newdata, method = "data.frame")
+ lapply(object$asset.fit, predict, newdata, ...)
+ }
+}
-}
#
# if ( !(missing(newdata) && !is.null(newdata) )) {
# numAssets <- length(names(fit.macro$asset.fit))
@@ -63,5 +70,5 @@
#
#
# }
-
-
+
+
Modified: pkg/FactorAnalytics/R/print.tsfm.r
===================================================================
--- pkg/FactorAnalytics/R/print.tsfm.r 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/R/print.tsfm.r 2014-06-26 07:54:15 UTC (rev 3442)
@@ -1,39 +1,45 @@
-#' print TimeSeriesfactorModel object
-#'
-#' Generic function of print method for \code{fitTimeSeriesFactorModel}.
-#'
-#'
-#' @param x Fit object created by \code{fitTimeSeriesFactorModel}.
-#' @param digits Integer indicating the number of decimal places. Default is 3.
-#' @param ... Other arguments for \code{print} methods.
-#' @author Yi-An Chen.
-#' @method print TimeSeriesFactorModel
-#' @export
-#' @examples
-#'
-#' # load data from the database
-#' data(managers.df)
-#' fit.macro <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
-#' factors.names=c("EDHEC.LS.EQ","SP500.TR"),
-#' data=managers.df,fit.method="OLS")
-#' print(fit.macro)
-#'
-print.TimeSeriesFactorModel <- function(x,digits=max(3, .Options$digits - 3),...){
- if(!is.null(cl <- x$call)) {
- cat("\nCall:\n")
- dput(cl)
- }
- cat("\nFactor Model:\n")
- tmp <- c(dim(t(x$beta)), nrow(x$data))
- names(tmp) <- c("Factors", "Variables", "Periods")
- print(tmp)
- cat("\nRegression alphas:\n")
- print(x$alpha , digits = digits, ...)
- cat("\nFactor Betas:\n")
- print(t(x$beta), digits = digits, ...)
- cat("\nRegression R-squared:\n")
- print(x$r2, digits = digits, ...)
- cat("\nResidual Variance:\n")
- print(x$resid.variance, digits = digits, ...)
-
-}
+#' @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}}
+#'
+#' @examples
+#' data(managers.df)
+#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]),
+#' factor.names=colnames(managers.df[,7:9]),
+#' market.name="SP500.TR",
+#' data=data, fit.method="OLS", variable.selection="none",
+#' add.up.market=TRUE, add.market.sqd=TRUE)
+#' print(fit)
+#'
+#' @export
+#'
+
+print.tsfm <- function(x, digits=max(3, .Options$digits - 3), ...){
+ if(!is.null(cl <- x$call)){
+ cat("\nCall:\n")
+ dput(cl)
+ }
+ cat("\nFactor Model dimensions:\n")
+ tmp <- c(dim(t(x$beta)), nrow(x$data))
+ names(tmp) <- c("#Factors", "#Assets", "#Periods")
+ print(tmp)
+ cat("\nRegression Alphas:\n")
+ print(x$alpha , digits = digits, ...)
+ cat("\nFactor Betas:\n")
+ print(t(x$beta), digits = digits, ...)
+ cat("\nRegression R-squared values:\n")
+ print(x$r2, digits = digits, ...)
+ cat("\nResidual Volatilities:\n")
+ print(x$resid.sd, digits = digits, ...)
+}
Modified: pkg/FactorAnalytics/R/summary.tsfm.r
===================================================================
--- pkg/FactorAnalytics/R/summary.tsfm.r 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/R/summary.tsfm.r 2014-06-26 07:54:15 UTC (rev 3442)
@@ -1,40 +1,47 @@
-#' summary method for TimeSeriesModel object.
-#'
-#' Generic function of summary method for \code{fitTimeSeriesFactorModel}.
-#'
-#'
-#' @param object An object created by \code{fitTimeSeiresFactorModel}.
-#' @param digits Integer indicates the number of decimal places. Default is 3.
-#' @param ... Other option used in \code{print} method.
-#' @author Yi-An Chen.
-#' @examples
-#'
-#' # load data from the database
-#' data(managers.df)
-#' # fit the factor model with OLS
-#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
-#' factors.names=c("EDHEC.LS.EQ","SP500.TR"),
-#' data=managers.df,fit.method="OLS")
-#' summary(fit)
-#' @method summary TimeSeriesFactorModel
-#' @export
-#'
-summary.TimeSeriesFactorModel <- function(object,digits=3,...){
- if(!is.null(cl <- object$call)) {
- cat("\nCall:\n")
- dput(cl)
- }
- cat("\nFactor Betas\n")
- n <- length(object$assets.names)
- for (i in 1:n) {
- options(digits = digits)
- cat("\n", object$assets.names[i], "\n")
- table.macro <- t(summary(object$asset.fit[[i]])$coefficients)
- colnames(table.macro)[1] <- "alpha"
- print(table.macro,digits = digits,...)
- cat("\nR-square =", object$r2[i] ,",residual variance ="
- , object$resid.variance[i],"\n")
- }
-
-}
-
+#' @title Summarizing fitted time series factor model
+#'
+#' @description S3 \code{summary} method for object of class \code{tsfm}.
+#' Resulting object is of class {summary.tsfm}.
+#'
+#' @param object 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.
+#'
+#' @return Returns an object of class {summary.tsfm}.
+#'
+#' @author Yi-An Chen & Sangeetha Srinivasan.
+#'
+#' @seealso \code{\link{fitTSFM}}
+#'
+#' @examples
+#' data(managers.df)
+#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]),
+#' factor.names=colnames(managers.df[,7:9]),
+#' market.name="SP500.TR",
+#' data=data, fit.method="OLS", variable.selection="none",
+#' add.up.market=TRUE, add.market.sqd=TRUE)
+#' summary(fit)
+#'
+#' @export
+#'
+
+summary.tsfm <- function(object, digits=3, ...){
+ if(!is.null(cl <- object$call)) {
+ cat("\nCall:\n")
+ dput(cl)
+ }
+ cat("\nFactor Betas\n")
+ n <- length(object$assets.names)
+ for (i in 1:n) {
+ options(digits = digits)
+ cat("\n", object$assets.names[i], "\n")
+ table.macro <- t(summary(object$asset.fit[[i]])$coefficients)
+ colnames(table.macro)[1] <- "Intercept"
+ print(table.macro,digits = digits,...)
+ cat("\nR-squared =", object$r2[i] ,",residual volatility ="
+ , object$resid.sd[i],"\n")
+ }
+
+}
+
Modified: pkg/FactorAnalytics/R/tsfm.r
===================================================================
--- pkg/FactorAnalytics/R/tsfm.r 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/R/tsfm.r 2014-06-26 07:54:15 UTC (rev 3442)
@@ -26,15 +26,14 @@
#'
#' @author Sangeetha Srinivasan
#'
-#' @seealso \code\link{fitTSFM}
+#' @seealso \code{\link{fitTSFM}}
#'
#' @examples
-#' \dontrun{
-#' data <- managers.df
+#' data(managers.df)
#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]),
-#' factor.names=colnames(data[,7:9]), market.name="SP500.TR",
+#' factor.names=colnames(managers.df[,7:9]),
+#' market.name="SP500.TR",
#' data=data, fit.method="OLS", variable.selection="none",
#' add.up.market=TRUE, add.market.sqd=TRUE)
#' print(fit)
-#' }
#'
\ No newline at end of file
Added: pkg/FactorAnalytics/man/.Rapp.history
===================================================================
Modified: pkg/FactorAnalytics/man/fitTSFM.Rd
===================================================================
--- pkg/FactorAnalytics/man/fitTSFM.Rd 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/man/fitTSFM.Rd 2014-06-26 07:54:15 UTC (rev 3442)
@@ -170,4 +170,9 @@
Journal of Business, Vol 54, No 4.
}
}
+\seealso{
+\code{\link{summary.tsfm}}, \code{\link{plot.tsfm}},
+\code{\link{predict.tsfm}}, \code{\link{coef.tsfm}},
+\code{\link{fitted.tsfm}}, \code{\link{residuals.tsfm}}
+}
Added: pkg/FactorAnalytics/man/plot.TSFM.Rd
===================================================================
--- pkg/FactorAnalytics/man/plot.TSFM.Rd (rev 0)
+++ pkg/FactorAnalytics/man/plot.TSFM.Rd 2014-06-26 07:54:15 UTC (rev 3442)
@@ -0,0 +1,89 @@
+% Generated by roxygen2 (4.0.1): do not edit by hand
+\name{plot.TSFM}
+\alias{plot.TSFM}
+\title{Plots from a fitted time series factor model}
+\usage{
+plot.TSFM(x, colorset = c(1:12), legend.loc = NULL, which.plot = c("none",
+ "1L", "2L", "3L", "4L", "5L", "6L", "7L"), max.show = 6,
+ plot.single = FALSE, asset.name, which.plot.single = c("none", "1L", "2L",
+ "3L", "4L", "5L", "6L", "7L", "8L", "9L", "10L", "11L", "12L", "13L"),
+ VaR.method = "historical", ...)
+}
+\arguments{
+\item{x}{an object of class \code{tsfm} produced by \code{fitTSFM}.}
+
+\item{colorset}{a vector of colors for the bars or bar components. Argument
+is used by \code{\link[graphics]{barplot}}. Default is c(1:12).}
+
+\item{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}.}
+
+\item{which.plot}{a number or "none" to indicate which type of group plot to
+create for multiple assets. Default is "none"; which brings up the following
+menu to select a type. \cr
+1 = "Fitted asset returns", \cr
+2 = "R-squared", \cr
+3 = "Residual Volatility",\cr
+4 = "FM Correlation",\cr
+5 = "Factors' Contribution to SD",\cr
+6 = "Factors' Contribution to ES",\cr
+7 = "Factors' Contribution to VaR"}
+
+\item{max.show}{maximum number of assets in a plot. Default is 6.}
+
+\item{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}.}
+
+\item{asset.name}{name of the individual asset to be plotted. Is necessary
+if \code{plot.single=TRUE}}
+
+\item{which.plot.single}{a number or "none" to indicate which type of group
+plot to create for multiple assets. Default is "none"; which brings up the
+following menu to select a type.\cr
+ 1 = time series plot of actual and fitted factor 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
+ 5 = SACF and PACF of residuals,\cr
+ 6 = SACF and PACF of squared residuals,\cr
+ 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 an observation window of length 24.}
+
+\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 passed to or from other methods.}
+}
+\description{
+S3 \code{plot} method for object of class \code{tsfm}. Plots
+selected characteristics for one or more assets.
+}
+\examples{
+\dontrun{
+# load data from the database
+data(managers.df)
+fit.macro <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]),
+ factor.names=c("EDHEC.LS.EQ","SP500.TR"),
+ data=managers.df,fit.method="OLS")
+# plot all assets and show only the first 4 assets.
+plot(fit.macro,max.show=4)
+# plot of an individual asset, "HAM1"
+plot(fit.macro, plot.single=TRUE, asset.name="HAM1")
+}
+}
+\author{
+Eric Zivot, Yi-An Chen and Sangeetha Srinivasan
+}
+\seealso{
+\code{\link{fitTSFM}}
+}
+
Deleted: pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd
===================================================================
--- pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd 2014-06-26 07:54:15 UTC (rev 3442)
@@ -1,77 +0,0 @@
-% Generated by roxygen2 (4.0.1): do not edit by hand
-\name{plot.TimeSeriesFactorModel}
-\alias{plot.TimeSeriesFactorModel}
-\title{plot TimeSeriesFactorModel object.}
-\usage{
-\method{plot}{TimeSeriesFactorModel}(x, colorset = c(1:12),
- legend.loc = NULL, which.plot = c("none", "1L", "2L", "3L", "4L", "5L",
- "6L", "7L"), max.show = 6, plot.single = FALSE, asset.name,
- which.plot.single = c("none", "1L", "2L", "3L", "4L", "5L", "6L", "7L",
- "8L", "9L", "10L", "11L", "12L", "13L"), VaR.method = "historical", ...)
-}
-\arguments{
-\item{x}{fit object created by \code{fitTimeSeriesFactorModel}.}
-
-\item{colorset}{Defualt colorset the same as \code{barplot}.}
-
-\item{legend.loc}{Plot legend or not. Defualt is \code{NULL}.}
-
-\item{which.plot}{Integer indicates which plot to create: "none" will
-create a menu to choose. Defualt is none.\cr
-1 = "Fitted factor returns", \cr
-2 = "R square", \cr
-3 = "Variance of Residuals",\cr
-4 = "FM Correlation",\cr
-5 = "Factor Contributions to SD",\cr
-6 = "Factor Contributions to ES",\cr
-7 = "Factor Contributions to VaR"}
-
-\item{max.show}{Maximum assets to plot. Default is 6.}
-
-\item{plot.single}{Plot a single asset of lm class. Defualt is \code{FALSE}.}
-
-\item{asset.name}{Name of the asset to be plotted.}
-
-\item{which.plot.single}{Integer indicates which plot to create: "none"
-will create a menu to choose. Defualt is none.\cr
- 1 = time series plot of actual and fitted values,\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
- 5 = SACF and PACF of residuals,\cr
- 6 = SACF and PACF of squared residuals,\cr
- 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 24 month window.}
-
-\item{VaR.method}{Character, method for computing VaR. Valid choices are
-either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR}
-in the PerformanceAnalytics package. Default is "historical".}
-
-\item{...}{further arguments passed to or from other methods.}
-}
-\description{
-Generic function of plot method for fitTimeSeriesFactorModel. Either plot
-all assets or choose a single asset to plot.
-}
-\examples{
-\dontrun{
-# load data from the database
-data(managers.df)
-fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
- factors.names=c("EDHEC.LS.EQ","SP500.TR"),
- data=managers.df,fit.method="OLS")
-# plot of all assets and show only first 4 assets.
-plot(fit.macro,max.show=4)
-# single plot of HAM1 asset
-plot(fit.macro, plot.single=TRUE, asset.name="HAM1")
-}
-}
-\author{
-Eric Zivot and Yi-An Chen.
-}
-
Deleted: pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd
===================================================================
--- pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd 2014-06-26 03:57:07 UTC (rev 3441)
+++ pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd 2014-06-26 07:54:15 UTC (rev 3442)
@@ -1,37 +0,0 @@
-% Generated by roxygen2 (4.0.1): do not edit by hand
-\name{predict.TimeSeriesFactorModel}
-\alias{predict.TimeSeriesFactorModel}
-\title{predict method for TimeSeriesModel object.}
-\usage{
-\method{predict}{TimeSeriesFactorModel}(object, newdata = NULL, ...)
-}
-\arguments{
-\item{object}{A fit object created by fitTimeSeiresFactorModel.}
-
-\item{newdata}{A vector, matrix, data.frame, xts, timeSeries or zoo object to be coerced.}
-
-\item{...}{Any other arguments used in \code{predict.lm}, such as \code{newdata} and
-\code{fit.se}.}
-}
-\description{
-Generic function of predict method for fitTimeSeriesFactorModel. It utilizes
-function \code{predict.lm}.
-}
-\examples{
-# load data from the database
-data(managers.df)
-ret.assets = managers.df[,(1:6)]
-# fit the factor model with OLS
-fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
- factors.names=c("EDHEC.LS.EQ","SP500.TR"),
- data=managers.df,fit.method="OLS")
-
-pred.fit <- predict(fit)
-newdata <- data.frame(EDHEC.LS.EQ = rnorm(n=120), SP500.TR = rnorm(n=120) )
-rownames(newdata) <- rownames(fit$data)
-pred.fit2 <- predict(fit,newdata,interval="confidence")
-}
-\author{
-Yi-An Chen.
-}
-
Added: pkg/FactorAnalytics/man/predict.tsfm.Rd
===================================================================
--- pkg/FactorAnalytics/man/predict.tsfm.Rd (rev 0)
+++ pkg/FactorAnalytics/man/predict.tsfm.Rd 2014-06-26 07:54:15 UTC (rev 3442)
@@ -0,0 +1,47 @@
+% Generated by roxygen2 (4.0.1): do not edit by hand
+\name{predict.tsfm}
+\alias{predict.tsfm}
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3442
More information about the Returnanalytics-commits
mailing list