[Returnanalytics-commits] r2987 - in pkg/FactorAnalytics: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Sep 4 21:09:14 CEST 2013
Author: chenyian
Date: 2013-09-04 21:09:13 +0200 (Wed, 04 Sep 2013)
New Revision: 2987
Modified:
pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r
pkg/FactorAnalytics/R/fitStatisticalFactorModel.R
pkg/FactorAnalytics/man/factorModelPerformanceAttribution.Rd
Log:
add benchmark and active returns performance attribution in factorModelPerformanceAttribution.r
Modified: pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r
===================================================================
--- pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r 2013-09-04 12:57:34 UTC (rev 2986)
+++ pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r 2013-09-04 19:09:13 UTC (rev 2987)
@@ -1,25 +1,25 @@
-# performance attribution
-# Yi-An Chen
-# July 30, 2012
-
-
-
-#' Compute BARRA-type performance attribution
+#' Compute performance attribution
#'
#' Decompose total returns or active returns into returns attributed to factors
#' and specific returns. Class of FM.attribution is generated and generic
#' function \code{plot()} and \code{summary()},\code{print()} can be used.
#'
#' total returns can be decomposed into returns attributed to factors and
-#' specific returns. \eqn{R_t = \sum_j b_{jt} * f_{jt} +
-#' u_t},t=1..T,\eqn{b_{jt}} is exposure to factor j and \eqn{f_{jt}} is factor
-#' j. The returns attributed to factor j is \eqn{b_{jt} * f_{jt}} and portfolio
-#' specific returns is \eqn{u_t}
+#' specific returns. \eqn{R_t = \sum_j b_{j} * f_{jt} +
+#' u_t},t=1..T,\eqn{b_{j}} is exposure to factor j and \eqn{f_{jt}} is factor
+#' j. The returns attributed to factor j is \eqn{b_{j} * f_{jt}} and specific
+#' returns is \eqn{u_t}.
#'
+#' If benchmark is provided. active returns = total returns - benchmark returns =
+#' active returns attributed to factors + specific returns. Specifically,
+#' \eqn{R_t = \sum_j b_{j}^A * f_{jt} + u_t},t=1..T, \eqn{b_{j}^A} is \emph{active beta} to factor j
+#' and \eqn{f_{jt}} is factor j. The active returns attributed to factor j is
+#' \eqn{b_{j}^A * f_{jt}} specific returns is \eqn{u_t}, and \eqn{b_{j}^A = b_{j}-1}
+#'
#' @param fit Class of "TimeSeriesFactorModel", "FundamentalFactorModel" or
#' "statFactorModel".
#' @param benchmark a xts, vector or data.frame provides benchmark time series
-#' returns.
+#' returns. If benchmark is provided, active returns decomposition will be calculated.
#' @param ... Other controled variables for fit methods.
#' @return an object of class \code{FM.attribution} containing
#' \itemize{
@@ -47,20 +47,9 @@
#'
factorModelPerformanceAttribution <-
function(fit,benchmark=NULL,...) {
-
- # input
- # fit : Class of MacroFactorModel, FundamentalFactorModel and statFactorModel
- # benchmark: benchmark returns, default is NULL. If benchmark is provided, active returns
- # is used.
- # ... : controlled variables for fitMacroeconomicsFactorModel and fitStatisticalFactorModel
- # output
- # class of "FMattribution"
- #
- # plot.FMattribution
- # summary.FMattribution
- # print.FMattribution
- require(xts)
-
+
+ require(PerformanceAnalytics)
+
if (class(fit) !="TimeSeriesFactorModel" & class(fit) !="FundamentalFactorModel"
& class(fit) != "StatFactorModel")
{
@@ -68,194 +57,203 @@
'StatFactorModel'.")
}
- # TimeSeriesFactorModel chunk
+ # TimeSeriesFactorModel chunk
- if (class(fit) == "TimeSeriesFactorModel") {
+ 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)
+
+ 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))
+ if (!is.null(benchmark)) {
+ benchmark.xts <- checkData(benchmark)[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 {
+ if (!is.null(benchmark)) {
+ attr.ret.xts <- actual.xts - xts(as.matrix(benchmark.xts)%*%as.matrix(fit.lm$coef[i]-1),
+ 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 benchmark is provided
-
-# if (!is.null(benchmark)) {
-# ret.assets = fit$data[] - benchmark
-# fit = fitTimeSeriesFactorModel(ret.assets=ret.assets,...)
-# }
-
- # return attributed to factors
- cum.attr.ret <- fit$beta
- cum.spec.ret <- fit$alpha
- factorName = colnames(fit$beta)
- fundName = rownames(fit$beta)
-
- attr.list <- list()
-
- for (k in fundName) {
- fit.lm = fit$asset.fit[[k]]
+ if (class(fit) =="FundamentalFactorModel" ) {
+ # if benchmark is provided
- ## 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))
+ 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
- # 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 ) {
+ #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] }
- 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.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)
}
-
- # 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) =="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)
- dates <- 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] }
-
- 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(dates))
- cum.attr.ret[k,] <- apply(attr.factor,2,Return.cumulative)
- cum.spec.ret[k] <- Return.cumulative(specific.returns)
- }
-
-
-
-}
-
if (class(fit) == "StatFactorModel") {
- # if benchmark is provided
-
- if (!is.null(benchmark)) {
- x = fit$asset.ret - benchmark
- fit = fitStatisticalFactorModel(data=x,...)
- }
# 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(fit$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 ) {
-
+ for (k in fundName) {
+ fit.lm = fit$asset.fit[[k]]
+
+ ## extract information from lm object
+ date <- index(fit$data[,k])
+ # probably needs more general Date setting
+ actual.xts = xts(fit.lm$model[1], as.Date(date))
+ if (!is.null(benchmark)) {
+ benchmark.xts <- checkData(benchmark)[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 ) {
+ if (!is.null(benchmark)) {
+ attr.ret.xts <- actual.xts - xts(as.matrix(benchmark.xts)%*%as.matrix(fit.lm$coef[i]-1),
+ 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))
+ 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")
}
-
- # 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")
- }
} else {
- # apca method
-# fit$loadings # f X K
-# fit$factors # T X f
+ # apca method
+ # fit$loadings # f X K
+ # fit$factors # T X f
- dates <- index(fit$factors)
+ date <- index(fit$factors)
for ( k in fundName) {
- attr.ret.xts.all <- xts(, as.Date(dates))
- actual.xts <- xts(fit$asset.ret[,k],as.Date(dates))
+ attr.ret.xts.all <- xts(, as.Date(date))
+ actual.xts <- xts(fit$asset.ret[,k],as.Date(date))
cum.ret <- Return.cumulative(actual.xts)
+ if (!is.null(benchmark)) {
+ benchmark.xts <- checkData(benchmark)[as.Date(date)]
+ }
for (i in factorName) {
- attr.ret.xts <- xts(fit$factors[,i] * fit$loadings[i,k], as.Date(dates) )
- 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(dates))
+ if (!is.null(benchmark)) {
+ attr.ret.xts <- actual.xts - xts(coredata(benchmark.xts)*(fit$loadings[i,k]-1),
+ as.Date(date))
+ } else {
+ 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)
+ attr.list[[k]] <- merge(attr.ret.xts.all,spec.ret.xts)
colnames(attr.list[[k]]) <- c(factorName,"specific.returns")
}
-
- }
-
+
+ }
+
}
@@ -263,6 +261,6 @@
ans = list(cum.ret.attr.f=cum.attr.ret,
cum.spec.ret=cum.spec.ret,
attr.list=attr.list)
-class(ans) = "FM.attribution"
-return(ans)
- }
+ class(ans) = "FM.attribution"
+ return(ans)
+ }
Modified: pkg/FactorAnalytics/R/fitStatisticalFactorModel.R
===================================================================
--- pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2013-09-04 12:57:34 UTC (rev 2986)
+++ pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2013-09-04 19:09:13 UTC (rev 2987)
@@ -342,37 +342,37 @@
# check data
data.xts <- checkData(data,method="xts")
-data <- coredata(data.xts)
+
call <- match.call()
- pos <- rownames(data)
- data <- as.matrix(data)
- if(any(is.na(data))) {
+ pos <- rownames(coredata(data.xts))
+ data.m <- as.matrix(coredata(data.xts))
+ if(any(is.na(data.m))) {
if(na.rm) {
- data <- na.omit(data)
+ data.m <- na.omit(data.m)
} else {
stop("Missing values are not allowed if na.rm=F.")
}
}
# use PCA if T > N
- if(ncol(data) < nrow(data)) {
+ if(ncol(data.m) < nrow(data.m)) {
if(is.character(k)) {
stop("k must be the number of factors for PCA.")
}
- if(k >= ncol(data)) {
+ if(k >= ncol(data.m)) {
stop("Number of factors must be smaller than number of variables."
)
}
- ans <- mfactor.pca(data, k, check = check)
+ ans <- mfactor.pca(data.m, k, check = check)
} else if(is.character(k)) {
- ans <- mfactor.test(data, k, refine = refine, check =
+ ans <- mfactor.test(data.m, k, refine = refine, check =
check, max.k = max.k, sig = sig)
} else { # use aPCA if T <= N
- if(k >= ncol(data)) {
+ if(k >= ncol(data.m)) {
stop("Number of factors must be smaller than number of variables."
)
}
- ans <- mfactor.apca(data, k, refine = refine, check =
+ ans <- mfactor.apca(data.m, k, refine = refine, check =
check)
}
@@ -383,20 +383,20 @@
f <- as.matrix(f)
}
- if(nrow(data) < ncol(data)) {
- mimic <- ginv(data) %*% f
+ if(nrow(data.m) < ncol(data.m)) {
+ mimic <- ginv(data.m) %*% f
} else {
- mimic <- qr.solve(data, f)
+ mimic <- qr.solve(data.m, f)
}
mimic <- t(t(mimic)/colSums(mimic))
- dimnames(mimic)[[1]] <- dimnames(data)[[2]]
+ dimnames(mimic)[[1]] <- dimnames(data.m)[[2]]
ans$mimic <- mimic
ans$resid.variance <- apply(ans$residuals,2,var)
ans$call <- call
ans$data <- data
- ans$assets.names <- colnames(data)
+ ans$assets.names <- colnames(data.m)
class(ans) <- "StatFactorModel"
return(ans)
}
Modified: pkg/FactorAnalytics/man/factorModelPerformanceAttribution.Rd
===================================================================
--- pkg/FactorAnalytics/man/factorModelPerformanceAttribution.Rd 2013-09-04 12:57:34 UTC (rev 2986)
+++ pkg/FactorAnalytics/man/factorModelPerformanceAttribution.Rd 2013-09-04 19:09:13 UTC (rev 2987)
@@ -1,6 +1,6 @@
\name{factorModelPerformanceAttribution}
\alias{factorModelPerformanceAttribution}
-\title{Compute BARRA-type performance attribution}
+\title{Compute performance attribution}
\usage{
factorModelPerformanceAttribution(fit, benchmark = NULL,
...)
@@ -10,7 +10,8 @@
"FundamentalFactorModel" or "statFactorModel".}
\item{benchmark}{a xts, vector or data.frame provides
- benchmark time series returns.}
+ benchmark time series returns. If benchmark is provided,
+ active returns decomposition will be calculated.}
\item{...}{Other controled variables for fit methods.}
}
@@ -31,11 +32,20 @@
}
\details{
total returns can be decomposed into returns attributed
- to factors and specific returns. \eqn{R_t = \sum_j b_{jt}
- * f_{jt} + u_t},t=1..T,\eqn{b_{jt}} is exposure to factor
+ to factors and specific returns. \eqn{R_t = \sum_j b_{j}
+ * f_{jt} + u_t},t=1..T,\eqn{b_{j}} is exposure to factor
j and \eqn{f_{jt}} is factor j. The returns attributed to
- factor j is \eqn{b_{jt} * f_{jt}} and portfolio specific
- returns is \eqn{u_t}
+ factor j is \eqn{b_{j} * f_{jt}} and specific returns is
+ \eqn{u_t}.
+
+ If benchmark is provided. active returns = total returns
+ - benchmark returns = active returns attributed to
+ factors + specific returns. Specifically, \eqn{R_t =
+ \sum_j b_{j}^A * f_{jt} + u_t},t=1..T, \eqn{b_{j}^A} is
+ \emph{active beta} to factor j and \eqn{f_{jt}} is factor
+ j. The active returns attributed to factor j is
+ \eqn{b_{j}^A * f_{jt}} specific returns is \eqn{u_t}, and
+ \eqn{b_{j}^A = b_{j}-1}
}
\examples{
data(managers.df)
More information about the Returnanalytics-commits
mailing list