[Returnanalytics-commits] r1981 - in pkg: PerformanceAnalytics/R PortfolioAnalytics/sandbox/attribution
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jun 5 08:37:12 CEST 2012
Author: ababii
Date: 2012-06-05 08:37:12 +0200 (Tue, 05 Jun 2012)
New Revision: 1981
Added:
pkg/PortfolioAnalytics/sandbox/attribution/Return.level.R
pkg/PortfolioAnalytics/sandbox/attribution/attribution.arithmetic.R
pkg/PortfolioAnalytics/sandbox/attribution/attribution.geometric.R
pkg/PortfolioAnalytics/sandbox/attribution/attribution.levels.R
Removed:
pkg/PerformanceAnalytics/R/Return.level.R
pkg/PerformanceAnalytics/R/attribution.arithmetic.R
pkg/PerformanceAnalytics/R/attribution.geometric.R
pkg/PerformanceAnalytics/R/attribution.levels.R
Log:
Moving attribution functions to the sandbox directory
Deleted: pkg/PerformanceAnalytics/R/Return.level.R
===================================================================
--- pkg/PerformanceAnalytics/R/Return.level.R 2012-06-05 02:04:17 UTC (rev 1980)
+++ pkg/PerformanceAnalytics/R/Return.level.R 2012-06-05 06:37:12 UTC (rev 1981)
@@ -1,140 +0,0 @@
-#' aggregate portfolio to the given level
-#'
-#' @aliases aggregate
-#'
-#' Aggregates the portfoio up to the chosen level using returns, weights and
-#' portfolio hierarchy (from the buildHierarchy function)
-#'
-#' @aliases aggregate
-#' @param Rp xts, data frame or matrix of portfolio returns
-#' @param wp vector, xts, data frame or matrix of portfolio weights.
-#' @param h portfolio hierarchy returned by the buildHierarchy function
-#' @param level aggregation level from the hierarchy
-#' @author Andrii Babii
-#' @seealso \code{\link{buildHierarchy}}
-#' TODO Replace example using portfolio dataset. Make rebalancing working
-#' correctly, starting from the next day as in the Return.rebalacing
-#' @references
-#' @export
-#' @examples
-#'
-Return.level <-
-function(Rp, wp, h, level = "Sector")
-{
- Rp = checkData(Rp, method = "xts")
-
- # Aggregate returns to the chosen level from the hierarchy
- h = split(h$primary_id, h[level])
- returns = as.xts(matrix(NA, ncol = length(h), nrow = nrow(Rp)), index(Rp))
- for(j in 1:length(h)){
- rp = as.xts(matrix(0, ncol = 1, nrow = nrow(Rp)), index(Rp))
- for(i in 1:length(h[[j]])){
- asset = h[[j]][i]
- r = as.data.frame(Rp)[asset] * as.data.frame(wp)[asset]
- r = as.xts(r)
- rp = rp + r
- }
- returns[, j] = rp
- colnames(returns) = names(h)
- }
- return(returns)
-}
-
-
-Weight.transform <-
-function(Rp, wp)
-{
- # Transform weights to the xts object used by aggregation and attribution functions
- if (is.vector(wp)){
- wp = as.xts(matrix(rep(wp, nrow(Rp)), nrow(Rp), ncol(Rp), byrow = TRUE), index(Rp))
- colnames(wp) = colnames(Rp)
- wp = checkData(wp, method = "xts")
- } else{
- wp = checkData(wp, method = "xts")
- if(as.Date(first(index(Rp))) > (as.Date(index(wp[1,]))+1)) {
- warning(paste('data series starts on',as.Date(first(index(Rp))),', which is after the first rebalancing period',as.Date(first(index(wp)))+1))
- }
- if(as.Date(last(index(Rp))) < (as.Date(index(wp[1,]))+1)){
- stop(paste('last date in series',as.Date(last(index(Rp))),'occurs before beginning of first rebalancing period',as.Date(first(index(wp)))+1))
- }
- w = Rp
- for(i in 1:nrow(w)){
- j = 1
- if(index(wp[j + 1, ]) > index(w[i, ])){
- w[i, ] = wp[j, ]
- } else{
- j = j + 1
- w[i, ] = wp[j, ]
- }
- }
- wp = w
- }
- return(wp)
-}
-
-Weight.level <-
-function(wp, h, level = "Sector")
-{
- #aggregate weights to the level chosen from the hierarchy
- wp = checkData(wp, method = "xts")
-
- h = split(h$primary_id, h[level])
- weights = wp[, 1:length(h)]
-
- for(j in 1:length(h)){
- W = as.xts(matrix(0, ncol = 1, nrow = nrow(wp)), index(wp))
- for(i in 1:length(h[[j]])){
- asset = h[[j]][i]
- w = as.data.frame(wp)[asset]
- w = as.xts(w)
- W = W + w
- }
- weights[, j] = W
- colnames(weights) = names(h)
- }
- return(weights)
-}
-
-# Example
-
-# 1. Generate data
-list <- c("XOM", "IBM", "CVX", "WMT", "GE")
-update_instruments.TTR(list, exchange="NYSE")
-hierarchy <- buildHierarchy(ls_stocks(), c("type", "currency", "Sector"))
-getSymbols(list)
-for (i in list){
- r <- Return.calculate(to.yearly(get(i)))[2:6, 4]
- colnames(r) <- i
- if(i == "XOM"){
- Rp <- r
- } else{
- Rp <- cbind(Rp, r)
- }
-}
-
-# 2. Aggregate portfolio
-Rp
-# with vector weights
-wp <- c(0.3, 0.2, 0.2, 0.1, 0.2)
-wp <- Weight.transform(Rp, wp)
-Return.level(Rp, wp, hierarchy, level = "Sector")
-# with xts weights
-wp <- Rp[1:2, ]
-wp[1, ] <- c(0.3, 0.2, 0.2, 0.1, 0.2)
-wp[2, ] <- c(0.3, 0.2, 0.2, 0.1, 0.2)
-wp <- Weight.transform(Rp, wp)
-Return.level(Rp, wp, hierarchy, level = "type")
-aggregate.weights(wp, hierarchy, level = "Sector")
-
-
-###############################################################################
-# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
-#
-# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson
-#
-# This R package is distributed under the terms of the GNU Public License (GPL)
-# for full details see the file COPYING
-#
-# $Id: CalmarRatio.R 1905 2012-04-21 19:23:13Z braverock $
-#
-###############################################################################
\ No newline at end of file
Deleted: pkg/PerformanceAnalytics/R/attribution.arithmetic.R
===================================================================
--- pkg/PerformanceAnalytics/R/attribution.arithmetic.R 2012-06-05 02:04:17 UTC (rev 1980)
+++ pkg/PerformanceAnalytics/R/attribution.arithmetic.R 2012-06-05 06:37:12 UTC (rev 1981)
@@ -1,94 +0,0 @@
-#' performs arithmetic attribution
-#'
-#' @aliases attribution.arithmetic
-#'
-#' Performs arithmetic attribution analysis of returns. Used to uncover the sources
-#' of portfolio return
-#'
-#' @aliases attribution.arithmetic
-#' @param Rp portfolio returns
-#' @param wp portfolio weights
-#' @param Rb benchmark returns
-#' @param wb benchmark weights
-#' @author Andrii Babii
-#' @seealso
-#' @references Jon A. Christopherson, David R., Wayne E. Ferson
-#' \emph{Portfolio Performance Measurement and Benchmarking}. McGraw-Hill. 2009.
-#' @examples
-#'
-#'
-#'
-attribution.arithmetic <-
-function (Rp, wp, Rb, wb, method = c("top.down", "bottom.up", "simple"))
-{ # @author Andrii Babii
-
- # DESCRIPTION:
- # This is a wrapper for attribution analysis.
- # TODO: extend to multiple periods, time-varying weights, multiple levels
-
- # Inputs:
- # Rp: portfolio returns
- # wp: portfolio weights
- # Rb: benchmark returns
- # wb: benchmark weights
-
- # Outputs:
- # This function returns the
- # FUNCTION:
-
- Rb = checkData(Rb)
- Rp = checkData(Rp)
- wp = as.xts(matrix(rep(wp, nrow(Rp)), nrow(Rp), ncol(Rp), byrow = TRUE), index(Rp))
- wb = as.xts(matrix(rep(wb, nrow(Rb)), nrow(Rb), ncol(Rb), byrow = TRUE), index(Rb))
- colnames(wp) = colnames(Rp)
- colnames(wb) = colnames(Rb)
-
- allocation = (wp - wb) * (Rb - drop(Rb %*% t(wb)))
- selection = wb * (Rp - Rb)
- interaction = (wp - wb) * (Rp - Rb)
- total = allocation + selection + interaction
-
- if(method == "top.down")
- result = data.frame(t(allocation), t(selection) + t(interaction),
- t(total)) # Top-down attribution
- else
- if(method == "bottom.up")
- result = data.frame(t(allocation) + t(interaction), t(selection),
- t(total)) # Bottom-up attribution
- else
- if(method == "simple")
- result = data.frame(t(allocation), t(selection), t(total))
- else
- stop(paste("Please select the correct method for the attribution output"))
- colnames(result) = c("Allocation", "Selection", "Total")
- sum = (t(as.matrix(colSums(result))))
- rownames(sum) = "Total"
- result = rbind(result, sum)
- return(result)
-}
-#EXAMPLE:
-Rp <- matrix(c(0.0397, 0.0493, 0.0891, 0.0289), 1, 4)
-colnames(Rp) <- c("Oil", "It", "Retail", "Energy")
-rownames(Rp) <- "2011-01-06"
-Rb <- Rp + 0.01
-wp <- c(0.1, 0.4, 0.3, 0.2)
-wb <- c(0.2, 0.1, 0.4, 0.3)
-attribution.arithmetic(Rp, wp, Rb, wb, method = "top.down")
-attribution.arithmetic(Rp, wp, Rb, wb, method = "bottom.up")
-attribution.arithmetic(Rp, wp, Rb, wb, method = "simple")
-attribution.arithmetic(Rp, wp, Rb, wb, method = "simpel")
-
-#' @export
-#' @rdname attribution.arithmetic
-
-###############################################################################
-# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
-#
-# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson
-#
-# This R package is distributed under the terms of the GNU Public License (GPL)
-# for full details see the file COPYING
-#
-# $Id: CalmarRatio.R 1905 2012-04-21 19:23:13Z braverock $
-#
-###############################################################################
Deleted: pkg/PerformanceAnalytics/R/attribution.geometric.R
===================================================================
--- pkg/PerformanceAnalytics/R/attribution.geometric.R 2012-06-05 02:04:17 UTC (rev 1980)
+++ pkg/PerformanceAnalytics/R/attribution.geometric.R 2012-06-05 06:37:12 UTC (rev 1981)
@@ -1,99 +0,0 @@
-#' performs geometric attribution
-#'
-#' @aliases attribution.geometric
-#'
-#' Performs geometric attribution analysis of returns. Used to uncover the sources
-#' of portfolio return
-#'
-#' @aliases attribution.geometric
-#' @param Rp portfolio returns
-#' @param wp portfolio weights
-#' @param Rb benchmark returns
-#' @param wb benchmark weights
-#' @author Andrii Babii
-#' @seealso
-#' @references Jon A. Christopherson, David R., Wayne E. Ferson
-#' \emph{Portfolio Performance Measurement and Benchmarking}. McGraw-Hill. 2009.
-#' @examples
-#'
-#'
-#'
-attribution.geometric <-
-function (Rp, wp, Rb, wb, method = c("top.down", "bottom.up", "simple"))
-{ # @author Andrii Babii
-
- # DESCRIPTION:
- # This is a wrapper for attribution analysis.
- # TODO: extend to multiple periods, time-varying weights, multiple levels
-
- # Inputs:
- # Rp: portfolio returns
- # wp: portfolio weights
- # Rb: benchmark returns
- # wb: benchmark weights
-
- # Outputs:
- # This function returns the
- # FUNCTION:
-
- Rb = checkData(Rb)
- Rp = checkData(Rp)
- wp = as.xts(matrix(rep(wp, ncol(Rp)), nrow(Rp), ncol(Rp)), index(Rp))
- wb = as.xts(matrix(rep(wb, ncol(Rb)), nrow(Rb), ncol(Rb)), index(Rb))
- colnames(wp) = colnames(Rp)
- colnames(wb) = colnames(Rb)
-
- allocation = (wp - wb) * (Rb - drop(Rb %*% t(wb)))
- selection = wb * (Rp - Rb)
- interaction = (wp - wb) * (Rp - Rb)
- total = allocation + selection + interaction
-
- k = (log(1 + Rp) - log(1 + Rb)) / (Rp - Rb)
- allocation = exp(allocation * k) - 1
- selection = exp(selection * k) - 1
- interaction = exp(interaction * k) - 1
- total = allocation + selection + interaction
-
- if(method == "top.down")
- result = data.frame(t(allocation), t(selection) + t(interaction),
- t(total)) # Top-down attribution
- else
- if(method == "bottom.up")
- result = data.frame(t(allocation) + t(interaction), t(selection),
- t(total)) # Bottom-up attribution
- else
- if(method == "simple")
- result = data.frame(t(allocation), t(selection), t(total))
- else
- stop(paste("Please select the correct method for the attribution output"))
- colnames(result) = c("Allocation", "Selection", "Total")
- sum = (t(as.matrix(colSums(result))))
- rownames(sum) = "Total"
- result = rbind(result, sum)
- return(result)
-}
-#EXAMPLE:
-Rp <- matrix(c(0.0397, 0.0493, 0.0891, 0.0289), 1, 4)
-colnames(Rp) <- c("Oil", "It", "Retail", "Energy")
-rownames(Rp) <- "2011-01-06"
-Rb <- Rp + 0.01
-wp <- c(0.1, 0.4, 0.3, 0.2)
-wb <- c(0.2, 0.1, 0.4, 0.3)
-attribution.geometric(Rp, wp, Rb, wb, method = "top.down")
-attribution.geometric(Rp, wp, Rb, wb, method = "bottom.up")
-attribution.geometric(Rp, wp, Rb, wb, method = "simple")
-attribution.geometric(Rp, wp, Rb, wb, method = "simpel")
-#' @export
-#' @rdname attribution.geometric
-
-###############################################################################
-# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
-#
-# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson
-#
-# This R package is distributed under the terms of the GNU Public License (GPL)
-# for full details see the file COPYING
-#
-# $Id: CalmarRatio.R 1905 2012-04-21 19:23:13Z braverock $
-#
-###############################################################################
\ No newline at end of file
Deleted: pkg/PerformanceAnalytics/R/attribution.levels.R
===================================================================
--- pkg/PerformanceAnalytics/R/attribution.levels.R 2012-06-05 02:04:17 UTC (rev 1980)
+++ pkg/PerformanceAnalytics/R/attribution.levels.R 2012-06-05 06:37:12 UTC (rev 1981)
@@ -1,104 +0,0 @@
-# 5-steps attribution (3-levels)
-attribution.levels <-
-function(Rp, Rb, wp, wb, h, ...)
-{ # @author Andrii Babii
-
- Rb = checkData(Rb)
- Rp = checkData(Rp)
-
- levels <- unlist(list(...))
- if (!is.null(levels)) stopifnot(is.character(levels))
-
- # Get lists with returns and weights at all levels for the portfolio and the benchmark
- returns.p = list()
- weights.p = list()
- for(i in 1:length(levels)){
- returns.p[[i]] = Return.level(Rp, wp, h, level = levels[i])
- weights.p[[i]] = Weight.level(wp, h, level = levels[i])
- }
- names(returns.p) = levels
- names(weights.p) = levels
-
- returns.b = list()
- weights.b = list()
- for(i in 1:length(levels)){
- returns.b[[i]] = Return.level(Rb, wb, h, level = levels[i])
- weights.b[[i]] = Weight.level(wb, h, level = levels[i])
- }
- names(returns.b) = levels
- names(weights.b) = levels
-
- # Get lists with semi-notional funds returns
- # (computed using portfolio weights and benchmark returns)
- bs = list()
- for(i in 1:length(levels)){
- bs[[i]] = Return.rebalancing(weights.p[[i]], returns.b[[i]])
- }
-
- # Get portfolio and benchmark returns
- r = Return.rebalancing(Rp, wp)
- b = Return.rebalancing(Rb, wb)
-
- allocation.1 = (1 + bs[[1]]) / (1 + b) - 1
- allocation.2 = (1 + bs[[2]]) / (1 + bs[[1]]) - 1
- allocation.3 = (1 + bs[[3]]) / (1 + bs[[2]]) - 1
- selection = (1 + r) / (1 + bs[[3]]) - 1
- total = (1 + r) / (1 + b) - 1 #Total excess return
- # Level 1 attribution
- l1 = (weights.p[[1]] - weights.b[[1]]) * ((1 + returns.b[[1]]) / (1 + b) - 1)
- # Level 2 attribution
- l2 = (weights.p[[2]] - weights.b[[2]]) * ((1 + returns.b[[2]]) / (1 + returns.b[[1]]) - 1) * ((1 + returns.b[[1]]) / (1 + bs[[1]]))
- # Level 3 attribution
- w = (weights.p[[3]] - weights.b[[3]])
- a1 = 1 + returns.b[[2]]
- b1 = ((1 + returns.b[[3]]) / (cbind(a1, a1, a1)) - 1)
- b2 = ((1 + returns.b[[2]]) / (1 + bs[[2]]))
- b2 = cbind(b2, b2, b2)
- l3 = w * b1 * b2
- # Security/Asset selection
- w = weights.p[[3]]
- a1 = cbind((1 + r), (1 + r), (1 + r))
- b1 = a1 / (1 + returns.b[[3]]) - 1
- a2 = cbind((1 + bs[[3]]), (1 + bs[[3]]), (1 + bs[[3]]))
- b2 = (1 + returns.b[[3]]) / a2
- select = w * b1 * b2
-
- result = list()
- general = cbind(allocation.1, allocation.2, allocation.3, selection, total)
- colnames(general) = c("L1 allocation", "L2 allocation", "L3 allocation",
- "Selection", "Total")
- result[[1]] = general
- result[[2]] = l1
- result[[3]] = l2
- result[[4]] = l3
- result[[5]] = select
- names(result) = c("Multi-level attribution", "Level 1 attribution", "Level 2 attribution", "Level 3 attribution", "Security selection")
- return(result)
-
-}
-
-# Example:
-require(FinancialInstrument)
-require(PerformanceAnalytics)
-list <- c("XOM", "IBM", "CVX", "WMT", "GE")
-update_instruments.TTR(list, exchange="NYSE")
-h <- buildHierarchy(ls_stocks(), c("type", "currency", "Sector"))
-getSymbols(list)
-for (i in list){
- r <- Return.calculate(to.yearly(get(i)))[2:6, 4]
- colnames(r) <- i
- if(i == "XOM"){
- Rp <- r
- } else{
- Rp <- cbind(Rp, r)
- }
-}
-Rb <- Rp
-wp <- c(0.3, 0.2, 0.2, 0.1, 0.2)
-wb <- c(0.1, 0.3, 0.2, 0.2, 0.2)
-wp = Weight.transform(Rp, wp) # transform weights to the xts object
-wb = Weight.transform(Rb, wb) # of the same size as returns using a function from Return.level
-
-attribution.levels(Rp, wp, Rb, wb, h, c("type", "currency", "Sector"))
-
-
Added: pkg/PortfolioAnalytics/sandbox/attribution/Return.level.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/Return.level.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/Return.level.R 2012-06-05 06:37:12 UTC (rev 1981)
@@ -0,0 +1,140 @@
+#' aggregate portfolio to the given level
+#'
+#' @aliases aggregate
+#'
+#' Aggregates the portfoio up to the chosen level using returns, weights and
+#' portfolio hierarchy (from the buildHierarchy function)
+#'
+#' @aliases aggregate
+#' @param Rp xts, data frame or matrix of portfolio returns
+#' @param wp vector, xts, data frame or matrix of portfolio weights.
+#' @param h portfolio hierarchy returned by the buildHierarchy function
+#' @param level aggregation level from the hierarchy
+#' @author Andrii Babii
+#' @seealso \code{\link{buildHierarchy}}
+#' TODO Replace example using portfolio dataset. Make rebalancing working
+#' correctly, starting from the next day as in the Return.rebalacing
+#' @references
+#' @export
+#' @examples
+#'
+Return.level <-
+function(Rp, wp, h, level = "Sector")
+{
+ Rp = checkData(Rp, method = "xts")
+
+ # Aggregate returns to the chosen level from the hierarchy
+ h = split(h$primary_id, h[level])
+ returns = as.xts(matrix(NA, ncol = length(h), nrow = nrow(Rp)), index(Rp))
+ for(j in 1:length(h)){
+ rp = as.xts(matrix(0, ncol = 1, nrow = nrow(Rp)), index(Rp))
+ for(i in 1:length(h[[j]])){
+ asset = h[[j]][i]
+ r = as.data.frame(Rp)[asset] * as.data.frame(wp)[asset]
+ r = as.xts(r)
+ rp = rp + r
+ }
+ returns[, j] = rp
+ colnames(returns) = names(h)
+ }
+ return(returns)
+}
+
+
+Weight.transform <-
+function(Rp, wp)
+{
+ # Transform weights to the xts object used by aggregation and attribution functions
+ if (is.vector(wp)){
+ wp = as.xts(matrix(rep(wp, nrow(Rp)), nrow(Rp), ncol(Rp), byrow = TRUE), index(Rp))
+ colnames(wp) = colnames(Rp)
+ wp = checkData(wp, method = "xts")
+ } else{
+ wp = checkData(wp, method = "xts")
+ if(as.Date(first(index(Rp))) > (as.Date(index(wp[1,]))+1)) {
+ warning(paste('data series starts on',as.Date(first(index(Rp))),', which is after the first rebalancing period',as.Date(first(index(wp)))+1))
+ }
+ if(as.Date(last(index(Rp))) < (as.Date(index(wp[1,]))+1)){
+ stop(paste('last date in series',as.Date(last(index(Rp))),'occurs before beginning of first rebalancing period',as.Date(first(index(wp)))+1))
+ }
+ w = Rp
+ for(i in 1:nrow(w)){
+ j = 1
+ if(index(wp[j + 1, ]) > index(w[i, ])){
+ w[i, ] = wp[j, ]
+ } else{
+ j = j + 1
+ w[i, ] = wp[j, ]
+ }
+ }
+ wp = w
+ }
+ return(wp)
+}
+
+Weight.level <-
+function(wp, h, level = "Sector")
+{
+ #aggregate weights to the level chosen from the hierarchy
+ wp = checkData(wp, method = "xts")
+
+ h = split(h$primary_id, h[level])
+ weights = wp[, 1:length(h)]
+
+ for(j in 1:length(h)){
+ W = as.xts(matrix(0, ncol = 1, nrow = nrow(wp)), index(wp))
+ for(i in 1:length(h[[j]])){
+ asset = h[[j]][i]
+ w = as.data.frame(wp)[asset]
+ w = as.xts(w)
+ W = W + w
+ }
+ weights[, j] = W
+ colnames(weights) = names(h)
+ }
+ return(weights)
+}
+
+# Example
+
+# 1. Generate data
+list <- c("XOM", "IBM", "CVX", "WMT", "GE")
+update_instruments.TTR(list, exchange="NYSE")
+hierarchy <- buildHierarchy(ls_stocks(), c("type", "currency", "Sector"))
+getSymbols(list)
+for (i in list){
+ r <- Return.calculate(to.yearly(get(i)))[2:6, 4]
+ colnames(r) <- i
+ if(i == "XOM"){
+ Rp <- r
+ } else{
+ Rp <- cbind(Rp, r)
+ }
+}
+
+# 2. Aggregate portfolio
+Rp
+# with vector weights
+wp <- c(0.3, 0.2, 0.2, 0.1, 0.2)
+wp <- Weight.transform(Rp, wp)
+Return.level(Rp, wp, hierarchy, level = "Sector")
+# with xts weights
+wp <- Rp[1:2, ]
+wp[1, ] <- c(0.3, 0.2, 0.2, 0.1, 0.2)
+wp[2, ] <- c(0.3, 0.2, 0.2, 0.1, 0.2)
+wp <- Weight.transform(Rp, wp)
+Return.level(Rp, wp, hierarchy, level = "type")
+aggregate.weights(wp, hierarchy, level = "Sector")
+
+
+###############################################################################
+# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
+#
+# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: CalmarRatio.R 1905 2012-04-21 19:23:13Z braverock $
+#
+###############################################################################
\ No newline at end of file
Added: pkg/PortfolioAnalytics/sandbox/attribution/attribution.arithmetic.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/attribution.arithmetic.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/attribution.arithmetic.R 2012-06-05 06:37:12 UTC (rev 1981)
@@ -0,0 +1,94 @@
+#' performs arithmetic attribution
+#'
+#' @aliases attribution.arithmetic
+#'
+#' Performs arithmetic attribution analysis of returns. Used to uncover the sources
+#' of portfolio return
+#'
+#' @aliases attribution.arithmetic
+#' @param Rp portfolio returns
+#' @param wp portfolio weights
+#' @param Rb benchmark returns
+#' @param wb benchmark weights
+#' @author Andrii Babii
+#' @seealso
+#' @references Jon A. Christopherson, David R., Wayne E. Ferson
+#' \emph{Portfolio Performance Measurement and Benchmarking}. McGraw-Hill. 2009.
+#' @examples
+#'
+#'
+#'
+attribution.arithmetic <-
+function (Rp, wp, Rb, wb, method = c("top.down", "bottom.up", "simple"))
+{ # @author Andrii Babii
+
+ # DESCRIPTION:
+ # This is a wrapper for attribution analysis.
+ # TODO: extend to multiple periods, time-varying weights, multiple levels
+
+ # Inputs:
+ # Rp: portfolio returns
+ # wp: portfolio weights
+ # Rb: benchmark returns
+ # wb: benchmark weights
+
+ # Outputs:
+ # This function returns the
+ # FUNCTION:
+
+ Rb = checkData(Rb)
+ Rp = checkData(Rp)
+ wp = as.xts(matrix(rep(wp, nrow(Rp)), nrow(Rp), ncol(Rp), byrow = TRUE), index(Rp))
+ wb = as.xts(matrix(rep(wb, nrow(Rb)), nrow(Rb), ncol(Rb), byrow = TRUE), index(Rb))
+ colnames(wp) = colnames(Rp)
+ colnames(wb) = colnames(Rb)
+
+ allocation = (wp - wb) * (Rb - drop(Rb %*% t(wb)))
+ selection = wb * (Rp - Rb)
+ interaction = (wp - wb) * (Rp - Rb)
+ total = allocation + selection + interaction
+
+ if(method == "top.down")
+ result = data.frame(t(allocation), t(selection) + t(interaction),
+ t(total)) # Top-down attribution
+ else
+ if(method == "bottom.up")
+ result = data.frame(t(allocation) + t(interaction), t(selection),
+ t(total)) # Bottom-up attribution
+ else
+ if(method == "simple")
+ result = data.frame(t(allocation), t(selection), t(total))
+ else
+ stop(paste("Please select the correct method for the attribution output"))
+ colnames(result) = c("Allocation", "Selection", "Total")
+ sum = (t(as.matrix(colSums(result))))
+ rownames(sum) = "Total"
+ result = rbind(result, sum)
+ return(result)
+}
+#EXAMPLE:
+Rp <- matrix(c(0.0397, 0.0493, 0.0891, 0.0289), 1, 4)
+colnames(Rp) <- c("Oil", "It", "Retail", "Energy")
+rownames(Rp) <- "2011-01-06"
+Rb <- Rp + 0.01
+wp <- c(0.1, 0.4, 0.3, 0.2)
+wb <- c(0.2, 0.1, 0.4, 0.3)
+attribution.arithmetic(Rp, wp, Rb, wb, method = "top.down")
+attribution.arithmetic(Rp, wp, Rb, wb, method = "bottom.up")
+attribution.arithmetic(Rp, wp, Rb, wb, method = "simple")
+attribution.arithmetic(Rp, wp, Rb, wb, method = "simpel")
+
+#' @export
+#' @rdname attribution.arithmetic
+
+###############################################################################
+# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
+#
+# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: CalmarRatio.R 1905 2012-04-21 19:23:13Z braverock $
+#
+###############################################################################
Added: pkg/PortfolioAnalytics/sandbox/attribution/attribution.geometric.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/attribution.geometric.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/attribution.geometric.R 2012-06-05 06:37:12 UTC (rev 1981)
@@ -0,0 +1,99 @@
+#' performs geometric attribution
+#'
+#' @aliases attribution.geometric
+#'
+#' Performs geometric attribution analysis of returns. Used to uncover the sources
+#' of portfolio return
+#'
+#' @aliases attribution.geometric
+#' @param Rp portfolio returns
+#' @param wp portfolio weights
+#' @param Rb benchmark returns
+#' @param wb benchmark weights
+#' @author Andrii Babii
+#' @seealso
+#' @references Jon A. Christopherson, David R., Wayne E. Ferson
+#' \emph{Portfolio Performance Measurement and Benchmarking}. McGraw-Hill. 2009.
+#' @examples
+#'
+#'
+#'
+attribution.geometric <-
+function (Rp, wp, Rb, wb, method = c("top.down", "bottom.up", "simple"))
+{ # @author Andrii Babii
+
+ # DESCRIPTION:
+ # This is a wrapper for attribution analysis.
+ # TODO: extend to multiple periods, time-varying weights, multiple levels
+
+ # Inputs:
+ # Rp: portfolio returns
+ # wp: portfolio weights
+ # Rb: benchmark returns
+ # wb: benchmark weights
+
+ # Outputs:
+ # This function returns the
+ # FUNCTION:
+
+ Rb = checkData(Rb)
+ Rp = checkData(Rp)
+ wp = as.xts(matrix(rep(wp, ncol(Rp)), nrow(Rp), ncol(Rp)), index(Rp))
+ wb = as.xts(matrix(rep(wb, ncol(Rb)), nrow(Rb), ncol(Rb)), index(Rb))
+ colnames(wp) = colnames(Rp)
+ colnames(wb) = colnames(Rb)
+
+ allocation = (wp - wb) * (Rb - drop(Rb %*% t(wb)))
+ selection = wb * (Rp - Rb)
+ interaction = (wp - wb) * (Rp - Rb)
+ total = allocation + selection + interaction
+
+ k = (log(1 + Rp) - log(1 + Rb)) / (Rp - Rb)
+ allocation = exp(allocation * k) - 1
+ selection = exp(selection * k) - 1
+ interaction = exp(interaction * k) - 1
+ total = allocation + selection + interaction
+
+ if(method == "top.down")
+ result = data.frame(t(allocation), t(selection) + t(interaction),
+ t(total)) # Top-down attribution
+ else
+ if(method == "bottom.up")
+ result = data.frame(t(allocation) + t(interaction), t(selection),
+ t(total)) # Bottom-up attribution
+ else
+ if(method == "simple")
+ result = data.frame(t(allocation), t(selection), t(total))
+ else
+ stop(paste("Please select the correct method for the attribution output"))
+ colnames(result) = c("Allocation", "Selection", "Total")
+ sum = (t(as.matrix(colSums(result))))
+ rownames(sum) = "Total"
+ result = rbind(result, sum)
+ return(result)
+}
+#EXAMPLE:
+Rp <- matrix(c(0.0397, 0.0493, 0.0891, 0.0289), 1, 4)
+colnames(Rp) <- c("Oil", "It", "Retail", "Energy")
+rownames(Rp) <- "2011-01-06"
+Rb <- Rp + 0.01
+wp <- c(0.1, 0.4, 0.3, 0.2)
+wb <- c(0.2, 0.1, 0.4, 0.3)
+attribution.geometric(Rp, wp, Rb, wb, method = "top.down")
+attribution.geometric(Rp, wp, Rb, wb, method = "bottom.up")
+attribution.geometric(Rp, wp, Rb, wb, method = "simple")
+attribution.geometric(Rp, wp, Rb, wb, method = "simpel")
+#' @export
+#' @rdname attribution.geometric
+
+###############################################################################
+# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
+#
+# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: CalmarRatio.R 1905 2012-04-21 19:23:13Z braverock $
+#
+###############################################################################
\ No newline at end of file
Added: pkg/PortfolioAnalytics/sandbox/attribution/attribution.levels.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/attribution.levels.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/attribution.levels.R 2012-06-05 06:37:12 UTC (rev 1981)
@@ -0,0 +1,104 @@
+# 5-steps attribution (3-levels)
+attribution.levels <-
+function(Rp, Rb, wp, wb, h, ...)
+{ # @author Andrii Babii
+
+ Rb = checkData(Rb)
+ Rp = checkData(Rp)
+
+ levels <- unlist(list(...))
+ if (!is.null(levels)) stopifnot(is.character(levels))
+
+ # Get lists with returns and weights at all levels for the portfolio and the benchmark
+ returns.p = list()
+ weights.p = list()
+ for(i in 1:length(levels)){
+ returns.p[[i]] = Return.level(Rp, wp, h, level = levels[i])
+ weights.p[[i]] = Weight.level(wp, h, level = levels[i])
+ }
+ names(returns.p) = levels
+ names(weights.p) = levels
+
+ returns.b = list()
+ weights.b = list()
+ for(i in 1:length(levels)){
+ returns.b[[i]] = Return.level(Rb, wb, h, level = levels[i])
+ weights.b[[i]] = Weight.level(wb, h, level = levels[i])
+ }
+ names(returns.b) = levels
+ names(weights.b) = levels
+
+ # Get lists with semi-notional funds returns
+ # (computed using portfolio weights and benchmark returns)
+ bs = list()
+ for(i in 1:length(levels)){
+ bs[[i]] = Return.rebalancing(weights.p[[i]], returns.b[[i]])
+ }
+
+ # Get portfolio and benchmark returns
+ r = Return.rebalancing(Rp, wp)
+ b = Return.rebalancing(Rb, wb)
+
+ allocation.1 = (1 + bs[[1]]) / (1 + b) - 1
+ allocation.2 = (1 + bs[[2]]) / (1 + bs[[1]]) - 1
+ allocation.3 = (1 + bs[[3]]) / (1 + bs[[2]]) - 1
+ selection = (1 + r) / (1 + bs[[3]]) - 1
+ total = (1 + r) / (1 + b) - 1 #Total excess return
+ # Level 1 attribution
+ l1 = (weights.p[[1]] - weights.b[[1]]) * ((1 + returns.b[[1]]) / (1 + b) - 1)
+ # Level 2 attribution
+ l2 = (weights.p[[2]] - weights.b[[2]]) * ((1 + returns.b[[2]]) / (1 + returns.b[[1]]) - 1) * ((1 + returns.b[[1]]) / (1 + bs[[1]]))
+ # Level 3 attribution
+ w = (weights.p[[3]] - weights.b[[3]])
+ a1 = 1 + returns.b[[2]]
+ b1 = ((1 + returns.b[[3]]) / (cbind(a1, a1, a1)) - 1)
+ b2 = ((1 + returns.b[[2]]) / (1 + bs[[2]]))
+ b2 = cbind(b2, b2, b2)
+ l3 = w * b1 * b2
+ # Security/Asset selection
+ w = weights.p[[3]]
+ a1 = cbind((1 + r), (1 + r), (1 + r))
+ b1 = a1 / (1 + returns.b[[3]]) - 1
+ a2 = cbind((1 + bs[[3]]), (1 + bs[[3]]), (1 + bs[[3]]))
+ b2 = (1 + returns.b[[3]]) / a2
+ select = w * b1 * b2
+
+ result = list()
+ general = cbind(allocation.1, allocation.2, allocation.3, selection, total)
+ colnames(general) = c("L1 allocation", "L2 allocation", "L3 allocation",
+ "Selection", "Total")
+ result[[1]] = general
+ result[[2]] = l1
+ result[[3]] = l2
+ result[[4]] = l3
+ result[[5]] = select
+ names(result) = c("Multi-level attribution", "Level 1 attribution", "Level 2 attribution", "Level 3 attribution", "Security selection")
+ return(result)
+
+}
+
+# Example:
+require(FinancialInstrument)
+require(PerformanceAnalytics)
+list <- c("XOM", "IBM", "CVX", "WMT", "GE")
+update_instruments.TTR(list, exchange="NYSE")
+h <- buildHierarchy(ls_stocks(), c("type", "currency", "Sector"))
+getSymbols(list)
+for (i in list){
+ r <- Return.calculate(to.yearly(get(i)))[2:6, 4]
+ colnames(r) <- i
+ if(i == "XOM"){
+ Rp <- r
+ } else{
+ Rp <- cbind(Rp, r)
+ }
+}
+Rb <- Rp
+wp <- c(0.3, 0.2, 0.2, 0.1, 0.2)
+wb <- c(0.1, 0.3, 0.2, 0.2, 0.2)
+wp = Weight.transform(Rp, wp) # transform weights to the xts object
+wb = Weight.transform(Rb, wb) # of the same size as returns using a function from Return.level
+
+attribution.levels(Rp, wp, Rb, wb, h, c("type", "currency", "Sector"))
+
+
More information about the Returnanalytics-commits
mailing list