[Returnanalytics-commits] r1977 - pkg/PerformanceAnalytics/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 4 20:44:38 CEST 2012
Author: ababii
Date: 2012-06-04 20:44:37 +0200 (Mon, 04 Jun 2012)
New Revision: 1977
Added:
pkg/PerformanceAnalytics/R/attribution.levels.R
Modified:
pkg/PerformanceAnalytics/R/Return.level.R
Log:
Some improvements in the Return.level functions.
attribution.levels is a prototype of the multi-level attribution function with working example. Currently it works only with 3 levels and may fail if used on other data than included example.
Modified: pkg/PerformanceAnalytics/R/Return.level.R
===================================================================
--- pkg/PerformanceAnalytics/R/Return.level.R 2012-06-04 13:46:22 UTC (rev 1976)
+++ pkg/PerformanceAnalytics/R/Return.level.R 2012-06-04 18:44:37 UTC (rev 1977)
@@ -12,7 +12,8 @@
#' @param level aggregation level from the hierarchy
#' @author Andrii Babii
#' @seealso \code{\link{buildHierarchy}}
-#' TODO Replace example using portfolio dataset.
+#' TODO Replace example using portfolio dataset. Make rebalancing working
+#' correctly, starting from the next day as in the Return.rebalacing
#' @references
#' @export
#' @examples
@@ -22,16 +23,38 @@
{
Rp = checkData(Rp, method = "xts")
- # Transform weights to the xts object used by aggregation function
+ # 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(R))) < (as.Date(index(weights[1,]))+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
@@ -44,29 +67,15 @@
w[i, ] = wp[j, ]
}
}
+ wp = w
}
- wp = w
-
- # Aggregate returns
- 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)
+ 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])
@@ -107,11 +116,13 @@
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")
Added: pkg/PerformanceAnalytics/R/attribution.levels.R
===================================================================
--- pkg/PerformanceAnalytics/R/attribution.levels.R (rev 0)
+++ pkg/PerformanceAnalytics/R/attribution.levels.R 2012-06-04 18:44:37 UTC (rev 1977)
@@ -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