[Returnanalytics-commits] r1987 - pkg/PortfolioAnalytics/sandbox/attribution

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jun 6 16:29:37 CEST 2012


Author: ababii
Date: 2012-06-06 16:29:36 +0200 (Wed, 06 Jun 2012)
New Revision: 1987

Modified:
   pkg/PortfolioAnalytics/sandbox/attribution/attribution.R
Log:
- added Frongello linking

Modified: pkg/PortfolioAnalytics/sandbox/attribution/attribution.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/attribution.R	2012-06-05 21:01:38 UTC (rev 1986)
+++ pkg/PortfolioAnalytics/sandbox/attribution/attribution.R	2012-06-06 14:29:36 UTC (rev 1987)
@@ -1,11 +1,11 @@
 #' performs arithmetic attribution
 #' 
-#' @aliases attribution.arithmetic
+#' @aliases attribution.crithmetic
 #' 
 #' Performs arithmetic attribution analysis of returns. Used to uncover the sources 
 #' of portfolio return 
 #'
-#' @aliases attribution.arithmetic
+#' @aliases attribution.crithmetic
 #' @param Rp portfolio returns
 #' @param wp portfolio weights
 #' @param Rb benchmark returns
@@ -42,6 +42,8 @@
     # Transform data to the xts
     Rb = checkData(Rb)
     Rp = checkData(Rp)
+    wp = Weight.transform(Rp, wp)
+    wb = Weight.transform(Rb, wb)
 
     # Compute attribution effects
     allocation = (wp - wb) * Rb
@@ -54,17 +56,20 @@
     interaction = cbind(interaction, rowSums(interaction)) # Total interaction effect for each period
     names(interaction)[ncol(interaction)] = "Total"
     
-    
-    # Get aggregated portfolio returns
+    # Get total portfolio returns
     rp = reclass(rowSums(Rp * wp), Rp) 
     rb = reclass(rowSums(Rb * wb), Rb)
-    rp.a = prod(rp + 1) - 1 
-    rb.a = prod(rb + 1) - 1
+    names(rp) = "Total"
+    names(rb) = "Total"
+    Rp = cbind(Rp, rp)
+    Rb = cbind(Rb, rb)
+    rp.c = Return.cumulative(rp)
+    rb.c = Return.cumulative(rb)
    
     if(linking == "carino"){
         # Carino linking #!!! Correct for equal portfolio and benchmark returns
         kt = (log(1 + rp) - log(1 + rb)) / (rp - rb) # Carino factors
-        k = (log(1 + rp.a) - log(1 + rb.a)) / (rp.a - rb.a)
+        k = (log(1 + rp.c) - log(1 + rb.c)) / (rp.c - rb.c)
         for(i in 1:ncol(allocation)){
             allocation[, i] = allocation[, i] * kt / k
             selection[, i] = selection[, i] * kt / k
@@ -74,8 +79,8 @@
 
     if(linking == "menchero"){
         # Menchero linking #!!! Correct for equal portfolio and benchmark returns
-        M = ((rp.a - rb.a) / nrow(Rp)) / ((1 + rp.a)^(1 / nrow(Rp)) - (1 + rb.a)^(1 / nrow(Rp)))
-        at = (rp.a - rb.a - M * sum(rp - rb)) * (rp - rb) / sum((rp - rb)^2)
+        M = ((rp.c - rb.c) / nrow(Rp)) / ((1 + rp.c)^(1 / nrow(Rp)) - (1 + rb.c)^(1 / nrow(Rp)))
+        at = (rp.c - rb.c - 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)
@@ -102,7 +107,14 @@
 
     if(linking == "frongello"){
         # Frongello linking
-        F = rp
+        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)
+        }
     }
     
     if(linking == "geometric"){
@@ -155,18 +167,16 @@
 data(attrib) # !!! Load attrib.RData workspace
 require(FinancialInstrument)
 require(PerformanceAnalytics)
-wp <- Weight.transform(Rp, wp)
-wb <- Weight.transform(Rb, wb)
 Rp <- Return.level(Rp, wp, h, level = "Sector") # Sector-level attribution
 Rb <- Return.level(Rb, wb, h, level = "Sector")
 wp <- Weight.level(wp, h, level = "Sector")
 wb <- Weight.level(wb, h, level = "Sector")
 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 = "simple", linking = "carino")
+attribution(Rp, wp, Rb, wb, method = "simple", linking = "grap")
 
 #' @export 
-#' @rdname attribution.arithmetic
+#' @rdname attribution
 
 ###############################################################################
 # R (http://r-project.org/) Econometrics for Performance and Risk Analysis



More information about the Returnanalytics-commits mailing list