[Returnanalytics-commits] r2331 - in pkg: . PortfolioAttribution PortfolioAttribution/R PortfolioAttribution/data PortfolioAttribution/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 29 18:47:30 CET 2013
Author: braverock
Date: 2013-03-29 18:47:30 +0100 (Fri, 29 Mar 2013)
New Revision: 2331
Added:
pkg/PortfolioAttribution/
pkg/PortfolioAttribution/DESCRIPTION
pkg/PortfolioAttribution/NAMESPACE
pkg/PortfolioAttribution/R/
pkg/PortfolioAttribution/R/AcctReturns.R
pkg/PortfolioAttribution/R/Attribution.geometric.R
pkg/PortfolioAttribution/R/AttributionFixedIncome.R
pkg/PortfolioAttribution/R/CAPM.dynamic.R
pkg/PortfolioAttribution/R/Carino.R
pkg/PortfolioAttribution/R/Conv.option.R
pkg/PortfolioAttribution/R/DaviesLaker.R
pkg/PortfolioAttribution/R/Frongello.R
pkg/PortfolioAttribution/R/Grap.R
pkg/PortfolioAttribution/R/HierarchyQuintiles.R
pkg/PortfolioAttribution/R/MarketTiming.R
pkg/PortfolioAttribution/R/Menchero.R
pkg/PortfolioAttribution/R/Modigliani.R
pkg/PortfolioAttribution/R/Return.annualized.excess.R
pkg/PortfolioAttribution/R/Return.level.R
pkg/PortfolioAttribution/R/Weight.level.R
pkg/PortfolioAttribution/R/Weight.transform.R
pkg/PortfolioAttribution/R/attribution.R
pkg/PortfolioAttribution/R/attribution.levels.R
pkg/PortfolioAttribution/R/logLinking.R
pkg/PortfolioAttribution/R/logLinkingZoo.R
pkg/PortfolioAttribution/R/periodApplyEZ.R
pkg/PortfolioAttribution/R/relativeAttribution.R
pkg/PortfolioAttribution/R/relativeAttributionWithoutFactors.R
pkg/PortfolioAttribution/data/
pkg/PortfolioAttribution/data/attrib.rda
pkg/PortfolioAttribution/man/
pkg/PortfolioAttribution/man/AcctReturns.Rd
pkg/PortfolioAttribution/man/Attribution.Rd
pkg/PortfolioAttribution/man/Attribution.geometric.Rd
pkg/PortfolioAttribution/man/Attribution.levels.Rd
pkg/PortfolioAttribution/man/AttributionFixedIncome.Rd
pkg/PortfolioAttribution/man/CAPM.dynamic.Rd
pkg/PortfolioAttribution/man/Carino.Rd
pkg/PortfolioAttribution/man/Conv.option.Rd
pkg/PortfolioAttribution/man/DaviesLaker.Rd
pkg/PortfolioAttribution/man/Frongello.Rd
pkg/PortfolioAttribution/man/Grap.Rd
pkg/PortfolioAttribution/man/HierarchyQuintiles.Rd
pkg/PortfolioAttribution/man/MarketTiming.Rd
pkg/PortfolioAttribution/man/Menchero.Rd
pkg/PortfolioAttribution/man/Modigliani.Rd
pkg/PortfolioAttribution/man/Return.annualized.excess.Rd
pkg/PortfolioAttribution/man/Return.level.Rd
pkg/PortfolioAttribution/man/Weight.level.Rd
pkg/PortfolioAttribution/man/Weight.transform.Rd
pkg/PortfolioAttribution/man/attrib.Rd
pkg/PortfolioAttribution/test_suite.R
Log:
- move GSoC 2012 'attribution' project to PortfolioAttribution
Added: pkg/PortfolioAttribution/DESCRIPTION
===================================================================
--- pkg/PortfolioAttribution/DESCRIPTION (rev 0)
+++ pkg/PortfolioAttribution/DESCRIPTION 2013-03-29 17:47:30 UTC (rev 2331)
@@ -0,0 +1,46 @@
+Package: attribution
+Type: Package
+Title: Econometric tools for performance and risk analysis.
+Version: 0.1
+Date: $Date: 2012-06-06 15:18:48 -0500 (Wed, 06 Jun 2012) $
+Author: Andrii Babii
+Maintainer: Brian G. Peterson <brian at braverock.com>
+Description: GSoC stub for attribution
+Depends:
+ R (>= 2.14.0),
+ zoo,
+ xts (>= 0.8),
+ PerformanceAnalytics(>= 1.0.4.3)
+Suggests:
+ Hmisc,
+ MASS,
+ tseries,
+ quadprog,
+ sn,
+ robustbase,
+ quantreg,
+ gplots,
+ ff
+License: GPL
+URL: http://r-forge.r-project.org/projects/returnanalytics/
+Copyright: (c) 2004-2012
+Collate:
+ 'Attribution.geometric.R'
+ 'attribution.levels.R'
+ 'attribution.R'
+ 'AttributionFixedIncome.R'
+ 'CAPM.dynamic.R'
+ 'Carino.R'
+ 'Conv.option.R'
+ 'DaviesLaker.R'
+ 'Frongello.R'
+ 'Grap.R'
+ 'HierarchyQuintiles.R'
+ 'Menchero.R'
+ 'Modigliani.R'
+ 'Return.annualized.excess.R'
+ 'Return.level.R'
+ 'MarketTiming.R'
+ 'Weight.level.R'
+ 'Weight.transform.R'
+ 'AcctReturns.R'
Added: pkg/PortfolioAttribution/NAMESPACE
===================================================================
--- pkg/PortfolioAttribution/NAMESPACE (rev 0)
+++ pkg/PortfolioAttribution/NAMESPACE 2013-03-29 17:47:30 UTC (rev 2331)
@@ -0,0 +1,19 @@
+export(AcctReturns)
+export(Attribution)
+export(Attribution.geometric)
+export(Attribution.levels)
+export(AttributionFixedIncome)
+export(CAPM.dynamic)
+export(Carino)
+export(Conv.option)
+export(DaviesLaker)
+export(Frongello)
+export(Grap)
+export(HierarchyQuintiles)
+export(MarketTiming)
+export(Menchero)
+export(Modigliani)
+export(Return.annualized.excess)
+export(Return.level)
+export(Weight.level)
+export(Weight.transform)
Added: pkg/PortfolioAttribution/R/AcctReturns.R
===================================================================
--- pkg/PortfolioAttribution/R/AcctReturns.R (rev 0)
+++ pkg/PortfolioAttribution/R/AcctReturns.R 2013-03-29 17:47:30 UTC (rev 2331)
@@ -0,0 +1,129 @@
+#' Calculate account returns
+#'
+#' Similar to the \code{PortfReturns} function, but gives returns for the
+#' entire account and takes into account external cashflows. External cashflows
+#' are defined as contributions to or withdrawals from the account. Allows
+#' selecting between time-weighted returns and linked modified Dietz approach.
+#' If time-weighted method is selected, returns at time \eqn{t} are computed
+#' using: \deqn{r_{t}=\frac{V_{t}}{V_{t-1}+C_{t}}-1}
+#' where \eqn{V_{t}} - account value at time \eqn{t}, \eqn{C_{t}} - cashflow at
+#' time \eqn{t}. The implicit assumption made here is that the cash flow is
+#' available for the portfolio manager to invest from the beginning of the day.
+#' These returns then can be chain linked with geometric compounding (for
+#' instance using \code{Return.cumulative} function from the
+#' \code{PerformanceAnalytics} package) to yield cumulative multi-period
+#' returns:
+#' \deqn{1+r=\prod_{t=1}^{T}(1+r_{t})=\prod_{t=1}^{T}\frac{V_{t}}{V_{t-1}+C_{t}}}
+#' In the case if there were no cashflows, the result reduces to simple
+#' one-period returns. Time-weighted returns has also an interpretation in
+#' terms of unit value pricing.
+#' If Modified Dietz method is selected, monthly returns are computed taking
+#' into account cashflows within each month:
+#' \deqn{r = \frac{V_{t}-V_{t-1}-C}{V_{t-1}+\sum_{t}C_{t}\times W_{t}}}
+#' where \eqn{C} - total external cash flows within a month,
+#' \eqn{C_{t}} - external cashflow at time \eqn{t},
+#' \deqn{W_{t}=\frac{TD-D_{t}}{TD}} - weighting ratio to be applied to external
+#' cashflow on day \eqn{t},
+#' \eqn{TD} - total number of days within the month,
+#' \eqn{D_{t}} - number of days since the beginning of the month including
+#' weekends and public holidays.
+#' Finally monthly Modified Dietz returns can also be linked geometrically.
+#'
+#' @aliases AcctReturns
+#' @param Account string name of the account to generate returns for
+#' @param \dots any other passthru parameters (like \code{native} for
+#' \code{.getBySymbol}
+#' @param Dates xts style ISO 8601 date subset to retrieve, default NULL
+#' (all dates)
+#' @param Portfolios concatenated string vector for portfolio names to retrieve
+#' returns on, default NULL (all portfolios)
+#' @param method Used to select between time-weighted and linked modified Dietz
+#' returns. May be any of: \itemize{\item timeweighted \item dietz} By default
+#' time-weighted is selected
+#' @return returns xts with account returns
+#' @author Brian Peterson, Andrii Babii
+#' @seealso PortfReturns
+#' @references Christopherson, Jon A., Carino, David R., Ferson, Wayne E.
+#' \emph{Portfolio Performance Measurement and Benchmarking}. McGraw-Hill.
+#' 2009. Chapter 5 \cr Bacon, C. \emph{Practical Portfolio Performance
+#' Measurement and Attribution}. Wiley. 2004. Chapter 2 \cr
+#' @keywords portfolio returns
+#' @note
+#' TODO handle portfolio and account in different currencies (not hard, just not done)
+#'
+#' TODO explicitly handle portfolio weights
+#'
+#' TODO support additions and withdrawals to available capital
+#' @export
+AcctReturns <-
+function(Account, Dates = NULL, Portfolios = NULL, method = c("timeweighted", "dietz"), ...)
+{ # @author Brian Peterson, Andrii Babii
+ aname <- Account
+ if(!grepl("account\\.", aname)){
+ Account <- try(get(paste("account", aname, sep = '.'), envir = .blotter))
+ } else{
+ Account <- try(get(aname, envir = .blotter))
+ }
+ if(inherits(Account, "try-error")){
+ stop(paste("Account ", aname, " not found, use initAcct() to create a new
+ account"))
+ }
+ if(!inherits(Account, "account")){
+ stop("Account ", aname, " passed is not the name of an account object.")
+ }
+ if(is.null(Portfolios)){
+ Portfolios = names(Account$portfolios)
+ }
+
+ # Get xts with net trading P&L for all portfolios associated with account
+ table = NULL
+ for(pname in Portfolios){
+ Portfolio <- getPortfolio(pname)
+ if(is.null(Dates)){
+ Dates <- paste("::", last(index(Portfolio$summary)), sep = '')
+ }
+ ptable = .getBySymbol(Portfolio = Portfolio, Attribute = "Net.Trading.PL",
+ Dates = Dates)
+ if(is.null(table)){
+ table=ptable
+ }
+ else{
+ table=cbind(table,ptable)
+ }
+ }
+ if(!is.null(attr(Account, 'initEq'))){
+ initEq <- as.numeric(attr(Account, 'initEq'))
+ if(initEq == 0){
+ stop("Initial equity of zero would produce div by zero NaN, Inf, -Inf
+ returns, please fix in initAcct().")
+ }
+
+ #TODO check portfolio and account currencies and convert if necessary
+
+ CF = Account$summary$Additions - Account$summary$Withdrawals # Cashflows
+ V = initEq + reclass(rowSums(table), table) # Account values
+ method = method[1]
+
+ if (method == "timeweighted"){
+ # Time-weighted returns
+ returns = V / (lag(V) + CF) - 1
+ }
+
+ if (method == "dietz"){
+ # Linked modified Dietz
+ C = apply.monthly(CF, sum) # total monthly cashflow
+ V = apply.monthly(V, first) # monthly account values
+ cfweighted <- function(CF){
+ TD = ndays(CF) # total number of days within the period
+ # number of days since the beginning of the period
+ D = round(as.vector((index(CF) - index(CF)[1])/3600/24))
+ W = (TD - D) / TD # weights
+ cashfl = sum(CF * W) # weighted sum of cashflows within the period
+ return(cashfl)
+ }
+ cashfl = apply.monthly(CF, cfweighted)
+ returns = (V - lag(V) - C) / (lag(V) + cashfl) # Modified Dietz
+ }
+ }
+ return(returns)
+}
Property changes on: pkg/PortfolioAttribution/R/AcctReturns.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: pkg/PortfolioAttribution/R/Attribution.geometric.R
===================================================================
--- pkg/PortfolioAttribution/R/Attribution.geometric.R (rev 0)
+++ pkg/PortfolioAttribution/R/Attribution.geometric.R 2013-03-29 17:47:30 UTC (rev 2331)
@@ -0,0 +1,176 @@
+#' performs sector-based geometric attribution
+#'
+#' Performs sector-based geometric attribution of excess return. Calculates
+#' total geometric attribution effects over multiple periods. Used internally
+#' by the \code{\link{Attribution}} function. Geometric attribution effects in
+#' the contrast with arithmetic do naturally link over time multiplicatively:
+#' \deqn{\frac{(1+R_{p})}{1+R_{b}}-1=\prod^{n}_{t=1}(1+A_{t}^{G})\times
+#' \prod^{n}_{t=1}(1+S{}_{t}^{G})-1}
+#' Total allocation effect at time \eqn{t}:
+#' \deqn{A_{t}^{G}=\frac{1+b_{S}}{1+R_{bt}}-1}
+#' Total selection effect at time \eqn{t}:
+#' \deqn{S_{t}^{G}=\frac{1+R_{pt}}{1+b_{S}}-1}
+#' Semi-notional fund:
+#' \deqn{b_{S}=\sum^{n}_{i=1}w_{pi}\times R_{bi}}
+#' \eqn{w_{pt}}{wpt} - portfolio weights at time \eqn{t},
+#' \eqn{w_{bt}}{wbt} - benchmark weights at time \eqn{t},
+#' \eqn{r_{t}}{rt} - portfolio returns at time \eqn{t},
+#' \eqn{b_{t}}{bt} - benchmark returns at time \eqn{t},
+#' \eqn{r} - total portfolio returns
+#' \eqn{b} - total benchmark returns
+#' \eqn{n} - number of periods
+#'
+#' The multi-currency geometric attribution is handled following the Appendix A
+#' (Bacon, 2004).
+#'
+#' The individual selection effects are computed using:
+#' \deqn{w_{pi}\times\left(\frac{1+R_{pLi}}{1+R_{bLi}}-1\right)\times
+#' \left(\frac{1+R_{bLi}}{1+b_{SL}}\right)}
+#'
+#' The individual allocation effects are computed using:
+#' \deqn{(w_{pi}-w_{bi})\times\left(\frac{1+R_{bHi}}{1+b_{L}}-1\right)}
+#'
+#' Where the total semi-notional returns hedged into the base currency were
+#' used:
+#' \deqn{b_{SH} = \sum_{i}w_{pi}\times R_{bi}((w_{pi} - w_{bi})R_{bHi} +
+#' w_{bi}R_{bLi})}
+#' Total semi-notional returns in the local currency:
+#' \deqn{b_{SL} = \sum_{i}w_{pi}R_{bLi}}
+#' \eqn{R_{pLi}}{RpLi} - portfolio returns in the local currency
+#' \eqn{R_{bLi}}{RbLi} - benchmark returns in the local currency
+#' \eqn{R_{bHi}}{RbHi} - benchmark returns hedged into the base currency
+#' \eqn{b_{L}}{bL} - total benchmark returns in the local currency
+#' \eqn{r_{L}}{rL} - total portfolio returns in the local currency
+#' The total excess returns are decomposed into:
+#' \deqn{\frac{(1+R_{p})}{1+R_{b}}-1=\frac{1+r_{L}}{1+b_{SL}}\times\frac{1+
+#' b_{SH}}{1+b_{L}}\times\frac{1+b_{SL}}{1+b_{SH}}\times\frac{1+R_{p}}{1+r_{L}}
+#' \times\frac{1+b_{L}}{1+R_{b}}-1}
+#'
+#' where the first term corresponds to the selection, second to the allocation,
+#' third to the hedging cost transferred and the last two to the naive currency
+#' attribution
+#'
+#' @aliases Attribution.geometric
+#' @param Rp xts of portfolio returns
+#' @param wp xts of portfolio weights
+#' @param Rb xts of benchmark returns
+#' @param wb xts of benchmark weights
+#' @param Rpl xts, data frame or matrix of portfolio returns in local currency
+#' @param Rbl xts, data frame or matrix of benchmark returns in local currency
+#' @param Rbh xts, data frame or matrix of benchmark returns hedged into the
+#' base currency
+#' @return This function returns the list with attribution effects (allocation
+#' or selection effect) including total multi-period attribution effects
+#' @author Andrii Babii
+#' @seealso \code{\link{Attribution}}
+#' @references Christopherson, Jon A., Carino, David R., Ferson, Wayne E.
+#' \emph{Portfolio Performance Measurement and Benchmarking}. McGraw-Hill.
+#' 2009. Chapter 18-19 \cr Bacon, C. \emph{Practical Portfolio Performance
+#' Measurement and Attribution}. Wiley. 2004. Chapter 5, 8, Appendix A \cr
+#' @keywords attribution, geometric attribution, geometric linking
+#' @examples
+#'
+#' data(attrib)
+#' Attribution.geometric(Rp = attrib.returns[, 1:10], wp = attrib.weights[1, ],
+#' Rb = attrib.returns[, 11:20], wb = attrib.weights[2, ])
+#'
+#' @export
+Attribution.geometric <-
+function(Rp, wp, Rb, wb, Rpl = NA, Rbl = NA, Rbh = NA)
+{ # @author Andrii Babii
+
+ # DESCRIPTION:
+ # Function to perform the geometric attribution analysis.
+
+ # Inputs:
+ # Rp xts of portfolio returns
+ # wp xts of portfolio weights
+ # Rb xts of benchmark returns
+ # wb xts of benchmark weights
+
+ # Outputs:
+ # This function returns the list with attribution effects (allocation or
+ # selection effect) including total multi-period attribution effects
+
+ # FUNCTION:
+ WP = wp # Save original weights in order to avoid double conversion later
+ WB = wb
+ wp = Weight.transform(wp, Rp)
+ wb = Weight.transform(wb, Rb)
+ currency = !(is.null(dim(Rpl)) & is.null(dim(Rpl)) & is.null(dim(Rpl)))
+
+ # Get total portfolio returns
+ if (is.vector(WP) & is.vector(WB)){
+ rp = Return.portfolio(Rp, WP)
+ rb = Return.portfolio(Rb, WB)
+ } else{
+ rp = Return.rebalancing(Rp, WP)
+ rb = Return.rebalancing(Rb, WB)
+ }
+ names(rp) = "Total"
+ names(rb) = "Total"
+
+ # Allocation notional fund returns
+ bs = reclass(rowSums((wp * coredata(Rb[, 1:ncol(wp)]))), rp)
+ if (!currency){
+ # Geometric attribution effects for individual categories
+ allocation = ((1 + Rb) / (1 + rep(rb, ncol(Rp))) - 1) * coredata(wp - wb)
+ selection = wp * (Rp - coredata(Rb)) / (1 + rep(bs, ncol(Rp)))
+ colnames(allocation) = colnames(Rp)
+
+ } else{
+ Rpl = checkData(Rpl)
+ Rbl = checkData(Rbl)
+ Rbh = checkData(Rbh)
+
+ bsl = reclass(rowSums(Rbl * wp), Rpl)
+ bsh = reclass(rowSums(((wp - wb) * Rbh + wb * Rbl)), Rpl)
+ rpl = reclass(rowSums(Rpl * wp), Rpl)
+ rbl = reclass(rowSums(Rbl * wp), Rpl)
+ allocation = (wp - wb) * ((1 + Rbh) / (1 + rep(rbl, ncol(Rbh))) - 1)
+ selection = wp * ((1 + Rpl) / (1 + Rbl) - 1) * ((1 + Rbl) /
+ (1 + rep(bsl, ncol(Rbl))))
+ hedge = (1 + bsl) / (1 + bsh) - 1
+ currency.attr = (1 + rp) * (1 + rbl) / (1 + rpl) / (1 + rb) - 1
+ curr = cbind(hedge, currency.attr)
+ colnames(curr) = c("Hedging", "Currency attribution")
+ }
+
+ # Total attribution effects are computed as a sum of individual effects
+ allocation = cbind(allocation, rowSums(allocation))
+ selection = cbind(selection, rowSums(selection))
+ colnames(allocation)[ncol(allocation)] = "Total"
+ colnames(selection)[ncol(selection)] = "Total"
+
+ # Link single-period attribution effects
+ a = (apply(1 + allocation[, ncol(allocation)], 2, prod) - 1)
+ s = (apply(1 + selection[, ncol(selection)], 2, prod) - 1)
+ allocation = rbind(as.data.frame(allocation),
+ c(rep(NA, ncol(allocation) - 1), a))
+ selection = rbind(as.data.frame(selection),
+ c(rep(NA, ncol(selection) - 1), s))
+ rownames(allocation)[nrow(allocation)] = "Total"
+ rownames(selection)[nrow(selection)] = "Total"
+
+ # Geometric excess returns + annualized geometric excess returns
+ excess.returns = (1 + rp) / (1 + coredata(rb)) - 1
+ if (nrow(rp) > 1){
+ er = Return.annualized.excess(rp, rb)
+ excess.returns = rbind(as.matrix(excess.returns), er)
+ }
+ colnames(excess.returns) = "Geometric"
+
+ result = list()
+ result[[1]] = excess.returns
+ result[[2]] = allocation
+ result[[3]] = selection
+ if (!currency){
+ names(result) = c("Excess returns", "Allocation", "Selection")
+ } else{
+ result[[4]] = curr
+ names(result) = c("Excess returns", "Allocation", "Selection",
+ "Currency management")
+ }
+
+ return(result)
+}
Property changes on: pkg/PortfolioAttribution/R/Attribution.geometric.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: pkg/PortfolioAttribution/R/AttributionFixedIncome.R
===================================================================
--- pkg/PortfolioAttribution/R/AttributionFixedIncome.R (rev 0)
+++ pkg/PortfolioAttribution/R/AttributionFixedIncome.R 2013-03-29 17:47:30 UTC (rev 2331)
@@ -0,0 +1,185 @@
+#' fixed income attribution
+#'
+#' Performs fixed income attribution. The investment decision process for bond
+#' managers is very different from that of equity managers, therefore for most
+#' fixed income investment strategies the standard Brinson model is not
+#' suitable. Bonds are simply a series of defined future cash flows which are
+#' relatively easy to price. Fixed income performance is therefore driven by
+#' changes in the shape of the yield curve. Systematic risk in the form of
+#' duration is a key part of the investment process. Fixed income attribution
+#' is, in fact, a specialist form of risk-adjusted attribution.
+#' The arithmetic attribution is handled using weighted duration approach
+#' (Van Breukelen, 2000). The allocation, selection and currency allocation
+#' effects for category \eqn{i} are:
+#' \deqn{A_{i} = (D_{pi}\times w_{pi}-D_{\beta}\times D_{bi}\times w_{pi})
+#' \times (-\Delta y_{bi} + \Delta y_{b})}
+#' \deqn{S_{i} = D_{i}\times w_{pi}\times (-\Delta y_{ri} + \Delta y_{bi})}
+#' \deqn{C_{i} = (w_{pi} - w_{bi})\times (c_{i} + R_{fi} - c')}{Ci =
+#' (wpi - wbi) * (ci + Rfi - c')}
+#' where \eqn{w_{pi}}{wpi} - portfolio weights,
+#' \eqn{w_{bi}}{wbi} - benchmark weights,
+#' \eqn{D_{i}}{Di} - modified duration in bond category \eqn{i}.
+#' Duration beta:
+#' \deqn{D_{\beta}=\frac{D_{r}}{D_{b}}}{Dbeta = Dr / Db}
+#' \eqn{D_{r}}{Dr} - portfolio duration,
+#' \eqn{D_{b}}{Db} - benchmark duration,
+#' \eqn{D_{bi}}{Dbi} - benchmark duration for category \eqn{i},
+#' \eqn{D_{pi}}{Dpi} - portfolio duration for category \eqn{i},
+#' \eqn{\Delta y_{ri}}{Delta yri} - change in portfolio yield
+#' for category \eqn{i},
+#' \eqn{\Delta y_{bi}}{Delta ybi} - change in benchmark yield
+#' for category \eqn{i},
+#' \eqn{\Delta y_{b}}{Delta yb} - change in benchmark yield,
+#' \eqn{R_{ci}}{Rci} - currency returns for category \eqn{i},
+#' \eqn{R_{fi}}{Rfi} - risk-free rate in currency of asset \eqn{i},
+#' \deqn{c'= \sum_{i}w_{bi}\times(R_{ci}+R_{fi})}
+#' The geometric attribution is adapted using Van Breukelen (2000) approach for
+#' the arithmetic attribution. The individual allocation and selection effects
+#' are computed as follows:
+#' \deqn{A_{i}=D_{i}w_{pi}-D_{\beta}D_{bi}w_{bi}}{Ai =
+#' Di * wpi - Dbeta * Dbi * wbi}
+#' \deqn{S_{i}=\frac{D_{pi}}{D_{bi}}\times (R_{bi} - R_{fi}) + R_{fi}}{Si =
+#' Dpi / Dbi * (Rbi - Rfi) + Rfi}
+#' @aliases AttributionFixedIncome
+#' @param Rp T x n xts, data frame or matrix of portfolio returns
+#' @param wp vector, xts, data frame or matrix of portfolio weights
+#' @param Rb T x n xts, data frame or matrix of benchmark returns
+#' @param wb vector, xts, data frame or matrix of benchmark weights
+#' @param Rf T x n xts, data frame or matrix with risk free rates
+#' @param Dp T x n xts, data frame or matrix with portfolio modified duration
+#' @param Db T x n xts, data frame or matrix with benchmark modified duration
+#' @param wbf vector, xts, data frame or matrix with benchmark weights of
+#' currency forward contracts
+#' @param S (T + 1) x n xts, data frame or matrix with spot rates. The first
+#' date should coincide with the first date of portfolio returns
+#' @param geometric - TRUE/FALSE for geometric/arithmetic attribution
+#' @return list with total excess returns decomposed into allocation, selection
+#' (and currency effects)
+#' @author Andrii Babii
+#' @seealso \code{\link{Attribution.levels}},
+#' \code{\link{Attribution.geometric}}
+#' @references Bacon, C. \emph{Practical Portfolio Performance Measurement
+#' and Attribution}. Wiley. 2004. Chapter 7 \cr Van Breukelen, G. \emph{Fixed
+#' income attribution}. Journal of Performance Measurement. Sumer.
+#' p. 61-68. 2000 \cr
+#' @keywords attribution
+#' @examples
+#'
+#' data(attrib)
+#' AttributionFixedIncome(Rp = attrib.returns[, 1:10], wp = attrib.weights[1, ], Rb = attrib.returns[, 11:20],
+#' wb = attrib.weights[2, ], Rf = attrib.returns[, 23:32], Dp = attrib.returns[, 63:72], Db = attrib.returns[, 73:82],
+#' S = attrib.currency[, 11:20], wbf = attrib.weights[4, ], geometric = FALSE)
+#'
+#' @export
+AttributionFixedIncome <-
+function (Rp, wp, Rb, wb, Rf, Dp, Db, S, wbf, geometric = FALSE)
+{ # @author Andrii Babii
+
+ # DESCRIPTION:
+ # Function to perform fixed income attribution
+
+ # Inputs:
+ # Rp xts, data frame or matrix of portfolio returns
+ # wp vector, xts, data frame or matrix of portfolio weights
+ # Rb xts, data frame or matrix of benchmark returns
+ # wb vector, xts, data frame or matrix of benchmark weights
+ # Rf xts, data frame or matrix of risk-free rate
+ # Dp T x n xts, data frame or matrix with portfolio modified duration
+ # Db T x n xts, data frame or matrix with benchmark modified duration
+ # S xts, data frame or matrix with spot rates
+ # wbf vector, xts, data frame or matrix with benchmark weights of
+ # currency forward contracts
+
+ # Outputs:
+ # This function returns the
+
+ # FUNCTION:
+ Rf = checkData(Rf)
+ Rp = checkData(Rp)
+ Rb = checkData(Rb)
+ Dp = checkData(Dp)
+ Db = checkData(Db)
+ S = checkData(S)
+ WP = wp # Save original weights in order to avoid double conversion later
+ WB = wb
+ WBF = wbf
+ wp = Weight.transform(wp, Rp)
+ wb = Weight.transform(wb, Rb)
+ wbf = Weight.transform(wbf, Rb)
+ if (ncol(Rb) == 1){
+ Rb = matrix(rep(coredata(Rb), ncol(Rp)), nrow(Rp), ncol(Rp))
+ }
+ if (ncol(Rb) != ncol(Rp)){
+ stop("Please use benchmark xts that has columns with benchmarks for each
+ asset or one common benchmark for all assets")
+ }
+ if (ncol(Db) == 1){
+ Db = matrix(rep(coredata(Db), ncol(Dp)), nrow(Dp), ncol(Dp))
+ }
+ if (ncol(Db) != ncol(Dp)){
+ print("Please use benchmark xts that has columns with benchmarks for each
+ asset or one common benchmark for all assets")
+ }
+ if (is.vector(WP) & is.vector(WB) & is.vector(WBF)){
+ rp = Return.portfolio(Rp, WP, geometric = geometric)
+ rb = Return.portfolio(Rb, WB, geometric = geometric)
+ rf = Return.portfolio(Rf, WP, geometric = geometric)
+ dp = Return.portfolio(Dp, WP, geometric = geometric) # portfolio duration
+ db = Return.portfolio(Db, WB, geometric = geometric) # benchmark duration
+ } else{
+ rp = Return.rebalancing(Rp, WP, geometric = geometric)
+ rb = Return.rebalancing(Rb, WB, geometric = geometric)
+ rf = Return.rebalancing(Rf, WP, geometric = geometric)
+ dp = Return.rebalancing(Dp, WP, geometric = geometric)
+ db = Return.rebalancing(Db, WB, geometric = geometric)
+ }
+ names(rp) = "Total"
+ names(rb) = "Total"
+ Dbeta = dp / coredata(db)
+ # Implied benchmark yield changes
+ DeltaYb = -(Rb - coredata(Rf)) / coredata(Db)
+ # Implied portfolio yield changes
+ DeltaYp = -(Rp - coredata(Rf)) / coredata(Dp)
+ # Implied total benchmark yield changes
+ deltayb = rep(rb - coredata(rp), ncol(Dp)) / coredata(Dp)
+ # Currency returns
+ Rc = lag(S, -1)[1:nrow(Rp), ] / S[1:nrow(Rp), ] - 1
+ rc = reclass(rowSums((wb + wbf) * (Rc + coredata(Rf))), Rc)
+ if (!geometric){
+ allocation = (Dp * wp - rep(Dbeta, ncol(Dp)) * coredata(Db) * wb) *
+ coredata(-DeltaYb + deltayb)
+ selection = Dp * coredata(wp) * coredata(-DeltaYp + coredata(DeltaYb))
+ currency = (wp - wb) * (Rc + coredata(Rf) - rep(rc, ncol(Rc)))
+ excess.returns = rp - coredata(rb)
+ } else{
+ rcprime = rowSums(wb * (Rc + Rf))
+ bd = reclass(rowSums(rep(Dbeta, ncol(Db)) * Db * coredata(wb) *
+ coredata(-DeltaYb)), Db) + rcprime # Overal duration notional fund
+ allocation = Dp * wp - rep(Dbeta, ncol(Dp)) * coredata(Db) * wb *
+ coredata(-DeltaYb + deltayb) / rep(bd, ncol(Db))
+ selection = Dp / coredata(Db) * coredata(Rb - coredata(Rf)) + Rf
+ excess.returns = (1 + rp) / (1 + coredata(rb)) - 1
+ }
+
+ # Get total attribution effects
+ n = ncol(allocation) # number of segments
+ allocation = cbind(allocation, rowSums(allocation))
+ names(allocation)[n + 1] = "Total"
+ selection = cbind(selection, rowSums(selection))
+ names(selection)[n + 1] = "Total"
+
+ result = list()
+ result[[1]] = excess.returns
+ result[[2]] = allocation
+ result[[3]] = selection
+ names(result) = c("Excess returns", "Market allocation", "Issue selection")
+
+ if (!geometric){
+ currency = cbind(currency, rowSums(currency))
+ names(currency)[ncol(currency)] = "Total"
+ result[[4]] = currency
+ names(result) = c("Excess returns", "Market allocation",
+ "Issue selection", "Currency allocation")
+ }
+ return(result)
+}
\ No newline at end of file
Property changes on: pkg/PortfolioAttribution/R/AttributionFixedIncome.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: pkg/PortfolioAttribution/R/CAPM.dynamic.R
===================================================================
--- pkg/PortfolioAttribution/R/CAPM.dynamic.R (rev 0)
+++ pkg/PortfolioAttribution/R/CAPM.dynamic.R 2013-03-29 17:47:30 UTC (rev 2331)
@@ -0,0 +1,101 @@
+#' Time-varying conditional beta
+#'
+#' CAPM is estimated assuming that betas and alphas change over time. It is
+#' assumed that the market prices of securities fully reflect readily available
+#' and public information. A matrix of market information variables, \eqn{Z}
+#' measures this information. Possible variables in \eqn{Z} could be the
+#' divident yield, Tresaury yield, etc. The betas of stocks and managed
+#' portfolios are allowed to change with market conditions:
+#' \deqn{\beta_{p}(z_{t})=b_{0p}+B_{p}'z_{t}}{beta(zt) = b0 + Bp'zt}
+#' where \eqn{z_{t}=Z_{t}-E[Z]}{zt = Zt - E[Z]} - a normalized vector of the
+#' deviations of \eqn{Z_{t}}{Zt}, \eqn{B_{p}}{Bp} - a vector with the same
+#' dimension as \eqn{Z_{t}}{Zt}. The coefficient \eqn{b_{0p}}{b0} can be
+#' interpreted as the "average beta" or the beta when all infromation variables
+#' are at their means. The elements of \eqn{B_{p}}{Bp} measure the sensitivity
+#' of the conditional beta to the deviations of the \eqn{Z_{t}}{Zt} from their
+#' means.
+#' In the similar way the time-varying conditional alpha is modeled:
+#' \deqn{\alpha_{pt}=\alpha_{p}(z_{t})=\alpha_{0p}+A_{p}'z_{t}}{alpha(zt) =
+#' a0 + Ap'zt}
+#' The modified regression is therefore:
+#' \deqn{r_{pt+1}=\alpha_{0p}+A_{p}'z_{t}+b_{0p}r_{bt+1}+B_{p}'[z_{t}r_{bt+1}]+
+#' \mu_{pt+1}}
+#'
+#' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' the asset returns
+#' @param Rb an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' the benchmark asset return
+#' @param Rf risk free rate, in same period as your returns
+#' @param Z an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' k variables that reflect public information
+#' @param lags number of lags before the current period on which the alpha and
+#' beta are conditioned
+#' @param \dots any other passthrough parameters
+#' @author Andrii Babii
+#' @seealso \code{\link{CAPM.beta}}
+#' @references J. Christopherson, D. Carino, W. Ferson. \emph{Portfolio
+#' Performance Measurement and Benchmarking}. 2009. McGraw-Hill. Chapter 12.
+#' \cr Wayne E. Ferson and Rudi Schadt, "Measuring Fund Strategy and
+#' Performance in Changing Economic Conditions," \emph{Journal of Finance},
+#' vol. 51, 1996, pp.425-462 \cr
+#' @examples
+#'
+#' data(managers)
+#' CAPM.dynamic(managers[,1,drop=FALSE], managers[,8,drop=FALSE], Rf=.035/12, Z=managers[, 9:10])
+#' CAPM.dynamic(managers[80:120,1:6], managers[80:120,7,drop=FALSE], Rf=managers[80:120,10,drop=FALSE], Z=managers[80:120, 9:10])
+#' CAPM.dynamic(managers[80:120,1:6], managers[80:120,8:7], managers[80:120,10,drop=FALSE], Z=managers[80:120, 9:10])
+#'
+#' @export
+CAPM.dynamic <- function (Ra, Rb, Rf = 0, Z, lags = 1, ...)
+{ # @author Andrii Babii
+
+ # FUNCTION
+
+ Ra = checkData(Ra)
+ Rb = checkData(Rb)
+ Z = checkData(Z)
+ Z = na.omit(Z)
+ if (!is.null(dim(Rf)))
+ Rf = checkData(Rf)
+ Ra.ncols = NCOL(Ra)
+ Rb.ncols = NCOL(Rb)
+ pairs = expand.grid(1:Ra.ncols)
+
+ xRa = Return.excess(Ra, Rf)[1:(nrow(Ra) - 1)]
+ xRb = Return.excess(Rb, Rf)[1:(nrow(Rb) - 1)]
+ z = Z - matrix(rep(mean(Z), nrow(Z)), nrow(Z), ncol(Z), byrow = TRUE)
+ # Construct the matrix with information regressors (lagged values)
+ inform = lag(z)
+ if (lags > 1){
+ for (i in 2:lags) {
+ inform = cbind(inform, lag(z, i))
+ }
+ }
+ z = inform[(lags + 1):nrow(z), ]
+
+ dynamic <- function (xRa, xRb, z){
+ y = xRa[1:nrow(z)]
+ X = cbind(z, coredata(xRb[1:nrow(z)]), z * matrix(rep(xRb[1:nrow(z)], ncol(z)), nrow(z), ncol(z)))
+ X.df = as.data.frame(X)
+ model = lm(xRa[1:nrow(z)] ~ 1 + ., data = X.df)
+ return(coef(model))
+ }
+ result = apply(pairs, 1, FUN = function(n, xRa, xRb, z)
+ dynamic(xRa[, n[1]], xRb[, 1], z), xRa = xRa, xRb = xRb, z = z)
+ result = t(result)
+
+ if (ncol(Rb) > 1){
+ for (i in 2:ncol(xRb)){
+ res = apply(pairs, 1, FUN = function(n, xRa, xRb, z)
+ dynamic(xRa[, n[1]], xRb[, i], z), xRa = xRa, xRb = xRb, z = z)
+ res = t(res)
+ result = rbind(result, res)
+ }
+ }
+
+ a = paste(rep(colnames(Z), lags), "alpha at t -", expand.grid(1:ncol(Z), 1:lags)[, 2])
+ b = paste(rep(colnames(Z), lags), "beta at t -", expand.grid(1:ncol(Z), 1:lags)[, 2])
+ colnames(result) = c("Average alpha", a, "Average beta", b)
+ rownames(result) = paste(rep(colnames(Ra), ncol(Rb)), "to", rep(colnames(Rb), each = ncol(Ra)))
+ return(result)
+}
\ No newline at end of file
Property changes on: pkg/PortfolioAttribution/R/CAPM.dynamic.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: pkg/PortfolioAttribution/R/Carino.R
===================================================================
--- pkg/PortfolioAttribution/R/Carino.R (rev 0)
+++ pkg/PortfolioAttribution/R/Carino.R 2013-03-29 17:47:30 UTC (rev 2331)
@@ -0,0 +1,95 @@
+#' calculates total attribution effects using logarithmic smoothing
+#'
+#' Calculates total attribution effects over multiple periods using
+#' logarithmic linking method. Used internally by the \code{\link{Attribution}}
+#' function. Arithmetic attribution effects do not naturally link over time.
+#' This function uses logarithmic smoothing to adjust attribution effects
+#' so that they can be summed up over multiple periods. Attribution effect
+#' are multiplied by the adjustment factor:
+#' \deqn{A_{t}' = A_{t} \times \frac{k_{t}}{k}}{At' = At * kt / k}
+#' where \deqn{k_{t} = \frac{log(1 + R_{pt}) -
+#' log(1 + R_{bt})}{R_{pt} - R_{bt}}}
+#' \deqn{k = \frac{log(1 + R_{p}) - log(1 + R_{b})}{R_{p} - R_{b}}}
+#' In case if portfolio and benchmark returns are equal:
+#' \deqn{k_{t} = \frac{1}{1 + R_{pt}}}{kt = 1 / (1 + Rpt)}
+#' where \eqn{A_{t}'}{At'} - adjusted attribution effects at period \eqn{t},
+#' \eqn{A_{t}}{At} - unadjusted attribution effects at period \eqn{t},
+#' \eqn{R_{pt}}{Rpt} - portfolio returns at period \eqn{t},
+#' \eqn{R_{bt}}{Rbt} - benchmark returns at period \eqn{t},
+#' \eqn{R_{p}}{Rp} - total portfolio returns,
+#' \eqn{R_{b}}{Rb} - total benchmark returns,
+#' \eqn{n} - number of periods
+#' The total arithmetic excess returns can be explained in terms of the sum
+#' of adjusted attribution effects:
+#' \deqn{R_{p} - R_{b} = \sum^{n}_{t=1}\left(Allocation_{t}+Selection_{t}+
+#' Interaction_{t}\right)}
+#'
+#' @aliases Carino
+#' @param rp xts of portfolio returns
+#' @param rb xts of benchmark returns
+#' @param attributions xts with attribution effects
+#' @return returns a data frame with original attribution effects and total
+#' attribution effects over multiple periods
+#' @param adjusted TRUE/FALSE, whether to show original or smoothed attribution
+#' effects for each period
+#' @author Andrii Babii
+#' @seealso \code{\link{Attribution}} \cr \code{\link{Menchero}} \cr
+#' \code{\link{Grap}} \cr \code{\link{Frongello}} \cr
+#' \code{\link{Attribution.geometric}}
+#' @references Christopherson, Jon A., Carino, David R., Ferson, Wayne E.
+#' \emph{Portfolio Performance Measurement and Benchmarking}. McGraw-Hill.
+#' 2009. Chapter 19 \cr Bacon, C. \emph{Practical Portfolio Performance
+#' Measurement and Attribution}. Wiley. 2004. p. 191-193 \cr Carino, D. (1999)
+#' \emph{Combining attribution effects over time}. The Journal of Performance
+#' Measurement. Summer. p. 5-14 \cr
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 2331
More information about the Returnanalytics-commits
mailing list