[Returnanalytics-commits] r3443 - in pkg/FactorAnalytics: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jun 27 05:57:26 CEST 2014
Author: pragnya
Date: 2014-06-27 05:57:26 +0200 (Fri, 27 Jun 2014)
New Revision: 3443
Removed:
pkg/FactorAnalytics/man/plot.TSFM.Rd
Modified:
pkg/FactorAnalytics/NAMESPACE
pkg/FactorAnalytics/R/factorModelCovariance.r
pkg/FactorAnalytics/R/fitTSFM.R
pkg/FactorAnalytics/R/paFM.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/factorModelCovariance.Rd
pkg/FactorAnalytics/man/fitTSFM.Rd
pkg/FactorAnalytics/man/paFM.Rd
pkg/FactorAnalytics/man/predict.tsfm.Rd
pkg/FactorAnalytics/man/print.tsfm.Rd
pkg/FactorAnalytics/man/summary.tsfm.Rd
Log:
Edits to fitTSFM and related method functions for consistency in description and names.
Modified: pkg/FactorAnalytics/NAMESPACE
===================================================================
--- pkg/FactorAnalytics/NAMESPACE 2014-06-26 07:54:15 UTC (rev 3442)
+++ pkg/FactorAnalytics/NAMESPACE 2014-06-27 03:57:26 UTC (rev 3443)
@@ -22,7 +22,7 @@
export(fitTSFM)
export(pCornishFisher)
export(paFM)
-export(plot.TSFM)
+export(plot.tsfm)
export(predict.tsfm)
export(print.tsfm)
export(qCornishFisher)
Modified: pkg/FactorAnalytics/R/factorModelCovariance.r
===================================================================
--- pkg/FactorAnalytics/R/factorModelCovariance.r 2014-06-26 07:54:15 UTC (rev 3442)
+++ pkg/FactorAnalytics/R/factorModelCovariance.r 2014-06-27 03:57:26 UTC (rev 3443)
@@ -1,88 +1,102 @@
-#' Compute Factor Model Covariance Matrix.
-#'
-#' Compute asset return covariance matrix from factor model.
-#'
-#' The return on asset \code{i} is assumed to follow the
-#' factor model
-#' \cr \code{R(i,t) = alpha + t(beta)*F(t) + e(i,t), e(i,t) ~ iid(0, sig(i)^2)} \cr
-#' where \code{beta} is a \code{K x 1} vector of factor
-#' exposures. The return variance is then \cr \code{var(R(i,t) =
-#' t(beta)*var(F(t))*beta + sig(i)^2}, \cr and the \code{N x N} covariance
-#' matrix of the return vector \code{R} is \cr \code{var(R) = B*var(F(t))*t(B)
-#' + D} \cr where B is the \code{N x K} matrix of asset betas and \code{D} is a
-#' diagonal matrix with \code{sig(i)^2} values along the diagonal.
-#'
-#' @param beta \code{N x K} matrix of factor betas, where \code{N} is the
-#' number of assets and \code{K} is the number of factors.
-#' @param factor.cov \code{K x K} factor return covariance matrix.
-#' @param resid.variance \code{N x 1} vector of asset specific residual
-#' variances from the factor model.
-#' @return \code{N x N} return covariance matrix based on factor model
-#' parameters.
-#' @author Eric Zivot and Yi-An Chen.
-#' @references Zivot, E. and J. Wang (2006), \emph{Modeling Financial Time
-#' Series with S-PLUS, Second Edition}, Springer-Verlag.
-#' @export
-#' @examples
-#' \dontrun{
-#' # Time Series model
-#'
-#' data(managers.df)
-#' factors = managers.df[,(7:9)]
-#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
-#' factors.names=c("EDHEC.LS.EQ","SP500.TR"),
-#' data=managers.df,fit.method="OLS")
-#' factors = managers.df[,(7:8)]
-#' factorModelCovariance(fit$beta,var(factors),fit$resid.variance)
-#'
-#' # Statistical Model
-#' data(stat.fm.data)
-#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=2)
-#' #' factorModelCovariance(t(sfm.pca.fit$loadings),var(sfm.pca.fit$factors),sfm.pca.fit$resid.variance)
-#'
-#' sfm.apca.fit <- fitStatisticalFactorModel(sfm.apca.dat,k=2)
-#'
-#' factorModelCovariance(t(sfm.apca.fit$loadings),
-#' var(sfm.apca.fit$factors),sfm.apca.fit$resid.variance)
-#'
-#' # fundamental factor model example
-#' #'
-#' data(stock)
-#' # there are 447 assets
-#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP")
-#' beta.mat <- subset(stock,DATE == "2003-12-31")[,exposure.names]
-#' beta.mat1 <- cbind(rep(1,447),beta.mat1)
-# FM return covariance
-#' fit.fund <- fitFundamentalFactorModel(exposure.names=c("BOOK2MARKET", "LOG.MARKETCAP")
-#' , data=stock,returnsvar = "RETURN",datevar = "DATE",
-#' assetvar = "TICKER",
-#' wls = TRUE, regression = "classic",
-#' covariance = "classic", full.resid.cov = FALSE)
-#' ret.cov.fundm <- factorModelCovariance(beta.mat1,fit.fund$factor.cov$cov,fit.fund$resid.variance)
-#' fit.fund$returns.cov$cov == ret.cov.fundm
-#' }
-#' @export
-#'
-
-factorModelCovariance <-
-function(beta, factor.cov, resid.variance) {
-
- beta = as.matrix(beta)
- factor.cov = as.matrix(factor.cov)
- sig.e = as.vector(resid.variance)
- if (length(sig.e) > 1) {
- D.e = diag(as.vector(sig.e))
- } else {
- D.e = as.matrix(sig.e)
- }
- if (ncol(beta) != ncol(factor.cov))
- stop("beta and factor.cov must have same number of columns")
-
- if (nrow(D.e) != nrow(beta))
- stop("beta and D.e must have same number of rows")
- cov.fm = beta %*% factor.cov %*% t(beta) + D.e
- if (any(diag(chol(cov.fm)) == 0))
- warning("Covariance matrix is not positive definite")
- return(cov.fm)
-}
-
+#' @title Factor model Covariance Matrix for assets' returns.
+#'
+#' @description Computes the covariance matrix for assets' returns based on a
+#' fitted factor model.
+#'
+#' @details The return on asset \code{i} is assumed to follow a factor model
+#' of the form, \cr \cr \code{R(i,t) = alpha + beta*F(t) + e(i,t)}, \cr \cr
+#' where, \code{e(i,t) ~ iid(0,sig(i)^2)}, \code{beta} is a \code{1 x K} vector
+#' of factor exposures and the error terms are serially uncorrelated and
+#' contenporaneously uncorrelated across assets. Thus, the variance of asset
+#' \code{i}'s return is given by \cr \cr
+#' \code{var(R(i,t)) = beta*var(F(t))*tr(beta) + sig(i)^2}. \cr \cr
+#' And, the \code{N x N} covariance matrix of N asset returns is \cr \cr
+#' \code{var(R) = B*var(F(t))*tr(B) + D}, \cr \cr
+#' where, B is the \code{N x K} matrix of asset betas and \code{D} is a diagonal
+#' matrix with \code{sig(i)^2} along the diagonal.
+#'
+#' @param beta an \code{N x K} matrix of factor betas, where \code{N} is the
+#' number of assets and \code{K} is the number of factors.
+#' @param factor.cov a \code{K x K} factor covariance matrix.
+#' @param resid.sd an \code{N x 1} vector of asset specific residual
+#' volatilities from the factor model.
+#'
+#' @return The computed \code{N x N} covariance matrix for asset returns based
+#' on the given factor model parameters.
+#'
+#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan.
+#'
+#' @references Zivot, E. and J. Wang (2006), \emph{Modeling Financial Time
+#' Series with S-PLUS, Second Edition}, Springer-Verlag.
+#'
+#' @seealso \code{\link{fitTSFM}}, \code{\link{fitSFM}}, \code{\link{fitFFM}}
+#'
+#' @examples
+#' \dontrun{
+#' # Time Series Factor model
+#' data(managers.df)
+#' factors = managers.df[, (7:9)]
+#' fit <- fitTSFM(assets.names=colnames(managers.df[, (1:6)]),
+#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), data=managers.df,
+#' fit.method="OLS")
+#' factors = managers.df[, (7:8)]
+#' factorModelCovariance(fit$beta, var(factors), fit$resid.sd)
+#'
+#' # Statistical Factor Model
+#' data(stat.fm.data)
+#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat, k=2)
+#' #' factorModelCovariance(t(sfm.pca.fit$loadings), var(sfm.pca.fit$factors),
+#' sfm.pca.fit$resid.sd)
+#'
+#' sfm.apca.fit <- fitSFM(sfm.apca.dat, k=2)
+#'
+#' factorModelCovariance(t(sfm.apca.fit$loadings), var(sfm.apca.fit$factors),
+#' sfm.apca.fit$resid.sd)
+#'
+#' # Fundamental Factor Model
+#' data(stock)
+#' # there are 447 assets
+#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP")
+#' beta.mat <- subset(stock, DATE=="2003-12-31")[, exposure.names]
+#' beta.mat1 <- cbind(rep(1, 447), beta.mat1)
+#' # FM return covariance
+#' fit.fund <- fitFFM(exposure.names=c("BOOK2MARKET", "LOG.MARKETCAP"),
+#' data=stock, returnsvar="RETURN", datevar="DATE",
+#' assetvar="TICKER", wls=TRUE, regression="classic",
+#' covariance="classic", full.resid.cov=FALSE)
+#' ret.cov.fundm <- factorModelCovariance(beta.mat1, fit.fund$factor.cov$cov,
+#' fit.fund$resid.sd)
+#' fit.fund$returns.cov$cov == ret.cov.fundm
+#' }
+#' @export
+#'
+
+factorModelCovariance <- function(beta, factor.cov, resid.sd) {
+
+ beta = as.matrix(beta)
+ factor.cov = as.matrix(factor.cov)
+ sig2.e = as.vector(resid.sd)^2
+
+ if (length(sig.e) > 1) {
+ D.e = diag(as.vector(sig2.e))
+ } else {
+ D.e = as.matrix(sig2.e)
+ }
+
+ if (ncol(beta) != ncol(factor.cov)) {
+ stop("'beta' and 'factor.cov' must have same number of columns.")
+ }
+
+ if (nrow(D.e) != nrow(beta)) {
+ stop("'beta' and 'D.e' must have same number of rows.")
+ }
+
+ cov.fm = beta %*% factor.cov %*% t(beta) + D.e
+
+ if (any(diag(chol(cov.fm)) == 0)) {
+ warning("Covariance matrix is not positive definite!")
+ }
+
+ return(cov.fm)
+}
+
Modified: pkg/FactorAnalytics/R/fitTSFM.R
===================================================================
--- pkg/FactorAnalytics/R/fitTSFM.R 2014-06-26 07:54:15 UTC (rev 3442)
+++ pkg/FactorAnalytics/R/fitTSFM.R 2014-06-27 03:57:26 UTC (rev 3443)
@@ -1,11 +1,11 @@
-#' @title Fits a time series factor model (TSFM) using time series regression
+#' @title Fit a time series factor model using time series regression
#'
#' @description Fits a time series (or, macroeconomic) factor model for single
#' or multiple asset returns or excess returns using time series regression.
#' Users can choose between ordinary least squares-OLS, discounted least
#' squares-DLS (or) robust regression. Several variable selection options
#' including Stepwise, Subsets, Lars are available as well. An object of class
-#' \code{\link{tsfm}} is returned.
+#' \code{tsfm} is returned.
#'
#' @details
#' Estimation method "OLS" corresponds to ordinary least squares, "DLS" is
@@ -13,7 +13,7 @@
#' exponentially declining weights that sum to unity, and, "Robust" is robust
#' regression (uses \code{\link[robust]{lmRob}}).
#'
-#' If \code{variable.selection}="none", all chosen factors are used in the
+#' If \code{variable.selection="none"}, all chosen factors are used in the
#' factor model. Whereas, "stepwise" performs traditional forward/backward
#' stepwise OLS regression (using \code{\link[stats]{step}}), that starts from
#' the initial set of factors and adds factors only if the regression fit, as
@@ -27,8 +27,8 @@
#'
#' Note: If \code{variable.selection}="lars" or "lasso", \code{fit.method}
#' will be ignored. And, "Robust" \code{fit.method} is not truly available with
-#' \code{variable.selection}="all subsets"; instead, results are produced for
-#' \code{variable.selection}="none" with "Robust" to include all factors.
+#' \code{variable.selection="all subsets"}; instead, results are produced for
+#' \code{variable.selection="none"} with "Robust" to include all factors.
#'
#' If \code{add.up.market = TRUE}, max(0, Rm-Rf) is added as a factor in the
#' regression, following Henriksson & Merton (1981), to account for market
@@ -42,41 +42,36 @@
#' cross-validated mean squared prediction error using
#' \code{\link[lars]{cv.lars}}.
#'
-#' @param asset.names a character vector containing the names of the assets,
-#' whose returns or excess returns are the dependent variable.
-#' @param factor.names a character vector containing the names of the
-#' macroeconomic factors.
-#' @param market.name name of an optional column for market excess returns
-#' (Rm-Rf). Necessary if \code{add.up.market} or \code{add.up.market.squared}
+#' @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 market.name name of the column for market excess returns (Rm-Rf).
+#' Is required only if \code{add.up.market} or \code{add.up.market.squared}
#' are \code{TRUE}.
-#' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object
-#' containing column(s) named \code{asset.names} and \code{factor.names}.
-#' \code{market.name} is also necessary if \code{add.up.market} or
-#' \code{add.market.sqd} are \code{TRUE}.
+#' @param data vector, matrix, data.frame, xts, timeSeries or zoo object
+#' containing column(s) named \code{asset.names}, \code{factor.names} and
+#' optionally, \code{market.name}.
#' @param fit.method the estimation method, one of "OLS", "DLS" or "Robust".
-#' See details. If \code{variable.selection}="lars" or "lasso",
-#' \code{fit.method} will be ignored. And, "Robust" \code{fit.method} is not
-#' available with \code{variable.selection}="all subsets".
+#' See details.
#' @param variable.selection the variable selection method, one of "none",
#' "stepwise","all subsets","lars" or "lasso". See details.
-#' @param subsets.method a required option for the "all subsets" method; one of
-#' "exhaustive", "forward", "backward" or "seqrep" (sequential replacement)
-#' to specify the type of subset search/selection.
-#' @param nvmax an option for the "all subsets" method; a scalar, specifies
-#' the maximum size of subsets to examine. Default is 8.
-#' @param force.in an option for the "all subsets" method; a vector containing
-#' the names of factors that should always be included in the model. Default
-#' is NULL.
-#' @param num.factors.subset an option for the "all subsets" method; a scalar
-#' number of factors required in the factor model. Default is 1.
+#' @param subsets.method one of "exhaustive", "forward", "backward" or "seqrep"
+#' (sequential replacement) to specify the type of subset search/selection.
+#' Required if "all subsets" variable selection is chosen.
+#' @param nvmax the maximum size of subsets to examine; an option for
+#' "all subsets" variable selection. Default is 8.
+#' @param force.in vector containing the names of factors that should always
+#' be included in the model; an option for "all subsets" variable selection.
+#' Default is NULL.
+#' @param num.factors.subset number of factors required in the factor model;
+#' an option for "all subsets" variable selection. Default is 1.
#' Note: nvmax >= num.factors.subset >= length(force.in).
-#' @param add.up.market a logical value that when set to \code{TRUE}, adds
-#' max(0, Rm-Rf) as a regressor. If \code{TRUE}, \code{market.name} is
-#' required. Default is \code{FALSE}. See Details.
-#' @param add.market.sqd a logical value that when set to \code{TRUE}, adds
-#' (Rm-Rf)^2 as a regressor. If \code{TRUE}, \code{market.name} is
-#' required. Default is \code{FALSE}.
-#' @param decay a scalar, specifies the decay factor for
+#' @param add.up.market logical; If \code{TRUE}, adds max(0, Rm-Rf) as a
+#' regressor and \code{market.name} is also required. Default is \code{FALSE}.
+#' See Details.
+#' @param add.market.sqd logical; If \code{TRUE}, adds (Rm-Rf)^2 as a
+#' regressor and \code{market.name} is also required. Default is \code{FALSE}.
+#' @param decay a scalar in (0, 1] to specify the decay factor for
#' \code{fit.method="DLS"}. Default is 0.95.
#' @param lars.criterion an option to assess model selection for the "lars" or
#' "lasso" variable.selection methods; one of "Cp" or "cv". See details.
@@ -88,13 +83,12 @@
#' include other controls passed to \code{lmRob} soon.
#'
#' @return fitTSFM returns an object of class
-#' \code{tsfm}.The returned object is a list
+#' \code{tsfm}. The returned object is a list
#' containing the following components:
-#' \describe{
-#' \item{asset.fit}{list of the fitted objects for each asset. Each fitted
-#' object is of class \code{lm} if \code{fit.method} is "OLS" or "DLS";
-#' of class \code{lmRob} if the \code{fit.method} is "Robust"; of class
-#' \code{lars} if \code{variable.selection}="lars" or "lasso".}
+#' \item{asset.fit}{list of fitted objects for each asset. Each object is of
+#' class \code{lm} if \code{fit.method="OLS" or "DLS"}, class \code{lmRob} if
+#' the \code{fit.method="Robust"}, or class \code{lars} if
+#' \code{variable.selection="lars" or "lasso"}.}
#' \item{alpha}{N x 1 vector of estimated alphas.}
#' \item{beta}{N x K matrix of estimated betas.}
#' \item{r2}{N x 1 vector of R-squared values.}
@@ -105,7 +99,6 @@
#' \item{factor.names}{factor.names as input.}
#' \item{fit.method}{fit.method as input.}
#' \item{variable.selection}{variable.selection as input.}
-#' }
#' Where N is the number of assets and K is the number of factors.
#'
#' @family Factor Models
@@ -126,10 +119,16 @@
#' 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}}
+#' @seealso The following generic method functions: \code{\link{plot.tsfm}},
+#' \code{\link{predict.tsfm}}, \code{\link{print.tsfm}} and
+#' \code{\link{summary.tsfm}}.
#'
+#' And, the following extractor functions: \code{\link{coef.tsfm}},
+#' \code{\link{cov.tsfm}}, \code{\link{fitted.tsfm}} and
+#' \code{\link{residuals.tsfm}}.
+#'
+#' \code{\link{paFM}} for Performance Attribution.
+#'
#' @examples
#' \dontrun{
#' # load data from the database
Modified: pkg/FactorAnalytics/R/paFM.r
===================================================================
--- pkg/FactorAnalytics/R/paFM.r 2014-06-26 07:54:15 UTC (rev 3442)
+++ pkg/FactorAnalytics/R/paFM.r 2014-06-27 03:57:26 UTC (rev 3443)
@@ -1,234 +1,233 @@
-#' Compute performance attribution
+#' @title Compute performance attribution in factor models
#'
-#' Decompose total returns into returns attributed to factors and specific returns.
-#' Class of \code{"pafm"} is generated and generic function \code{plot()} and \code{summary()},\code{print()} can be applied.
+#' @description Decompose total returns into returns attributed to factors and
+#' specific returns. An object of class \code{"pafm"} is generated and generic
+#' functions such as \code{plot}, \code{summary} and \code{print} can be used.
#'
-#' Total returns can be decomposed into returns attributed to factors and
-#' specific returns. \cr \eqn{R_t = \sum b_j * f_jt + u_t,t=1...T} \cr
+#' @details Total returns can be decomposed into returns attributed to factors
+#' and specific returns. \cr \eqn{R_t = \sum b_j * f_jt + u_t,t=1...T} \cr
#' \code{b_j} is exposure to factor j and \code{f_jt} is factor j.
#' The returns attributed to factor j is \code{b_j * f_jt} and specific
#' returns is \code{u_t}.
#'
-#' @param fit Class of "TimeSeriesFactorModel", "FundamentalFactorModel" or
-#' "statFactorModel".
-#' @param ... Other controled variables for fit methods.
-#' @return an object of class \code{"pafm"} containing
-#' \itemize{
-#' \item{cum.ret.attr.f} N X J matrix of cumulative return attributed to
-#' factors.
-#' \item{cum.spec.ret} 1 x N vector of cumulative specific returns.
-#' \item{attr.list} list of time series of attributed returns for every
-#' portfolio.
+#' @param fit an object of class \code{tsfm}, \code{sfm} or \code{ffm}.
+#' @param ... other arguments/controls passed to the fit methods.
+#'
+#' @return The returned object is of class \code{"pafm"} containing
+#' \describe{
+#' \item{cum.ret.attr.f}{N X J matrix of cumulative return attributed to
+#' factors.}
+#' \item{cum.spec.ret}{1 x N vector of cumulative specific returns.}
+#' \item{attr.list}{list of time series of attributed returns for every
+#' portfolio.}
#' }
-#' @author Yi-An Chen.
-#' @references Grinold,R and Kahn R, \emph{Active Portfolio Management},
+#'
+#' @author Yi-An Chen and Sangeetha Srinivasan
+#'
+#' @references Grinold, R. and Kahn, R. \emph{Active Portfolio Management},
#' McGraw-Hill.
-#' @export
-#' @examples
#'
+#' @seealso \code{\link{fitTSFM}}, \code{\link{fitSFM}}, \code{\link{fitFFM}}
+#'
+#' @examples
#' \dontrun{
#' data(managers.df)
-#' fit.ts <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
-#' factors.names=c("EDHEC.LS.EQ","SP500.TR"),
-#' data=managers.df,fit.method="OLS")
-#' # withoud benchmark
+#' fit.ts <- fitTSFM(assets.names=colnames(managers.df[, (1:6)]),
+#' factors.names=c("EDHEC.LS.EQ","SP500.TR"),
+#' data=managers.df, fit.method="OLS")
+#' # without benchmark
#' fm.attr <- paFM(fit.ts)
#' }
#'
+#' @export
#'
-paFM <-
- function(fit,...) {
+
+paFM <- function(fit, ...) {
+
+ if (class(fit)!="tsfm" & class(fit)!="ffm" & class(fit)!="sfm") {
+ stop("Class has to be one of 'tsfm', 'ffm' or 'sfm'.")
+ }
+
+ # TSFM chunk
+
+ if (class(fit)=="tsfm") {
+ # return attributed to factors
+ cum.attr.ret <- fit$beta
+ cum.spec.ret <- fit$alpha
+ factorName = colnames(fit$beta)
+ fundName = rownames(fit$beta)
- if (class(fit) !="TimeSeriesFactorModel" & class(fit) !="FundamentalFactorModel"
- & class(fit) != "StatFactorModel")
- {
- stop("Class has to be either 'TimeSeriesFactorModel', 'FundamentalFactorModel' or
- 'StatFactorModel'.")
+ attr.list <- list()
+
+ for (k in fundName) {
+ fit.lm = fit$asset.fit[[k]]
+
+ ## extract information from lm object
+ data <- checkData(fit$data)
+ date <- index(na.omit(data[, k]))
+ actual.xts = xts(fit.lm$model[1], as.Date(date))
+ # attributed returns
+ # active portfolio management p.512 17A.9
+ # top-down method
+
+ cum.ret <- Return.cumulative(actual.xts)
+ # setup initial value
+ attr.ret.xts.all <- xts(, as.Date(date))
+
+ for ( i in factorName ) {
+
+ if (is.na(fit$beta[k, i])) {
+ cum.attr.ret[k, i] <- NA
+ attr.ret.xts.all <- merge(attr.ret.xts.all,
+ xts(rep(NA, length(date)), as.Date(date)))
+ } else {
+ attr.ret.xts <- actual.xts -
+ xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]),
+ as.Date(date))
+ cum.attr.ret[k, i] <- cum.ret -
+ Return.cumulative(actual.xts - attr.ret.xts)
+ attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts)
+ }
+ }
+
+ # specific returns
+ spec.ret.xts <- actual.xts -
+ xts(as.matrix(fit.lm$model[, -1])%*%as.matrix(fit.lm$coef[-1]),
+ as.Date(date))
+ cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts - spec.ret.xts)
+ attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts)
+ colnames(attr.list[[k]]) <- c(factorName, "specific.returns")
}
+ }
+
+ if (class(fit)=="ffm" ) {
+ # if benchmark is provided
+ #
+ # if (!is.null(benchmark)) {
+ # stop("use fitFundamentalFactorModel instead")
+ # }
+ # return attributed to factors
+ factor.returns <- fit$factor.returns[, -1]
+ factor.names <- colnames(fit$beta)
+ date <- index(factor.returns)
+ ticker <- fit$asset.names
- # TimeSeriesFactorModel chunk
+ #cumulative return attributed to factors
+ if (factor.names[1] == "(Intercept)") {
+ # discard intercept
+ cum.attr.ret <- matrix(, nrow=length(ticker), ncol=length(factor.names),
+ dimnames=list(ticker, factor.names))[, -1]
+ } else {
+ cum.attr.ret <- matrix(, nrow=length(ticker), ncol=length(factor.names),
+ dimnames=list(ticker, factor.names))
+ }
+ cum.spec.ret <- rep(0, length(ticker))
+ names(cum.spec.ret) <- ticker
- if (class(fit) == "TimeSeriesFactorModel") {
-
- # return attributed to factors
- cum.attr.ret <- fit$beta
- cum.spec.ret <- fit$alpha
- factorName = colnames(fit$beta)
- fundName = rownames(fit$beta)
+ # make list of every asstes and every list contains return attributed to
+ # factors and specific returns
+ attr.list <- list()
+
+ for (k in ticker) {
+ idx <- which(fit$data[, fit$assetvar]== k)
+ returns <- fit$data[idx, fit$returnsvar]
+ num.f.names <- intersect(fit$exposure.names, factor.names)
- attr.list <- list()
+ # check if there is industry factors
+ if (length(setdiff(fit$exposure.names, factor.names)) > 0) {
+ ind.f <- matrix(rep(fit$beta[k, ][-(1:length(num.f.names))],
+ length(idx)), nrow=length(idx), byrow=TRUE)
+ colnames(ind.f) <- colnames(fit$beta)[-(1:length(num.f.names))]
+ exposure <- cbind(fit$data[idx, num.f.names], ind.f)
+ } else {
+ exposure <- fit$data[idx, num.f.names]
+ }
+ attr.factor <- exposure * coredata(factor.returns)
+ specific.returns <- returns - apply(attr.factor, 1, sum)
+ attr <- cbind(attr.factor, specific.returns)
+ attr.list[[k]] <- xts(attr, as.Date(date))
+ cum.attr.ret[k, ] <- apply(attr.factor, 2, Return.cumulative)
+ cum.spec.ret[k] <- Return.cumulative(specific.returns)
+ }
+ }
+
+ if (class(fit)=="sfm") {
+
+ # return attributed to factors
+ cum.attr.ret <- t(fit$loadings)
+ cum.spec.ret <- fit$r2
+ factorName = rownames(fit$loadings)
+ fundName = colnames(fit$loadings)
+ data <- checkData(fit$data)
+ # create list for attribution
+ attr.list <- list()
+ # pca method
+
+ if ( dim(fit$asset.ret)[1] > dim(fit$asset.ret)[2] ) {
+
for (k in fundName) {
fit.lm = fit$asset.fit[[k]]
-
## extract information from lm object
- data <- checkData(fit$data)
- date <- index(na.omit(data[,k]))
+ date <- index(data[, k])
+ # probably needs more general Date setting
actual.xts = xts(fit.lm$model[1], as.Date(date))
# attributed returns
# active portfolio management p.512 17A.9
- # top-down method
-
cum.ret <- Return.cumulative(actual.xts)
# setup initial value
attr.ret.xts.all <- xts(, as.Date(date))
for ( i in factorName ) {
-
- if (is.na(fit$beta[k,i])) {
- cum.attr.ret[k,i] <- NA
- attr.ret.xts.all <- merge(attr.ret.xts.all,xts(rep(NA,length(date)),as.Date(date)))
- } else {
- attr.ret.xts <- actual.xts - xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]),
- as.Date(date))
- cum.attr.ret[k,i] <- cum.ret - Return.cumulative(actual.xts-attr.ret.xts)
- attr.ret.xts.all <- merge(attr.ret.xts.all,attr.ret.xts)
- }
+ attr.ret.xts <- actual.xts -
+ xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]),
+ as.Date(date))
+ cum.attr.ret[k, i] <- cum.ret -
+ Return.cumulative(actual.xts - attr.ret.xts)
+ attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts)
}
-
# specific returns
- spec.ret.xts <- actual.xts - xts(as.matrix(fit.lm$model[,-1])%*%as.matrix(fit.lm$coef[-1]),
- as.Date(date))
+ spec.ret.xts <- actual.xts -
+ xts(as.matrix(fit.lm$model[, -1])%*%as.matrix(fit.lm$coef[-1]),
+ as.Date(date))
cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts)
- attr.list[[k]] <- merge(attr.ret.xts.all,spec.ret.xts)
- colnames(attr.list[[k]]) <- c(factorName,"specific.returns")
+ attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts)
+ colnames(attr.list[[k]]) <- c(factorName, "specific.returns")
}
+ } else {
+ # apca method:
+ # fit$loadings # f X K
+ # fit$factors # T X f
+ date <- index(fit$factors)
-
- }
-
- if (class(fit) =="FundamentalFactorModel" ) {
- # if benchmark is provided
-#
-# if (!is.null(benchmark)) {
-# stop("use fitFundamentalFactorModel instead")
-# }
- # return attributed to factors
- factor.returns <- fit$factor.returns[,-1]
- factor.names <- colnames(fit$beta)
- date <- index(factor.returns)
- ticker <- fit$asset.names
-
-
-
- #cumulative return attributed to factors
- if (factor.names[1] == "(Intercept)") {
- cum.attr.ret <- matrix(,nrow=length(ticker),ncol=length(factor.names),
- dimnames=list(ticker,factor.names))[,-1] # discard intercept
- } else {
- cum.attr.ret <- matrix(,nrow=length(ticker),ncol=length(factor.names),
- dimnames=list(ticker,factor.names))
- }
- cum.spec.ret <- rep(0,length(ticker))
- names(cum.spec.ret) <- ticker
-
- # make list of every asstes and every list contains return attributed to factors
- # and specific returns
-
- attr.list <- list()
- for (k in ticker) {
- idx <- which(fit$data[,fit$assetvar]== k)
- returns <- fit$data[idx,fit$returnsvar]
- num.f.names <- intersect(fit$exposure.names,factor.names)
- # check if there is industry factors
- if (length(setdiff(fit$exposure.names,factor.names))>0 ){
- ind.f <- matrix(rep(fit$beta[k,][-(1:length(num.f.names))],length(idx)),nrow=length(idx),byrow=TRUE)
- colnames(ind.f) <- colnames(fit$beta)[-(1:length(num.f.names))]
- exposure <- cbind(fit$data[idx,num.f.names],ind.f)
- } else {exposure <- fit$data[idx,num.f.names] }
+ for ( k in fundName) {
+ attr.ret.xts.all <- xts(, as.Date(date))
+ actual.xts <- xts(fit$asset.ret[, k], as.Date(date))
+ cum.ret <- Return.cumulative(actual.xts)
- attr.factor <- exposure * coredata(factor.returns)
- specific.returns <- returns - apply(attr.factor,1,sum)
- attr <- cbind(attr.factor,specific.returns)
- attr.list[[k]] <- xts(attr,as.Date(date))
- cum.attr.ret[k,] <- apply(attr.factor,2,Return.cumulative)
- cum.spec.ret[k] <- Return.cumulative(specific.returns)
- }
-
-
-
- }
-
- if (class(fit) == "StatFactorModel") {
-
- # return attributed to factors
- cum.attr.ret <- t(fit$loadings)
- cum.spec.ret <- fit$r2
- factorName = rownames(fit$loadings)
- fundName = colnames(fit$loadings)
- data <- checkData(fit$data)
- # create list for attribution
- attr.list <- list()
- # pca method
-
- if ( dim(fit$asset.ret)[1] > dim(fit$asset.ret)[2] ) {
-
-
- for (k in fundName) {
- fit.lm = fit$asset.fit[[k]]
-
- ## extract information from lm object
- date <- index(data[,k])
- # probably needs more general Date setting
- actual.xts = xts(fit.lm$model[1], as.Date(date))
- # attributed returns
- # active portfolio management p.512 17A.9
-
- cum.ret <- Return.cumulative(actual.xts)
- # setup initial value
- attr.ret.xts.all <- xts(, as.Date(date))
- for ( i in factorName ) {
- attr.ret.xts <- actual.xts - xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]),
- as.Date(date))
- cum.attr.ret[k,i] <- cum.ret - Return.cumulative(actual.xts-attr.ret.xts)
- attr.ret.xts.all <- merge(attr.ret.xts.all,attr.ret.xts)
-
-
- }
-
- # specific returns
- spec.ret.xts <- actual.xts - xts(as.matrix(fit.lm$model[,-1])%*%as.matrix(fit.lm$coef[-1]),
- as.Date(date))
- cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts)
- attr.list[[k]] <- merge(attr.ret.xts.all,spec.ret.xts)
- colnames(attr.list[[k]]) <- c(factorName,"specific.returns")
+ for (i in factorName) {
+ attr.ret.xts <- xts(fit$factors[, i] * fit$loadings[i, k],
+ as.Date(date))
+ attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts)
+ cum.attr.ret[k, i] <- cum.ret - Return.cumulative(actual.xts -
+ attr.ret.xts)
}
- } else {
- # apca method
- # fit$loadings # f X K
- # fit$factors # T X f
-
- date <- index(fit$factors)
- for ( k in fundName) {
- attr.ret.xts.all <- xts(, as.Date(date))
- actual.xts <- xts(fit$asset.ret[,k],as.Date(date))
- cum.ret <- Return.cumulative(actual.xts)
- for (i in factorName) {
- attr.ret.xts <- xts(fit$factors[,i] * fit$loadings[i,k], as.Date(date) )
- attr.ret.xts.all <- merge(attr.ret.xts.all,attr.ret.xts)
- cum.attr.ret[k,i] <- cum.ret - Return.cumulative(actual.xts-attr.ret.xts)
- }
- spec.ret.xts <- actual.xts - xts(fit$factors%*%fit$loadings[,k],as.Date(date))
- cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts)
- attr.list[[k]] <- merge(attr.ret.xts.all,spec.ret.xts)
- colnames(attr.list[[k]]) <- c(factorName,"specific.returns")
- }
-
-
- }
-
- }
-
-
-
- ans = list(cum.ret.attr.f=cum.attr.ret,
- cum.spec.ret=cum.spec.ret,
- attr.list=attr.list)
- class(ans) = "pafm"
- return(ans)
+ spec.ret.xts <- actual.xts - xts(fit$factors%*%fit$loadings[, k],
+ as.Date(date))
+ cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3443
More information about the Returnanalytics-commits
mailing list