[Returnanalytics-commits] r2011 - pkg/PortfolioAnalytics/sandbox/attribution
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 13 20:42:29 CEST 2012
Author: ababii
Date: 2012-06-13 20:42:29 +0200 (Wed, 13 Jun 2012)
New Revision: 2011
Added:
pkg/PortfolioAnalytics/sandbox/attribution/Attribution.geometric.R
pkg/PortfolioAnalytics/sandbox/attribution/Carino.R
pkg/PortfolioAnalytics/sandbox/attribution/Frongello.R
pkg/PortfolioAnalytics/sandbox/attribution/Grap.R
pkg/PortfolioAnalytics/sandbox/attribution/Menchero.R
Modified:
pkg/PortfolioAnalytics/sandbox/attribution/attribution.R
Log:
- separated linking functions from the attribution (without documentation at the moment)
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-13 18:42:29 UTC (rev 2011)
@@ -0,0 +1,30 @@
+# Geometric attribution
+Attribution.geometric <-
+function(Rp, wp, Rb, wb)
+{
+ rp = reclass(rowSums(Rp * wp), Rp)
+ rb = reclass(rowSums(Rb * wb), Rb)
+ names(rp) = "Total"
+ names(rb) = "Total"
+ rp.a = prod(1 + rp) - 1
+ rb.a = prod(1 + rb) - 1
+ Rp = cbind(Rp, rp)
+ Rb = cbind(Rb, rb)
+
+ bs = reclass(rowSums((wp * Rb[, 1:ncol(wp)])), rp) # Seminotional funds returns
+ allocation = ((1 + Rb) / (1 + rb.a) - 1) * cbind((wp - wb), rep(1, nrow(wp)))
+ selection = allocation
+ for (i in 1:ncol(wp)){
+ selection[, i] = ((Rp - Rb) * cbind(wp, rep(1, nrow(wp))))[, i] / (1 + bs)
+ }
+ allocation = rbind(as.data.frame(allocation), (apply(1 + allocation, 2, prod) - 1))
+ selection = rbind(as.data.frame(selection), (apply(1 + selection, 2, prod) - 1))
+ rownames(allocation)[nrow(allocation)] = "Total"
+ rownames(selection)[nrow(selection)] = "Total"
+ result = list()
+ result[[1]] = allocation
+ result[[2]] = selection
+ result[[3]] = allocation + selection
+ names(result) = c("Allocation", "Selection", "Total")
+ return(result)
+}
\ No newline at end of file
Added: pkg/PortfolioAnalytics/sandbox/attribution/Carino.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/Carino.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/Carino.R 2012-06-13 18:42:29 UTC (rev 2011)
@@ -0,0 +1,21 @@
+# Carino linking
+Carino <-
+function(rp, rb, attributions)
+{ # @author Andrii Babii
+ rp.a = prod(1 + rp) - 1
+ rb.a = prod(1 + rb) - 1
+ k = (log(1 + rp.a) - log(1 + rb.a)) / (rp.a - rb.a)
+ kt = rp
+ for (t in 1:nrow(kt)){
+ if (rp[t] == rb[t]){
+ kt[t] = 1 / (1 + rp[t]) # Carino factors if portfolio and benchmark returns are equal
+ } else{
+ kt[t] = (log(1 + rp[t]) - log(1 + rb[t])) / (rp[t] - rb[t]) # if different
+ }
+ }
+ kt = matrix(rep(kt, ncol(attributions)), nrow(attributions), ncol(attributions), byrow = FALSE)
+ total = colSums(attributions * kt / k)
+ attributions = rbind(as.data.frame(attributions), total)
+ rownames(attributions)[nrow(attributions)] = "Total"
+ return(attributions)
+}
\ No newline at end of file
Added: pkg/PortfolioAnalytics/sandbox/attribution/Frongello.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/Frongello.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/Frongello.R 2012-06-13 18:42:29 UTC (rev 2011)
@@ -0,0 +1,19 @@
+# Frongello linking
+Frongello <-
+function(Rp, wp, Rb, wb, attributions)
+{ # @author Andrii Babii
+ rp = reclass(rowSums(Rp * wp), Rp)
+ rb = reclass(rowSums(Rb * wb), Rb)
+ Rp = cbind(Rp, rp)
+ Rb = cbind(Rb, rb)
+ attr = attributions
+ attr[1, ] = attributions[1, ] + Rb[1, ]
+
+ for(i in 2:nrow(rp)){
+ attr[i, ] = attr[i, ] * apply((1 + Rp[1:(i-1), ]), 2, prod) + Rb[i, ] * apply(attr[1:(i-1)], 2, sum)
+ }
+ total = colSums(attr)
+ attributions = rbind(as.data.frame(attributions), total)
+ rownames(attributions)[nrow(attributions)] = "Total"
+ return(attributions)
+}
Added: pkg/PortfolioAnalytics/sandbox/attribution/Grap.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/Grap.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/Grap.R 2012-06-13 18:42:29 UTC (rev 2011)
@@ -0,0 +1,26 @@
+# GRAP linking
+Grap <-
+function(rp, rb, attributions)
+{ # @author Andrii Babii
+ G = rp
+ T = nrow(rp)
+ G[1] = prod(1 + rb[2:T]) #GRAP factor for the first period
+ if (T == 2){
+ G[2] = (1 + rp[1])
+ }
+ if (T > 2){
+ G[T] = prod(1 + rp[1:(T - 1)]) #GRAP factor for the last period
+ }
+ if (T > 3){
+ for(i in 2:(T - 1)){
+ r = 1 + rp[1:(i-1)]
+ b = 1 + rb[(i+1):T]
+ G[i] = apply(r, 2, prod) * apply(b, 2, prod)
+ }
+ }
+ g = matrix(rep(G, ncol(attributions)), nrow(attributions), ncol(attributions), byrow = FALSE)
+ total = colSums(attributions * g)
+ attributions = rbind(as.data.frame(attributions), total)
+ rownames(attributions)[nrow(attributions)] = "Total"
+ return(attributions)
+}
\ No newline at end of file
Added: pkg/PortfolioAnalytics/sandbox/attribution/Menchero.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/Menchero.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/Menchero.R 2012-06-13 18:42:29 UTC (rev 2011)
@@ -0,0 +1,20 @@
+# Menchero linking
+Menchero <-
+function(rp, rb, attributions)
+{ # @author Andrii Babii
+ rp.a = prod(1 + rp) - 1
+ rb.a = prod(1 + rb) - 1
+ T = nrow(rp)
+ if (rp.a == rb.a){
+ M = (1 + rb.a)^((T - 1) / T)
+ at = 0
+ } else{
+ M = ((rp.a - rb.a) / T) / ((1 + rp.a)^(1 / T) - (1 + rb.a)^(1 / T))
+ at = (rp.a - rb.a - M * sum(rp - rb)) * (rp - rb) / sum((rp - rb)^2)
+ }
+ m = matrix(rep(M + at, ncol(attributions)), nrow(attributions), ncol(attributions), byrow = FALSE)
+ total = colSums(attributions * m)
+ attributions = rbind(as.data.frame(attributions), total)
+ rownames(attributions)[nrow(attributions)] = "Total"
+ return(attributions)
+}
\ No newline at end of file
Modified: pkg/PortfolioAnalytics/sandbox/attribution/attribution.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/attribution.R 2012-06-13 13:17:35 UTC (rev 2010)
+++ pkg/PortfolioAnalytics/sandbox/attribution/attribution.R 2012-06-13 18:42:29 UTC (rev 2011)
@@ -6,17 +6,18 @@
#' can dissect the value-added into useful components. This function is based
#' on the sector-based approach to the attribution. The workhorse is the
#' Brinson model that explains the arithmetic difference between portfolio and
-#' benchmark returns. That is it breaks down the arithmetic excess returns.
-#' It also alows to break down the geometric excess returns. The attribution
-#' effects can be computed for several periods. Different linking methods
-#' allow to get the multi-period summary. Finally, it annualizes arithmetic
-#' and geometric excess returns similarly to the portfolio and/or benchmark
-#' returns annualization.
+#' benchmark returns. That is it breaks down the arithmetic excess returns at
+#' one level. It also alows to break down the geometric excess returns. The
+#' attribution effects can be computed for several periods. Different linking
+#' methods allow to get the multi-period summary. Finally, it annualizes
+#' arithmetic and geometric excess returns similarly to the portfolio and/or
+#' benchmark returns annualization.
#'
-#' @param Rp portfolio returns
-#' @param wp portfolio weights
-#' @param Rb benchmark returns
-#' @param wb benchmark weights
+#' @aliases Attribution
+#' @param Rp xts, data frame or matrix of portfolio returns
+#' @param wp vector, xts, data frame or matrix of portfolio weights
+#' @param Rb xts, data frame or matrix of benchmark returns
+#' @param wb vector, xts, data frame or matrix of benchmark weights
#' @param method Used to select the priority between allocation and selection
#' effects in arithmetic attribution. May be any of: \itemize{ \item none -
#' present allocation, selection and interaction effects independently,
@@ -29,7 +30,9 @@
#' geometric attribution. May be any of: \itemize{ \item carino - logarithmic
#' linking coefficient method, \item menchero - Menchero's smoothing algorithm,
#' \item grap - linking approach developed by GRAP, \item frongello -
-#' Frongello's linking method, \item geometric - geometric attribution}
+#' Frongello's linking method
+#' @param geometric TRUE/FALSE, whether to use geometric or arithmetic excess
+#' returns for the attribution analysis
#' @author Andrii Babii
#' @seealso \code{\link{Attribution.levels}}
#' @references Bacon, C. \emph{Practical Portfolio Performance Measurement and
@@ -47,30 +50,26 @@
#'
#' data(attrib)
#' Attribution(Rp, wp, Rb, wb, method = "top.down", linking = "carino")
-#' Attribution(Rp, wp, Rb, wb, method = "bottom.up", linking = "menchero")
-#' Attribution(Rp, wp, Rb, wb, method = "none", linking = "grap")
-#' Attribution(Rp, wp, Rb, wb, method = "top.down", linking = "frongello")
-#' Attribution(Rp, wp, Rb, wb, linking = "geometric")
+#' Attribution(Rp, wp, Rb, wb, geometric = TRUE)
#'
#' @export
Attribution <-
function (Rp, wp, Rb, wb, method = c("none", "top.down", "bottom.up"),
-linking = c("carino", "menchero", "grap", "frongello", "geometric"))
+linking = c("carino", "menchero", "grap", "frongello"), geometric = FALSE)
{ # @author Andrii Babii
# DESCRIPTION:
# Function to perform the attribution analysis.
# Inputs:
- # Rp portfolio returns
- # wp portfolio weights
- # Rb benchmark returns
- # wb benchmark weights
- # method
- # linking
+ # 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
# Outputs:
- # This function returns the attribution effects
+ # This function returns the attribution effects with multi-period summary
+ # and annualized excess returns
# FUNCTION:
# Transform data to the xts objects
@@ -78,141 +77,79 @@
Rp = checkData(Rp)
wp = Weight.transform(wp, Rp)
wb = Weight.transform(wb, Rb)
-
+ if (nrow(wp) < nrow(Rp)){ # Rebalancing occurs next day
+ Rp = Rp[2:nrow(Rp)]
+ Rb = Rb[2:nrow(Rb)]
+ }
+
# Compute attribution effects
allocation = (wp - wb) * Rb
selection = wb * (Rp - Rb)
interaction = (wp - wb) * (Rp - Rb)
- # Get total attribution effects
+ # Get total attribution effects ???
+ n = ncol(allocation) # number of segments
allocation = cbind(allocation, rowSums(allocation))
- names(allocation)[ncol(allocation)] = "Total"
+ names(allocation)[n + 1] = "Total"
selection = cbind(selection, rowSums(selection))
- names(selection)[ncol(selection)] = "Total"
+ names(selection)[n + 1] = "Total"
interaction = cbind(interaction, rowSums(interaction))
- names(interaction)[ncol(interaction)] = "Total"
+ names(interaction)[n + 1] = "Total"
total = allocation + selection + interaction
-
- # Get total portfolio returns
- rp = reclass(rowSums(Rp * wp), Rp)
+
+ # Get total portfolio returns and annualized excess returns
+ rp = reclass(rowSums(Rp * wp), Rp)
rb = reclass(rowSums(Rb * wb), Rb)
- names(rp) = "Total"
- names(rb) = "Total"
- rp.a = prod(1 + rp) - 1
+ names(rp) = "Total"
+ names(rb) = "Total"
+ rp.a = prod(1 + rp) - 1
rb.a = prod(1 + rb) - 1
- aer = rp.a - rb.a # Arithmetic (annualized) excess returns
- ger = (1 + rp.a) / (1 + rb.a) - 1 # Geometric (annualized) excess returns
- excess.return = as.matrix(c(aer, ger))
+
+ aer.a = rp.a - rb.a # Arithmetic (annualized) excess returns
+ ger.a = (1 + rp.a) / (1 + rb.a) - 1 # Geometric (annualized) excess returns
+ excess.return = as.matrix(c(aer.a, ger.a))
rownames(excess.return) = c("Arithmetic", "Geometric")
- Rp = cbind(Rp, rp)
- Rb = cbind(Rb, rb)
+
# Adjust attribution effects using one of linking methods
if (linking == "carino"){
- # Carino linking
- kt = rp
- for (t in 1:nrow(kt)){
- if (rp[t] == rb[t]){
- kt[t] = 1 / (1 + rp[t]) # Carino factors if portfolio and benchmark returns are equal
- } else{
- kt[t] = (log(1 + rp[t]) - log(1 + rb[t])) / (rp[t] - rb[t]) # if different
- }
- }
- k = (log(1 + rp.a) - log(1 + rb.a)) / (rp.a - rb.a)
- for(i in 1:ncol(allocation)){
- allocation[, i] = allocation[, i] * kt / k
- selection[, i] = selection[, i] * kt / k
- interaction[, i] = interaction[, i] * kt / k
- }
+ allocation = Carino(rp, rb, allocation)
+ selection = Carino(rp, rb, selection)
+ interaction = Carino(rp, rb, interaction)
+ total = Carino(rp, rb, total)
}
if (linking == "menchero"){
- # Menchero linking
- T = nrow(Rp)
- if (rp.a == rb.a){
- M = (1 + rb.a)^((T - 1) / T)
- at = 0
- } else{
- M = ((rp.a - rb.a) / T) / ((1 + rp.a)^(1 / T) - (1 + rb.a)^(1 / T))
- at = (rp.a - rb.a - M * sum(rp - rb)) * (rp - rb) / sum((rp - rb)^2)
- }
- for(i in 1:ncol(allocation)){
- allocation[, i] = allocation[, i] * (M + at)
- selection[, i] = selection[, i] * (M + at)
- interaction[, i] = interaction[, i] * (M + at)
- }
+ allocation = Menchero(rp, rb, allocation)
+ selection = Menchero(rp, rb, selection)
+ interaction = Menchero(rp, rb, interaction)
+ total = Menchero(rp, rb, total)
}
if (linking == "grap"){
- # GRAP linking
- G = rp
- T = nrow(Rp)
- G[1] = prod(1 + rb[2:T]) #GRAP factor for the first period
- if (T == 2){
- G[2] = (1 + rp[1])
- }
- if (T > 2){
- G[T] = prod(1 + rp[1:(T - 1)]) #GRAP factor for the last period
- }
- if (T > 3){
- for(i in 2:(T - 1)){
- r = 1 + rp[1:(i-1)]
- b = 1 + rb[(i+1):T]
- G[i] = apply(r, 2, prod) * apply(b, 2, prod)
- }
- }
- for(i in 1:ncol(allocation)){
- allocation[, i] = allocation[, i] * G
- selection[, i] = selection[, i] * G
- interaction[, i] = interaction[, i] * G
- }
+ allocation = Grap(rp, rb, allocation)
+ selection = Grap(rp, rb, selection)
+ interaction = Grap(rp, rb, interaction)
+ total = Grap(rp, rb, total)
}
if (linking == "frongello"){
- # Frongello linking
- allocation[1, ] = allocation[1, ] + Rb[1, ]
- selection[1, ] = selection[1, ] + Rb[1, ]
- interaction[1, ] = interaction[1, ] + Rb[1, ]
- for(i in 2:nrow(Rp)){
- allocation[i, ] = allocation[i, ] * apply((1 + Rp[1:(i-1), ]), 2, prod) + Rb[i, ] * apply(allocation[1:(i-1)], 2, sum)
- selection[i, ] = selection[i, ] * apply((1 + Rp[1:(i-1), ]), 2, prod) + Rb[i, ] * apply(selection[1:(i-1)], 2, sum)
- interaction[i, ] = interaction[i, ] * apply((1 + Rp[1:(i-1), ]), 2, prod) + Rb[i, ] * apply(interaction[1:(i-1)], 2, sum)
- }
+ allocation = Frongello(Rp, wp, Rb, wb, allocation)
+ selection = Frongello(Rp, wp, Rb, wb, selection)
+ interaction = Frongello(Rp, wp, Rb, wb, interaction)
+ total = Frongello(Rp, wp, Rb, wb, total)
}
- if (linking == "geometric"){
- bs = reclass(rowSums((wp * Rb[, 1:ncol(wp)])), rp) # Seminotional fund returns
- allocation = ((1 + Rb) / (1 + rb.a) - 1) * cbind((wp - wb), rep(1, nrow(wp)))
- for (i in 1:ncol(wp)){
- selection[, i] = ((Rp - Rb) * cbind(wp, rep(1, nrow(wp))))[, i] / (1 + bs)
- }
+ if (geometric == TRUE){
+ attrib = Attribution.geometric(Rp, wp, Rb, wb)
}
- # Aggregate adjusted multi-period attribution effects
- if (linking != "geometric"){
- totals <- function(x){
- x = as.data.frame(x)
- x = rbind(x, colSums(x))
- rownames(x)[nrow(x)] = "Total"
- return(x)
- }
- allocation = totals(allocation)
- selection = totals(selection)
- interaction = totals(interaction)
- total = totals(total)
- } else{
- allocation = rbind(as.data.frame(allocation), (apply(1 + allocation, 2, prod) - 1))
- selection = rbind(as.data.frame(selection), (apply(1 + selection, 2, prod) - 1))
- rownames(allocation)[nrow(allocation)] = "Total"
- rownames(selection)[nrow(selection)] = "Total"
- }
-
# Select the appropriate result corresponding to the chosen method
result = list()
result[[1]] = allocation
result[[2]] = selection
result[[3]] = total
- if (linking != "geometric"){
+ if (geometric == FALSE){
if (method == "top.down"){ # Top-down attribution
result[[2]] = result[[2]] + interaction
}
@@ -223,14 +160,16 @@
result[[4]] = result[[3]]
result[[3]] = interaction
}
+ } else{
+ result = attrib
}
result[[length(result) + 1]] = excess.return
# Label the output
- if (method == "none" & linking != "geometric"){
+ if (method == "none" & geometric == FALSE){
names(result) = c("Allocation", "Selection", "Interaction", "Total", "Annualized excess returns")
} else{
- names(result) = c("Allocation", "Selection", "Total", "Annualized excess returns")
+ names(result) = c("Allocation", "Selection", "Total", "Annualized excess returns")
}
return(result)
}
\ No newline at end of file
More information about the Returnanalytics-commits
mailing list