[Returnanalytics-commits] r2115 - in pkg/PortfolioAnalytics/sandbox/attribution: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Jul 6 18:50:21 CEST 2012


Author: ababii
Date: 2012-07-06 18:50:21 +0200 (Fri, 06 Jul 2012)
New Revision: 2115

Added:
   pkg/PortfolioAnalytics/sandbox/attribution/R/HierarchyQuintiles.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/Return.annualized.excess.R
   pkg/PortfolioAnalytics/sandbox/attribution/man/AttributionFixedIncome.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Conv.option.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/DaviesLaker.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/HierarchyQuintiles.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Return.annualized.excess.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/test_suite.R
Removed:
   pkg/PortfolioAnalytics/sandbox/attribution/R/test_suite.R
Modified:
   pkg/PortfolioAnalytics/sandbox/attribution/R/Attribution.geometric.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/AttributionFixedIncome.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/Carino.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/Conv.option.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/DaviesLaker.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/Frongello.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/Grap.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/Menchero.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/Return.level.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/attribution.R
   pkg/PortfolioAnalytics/sandbox/attribution/R/attribution.levels.R
   pkg/PortfolioAnalytics/sandbox/attribution/man/Attribution.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Attribution.geometric.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Attribution.levels.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Carino.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Frongello.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Grap.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Menchero.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Modigliani.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/Weight.transform.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/logLinking.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/logLinking.zoo.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/period.apply.EZ.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/relativeAttribution.Rd
   pkg/PortfolioAnalytics/sandbox/attribution/man/relativeAttributionWithoutFactors.Rd
Log:
- fixed bug with incorrect portfolio returns (replaced by Return.portfolio)
- fixed bug with incorrect annualized excess returns in case of different
periodicities (replaced by Return.annualized.excess)
- fixed bugs in the Return.level function with aggregation by quintiles
for weights
- fixed bugs in the Attribution.levels
- HierarchyQuintiles is used internally
- added Brinson and Fachler decomposition
- other corrections and fixes
- update in the documentation

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/Attribution.geometric.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/Attribution.geometric.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/Attribution.geometric.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -3,9 +3,10 @@
 #' Performance attribution of geometric excess returns. Calculates total 
 #' geometric attribution effects over multiple periods. Used internally by the
 #' \code{\link{Attribution}} function. Geometric attribution effects in the
-#' conrast with arithmetic do naturally link over time multiplicatively:
+#' contrast with arithmetic do naturally link over time multiplicatively:
 #' \deqn{\frac{(1+r)}{1+b}-1=\overset{n}{\underset{t=1}{\prod}}(1+A_{t}^{G})\times\overset{n}{\underset{t=1}{\prod}}(1+S{}_{t}^{G})-1}
-#' , where
+#' 
+#' where
 #' \deqn{A_{t}^{G}} - total allocation effect at time t
 #' \deqn{S_{t}^{G}} - total selection effect at time t
 #' \deqn{A_{t}^{G}=\frac{1+b_{S}}{1+b_{t}}-1}
@@ -19,27 +20,32 @@
 #' \deqn{r} - total portfolio returns
 #' \deqn{b} - total benchmark returns
 #' \deqn{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
 #' \deqn{b_{SH} = \underset{i}{\sum}((w_{pi} - w_{bi})R_{bHi} + w_{bi}R_{bLi})}
 #' - total semi-notional return hedged into the base currency 
+#' 
 #' \deqn{b_{SL} = \underset{i}{\sum}w_{pi}R_{bLi}} - total semi-notional return
 #' in the local currency
 #' \deqn{w_{pi}} - portfolio weights of asset i
 #' \deqn{w_{bi}} - benchmark weights of asset i
 #' \deqn{R_{pLi}} - portfolio returns in the local currency
 #' \deqn{R_{bLi}}} - benchmark returns in the local currency
-#' \deqn{R_{bHi}} - benchmark returns hendged into the base currency
+#' \deqn{R_{bHi}} - benchmark returns hedged into the base currency
 #' \deqn{b_{L}} - total benchmark returns in the local currency
 #' \deqn{r_{L}} - total portfolio returns in the local currency
 #' The total excess returns are decomposed into:
 #' \deqn{\frac{(1+r)}{1+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}{1+r_{L}}\times\frac{1+b_{L}}{1+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
@@ -54,7 +60,7 @@
 #' @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
+#' 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.  
@@ -78,40 +84,52 @@
     # Function to perform the geometric attribution analysis.
   
     # 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
+    # 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:
-    rp = reclass(rowSums(Rp * wp), Rp)  
-    rb = reclass(rowSums(Rb * wb), Rb)  
+    WP = wp # Save original weights in order to avoid double conversion later
+    WB = wb
+    wp = Weight.transform(wp, Rp)
+    wb = Weight.transform(wb, Rb)
+    
+    # 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"                 
-    bs = reclass(rowSums((wp * Rb[, 1:ncol(wp)])), rp) # Allocation notional fund returns
+    names(rb) = "Total"
+    
+    bs = reclass(rowSums((wp * coredata(Rb[, 1:ncol(wp)]))), rp) # Allocation notional fund returns
     if (!currency){
-        allocation = ((1 + Rb) / (1 + rep(rb, ncol(Rp))) - 1) * (wp - wb) # Geometric attribution effects for individual categories
-        selection = wp * (Rp - Rb) / (1 + rep(bs, ncol(Rp)))
+      allocation = ((1 + Rb) / (1 + rep(rb, ncol(Rp))) - 1) * coredata(wp - wb) # Geometric attribution effects for individual categories
+      selection = wp * (Rp - coredata(Rb)) / (1 + rep(bs, ncol(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")
+      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
@@ -128,23 +146,23 @@
     rownames(allocation)[nrow(allocation)] = "Total"
     rownames(selection)[nrow(selection)] = "Total"
     
-    # Get total geometric excess returns
-    excess.returns = (1 + rp) / (1 + rb) - 1
-    rp.a = prod(1 + rp) - 1              
-    rb.a = prod(1 + rb) - 1
-    ger.a = as.matrix((1 + rp.a) / (1 + rb.a) - 1)  
-    rownames(ger.a) = "Total geometric"
-    excess.returns = rbind(as.matrix(excess.returns), ger.a)
+    # 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")
+      names(result) = c("Excess returns", "Allocation", "Selection")
     } else{
-        result[[4]] = curr
-        names(result) = c("Excess returns", "Allocation", "Selection", "Currency management")
+      result[[4]] = curr
+      names(result) = c("Excess returns", "Allocation", "Selection", "Currency management")
     }
     
     return(result)

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/AttributionFixedIncome.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/AttributionFixedIncome.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/AttributionFixedIncome.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -1,4 +1,4 @@
-#' performs fixed income attribution
+#' 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
@@ -94,32 +94,45 @@
     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)
     
-    rp = reclass(rowSums(Rp * wp), Rp)
-    rb = reclass(rowSums(Rb * wb), wb)
-    rf = reclass(rowSums(Rf * wp), Rf)
-    dp = reclass(rowSums(Dp * wp), Dp) # Portfolio duration
-    db = reclass(rowSums(Db * wp), Db) # Benchmark duration
-    Dbeta = dp / db
-    DeltaYb = -(Rb - Rf) / Db # Implied benchmark yield changes
-    DeltaYp = -(Rp - Rf) / Dp # Implied portfolio yield changes
-    deltayb = rep(-(rp - rb), ncol(Dp)) / Dp # Implied total benchmark yield changes
+    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)
+    DeltaYb = -(Rb - coredata(Rf)) / coredata(Db) # Implied benchmark yield changes
+    DeltaYp = -(Rp - coredata(Rf)) / coredata(Dp) # Implied portfolio yield changes
+    deltayb = rep(rb - coredata(rp), ncol(Dp)) / coredata(Dp) # Implied total benchmark yield changes
     Rc = lag(S, -1)[1:nrow(Rp), ] / S[1:nrow(Rp), ] - 1 # Currency returns
-    rc = reclass(rowSums((wb + wbf) * (Rc + Rf)), Rc)
+    rc = reclass(rowSums((wb + wbf) * (Rc + coredata(Rf))), Rc)
     if (!geometric){
-        allocation = (Dp * wp - rep(Dbeta, ncol(Dp)) * Db * wb) * (-DeltaYb + deltayb)
-        selection = Dp * wp * (-DeltaYp + DeltaYb)
-        currency = (wp - wb) * (Rc + Rf - rep(rc, ncol(Rc)))
-        excess.returns = rp - rb
+      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 * wb * -DeltaYb), Db) + rcprime # Overal duration notional fund
-        allocation = Dp * wp - rep(Dbeta, ncol(Dp)) * Db * wb * (-DeltaYb + deltayb) / rep(bd, ncol(Db))
-        selection = Dp / Db * (Rb - Rf) + Rf
-        excess.returns = (1 + rp) / (1 + rb) - 1
+      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 
@@ -136,10 +149,10 @@
     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")
+      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

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/Carino.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/Carino.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/Carino.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -7,9 +7,12 @@
 #' 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}},
+#' 
 #' where \deqn{k_{t} = \frac{log(1 + r_{t}) - log(1 + b_{t})}{r_{t} - b_{t}}}, 
-#' \deqn{k = \frac{log(1 + r) - log(1 + b)}{r - b}}. In case if portfolio and 
-#' benchmark returns are equal \deqn{k_{t} = \frac{1}{1 + r_{t}}. 
+#' \deqn{k = \frac{log(1 + r) - log(1 + b)}{r - b}}. 
+#' 
+#' In case if portfolio and benchmark returns are equal:
+#' \deqn{k_{t} = \frac{1}{1 + r_{t}}
 #' \deqn{A_{t}}' - adjusted attribution effects at period \deqn{t}
 #' \deqn{A_{t}} - unadjusted attribution effects at period \deqn{t}
 #' \deqn{r_{t}} - portfolio returns at period \deqn{t}
@@ -67,24 +70,24 @@
     # and total attribution effects over multiple periods
   
     # FUNCTION:
-    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)
+    rpc = prod(1 + rp) - 1     # Cumulative returns          
+    rbc = prod(1 + rb) - 1
+    k = (log(1 + rpc) - log(1 + rbc)) / (rpc - rbc)
     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
+      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[[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)
     adj = attributions * kt / k 
     total = colSums(adj)
     if (adjusted == FALSE){
-        attributions = rbind(as.data.frame(attributions), total)
+      attributions = rbind(as.data.frame(attributions), total)
     } else{
-        attributions = rbind(as.data.frame(adj), total)
+      attributions = rbind(as.data.frame(adj), total)
     }
     rownames(attributions)[nrow(attributions)] = "Total"
     

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/Conv.option.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/Conv.option.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/Conv.option.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -1,4 +1,4 @@
-#' convert infromation about options, warrants or convertible bonds to the
+#' convert information about options, warrants or convertible bonds to the
 #' equivalent of returns
 #' 
 #' The performance of option contracts are measured in exactly the same way as

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/DaviesLaker.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/DaviesLaker.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/DaviesLaker.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -58,20 +58,29 @@
     # and total attribution effects over multiple periods
     
     # FUNCTION:
-    rp = reclass(rowSums(Rp * wp), Rp)  
-    rb = reclass(rowSums(Rb * wb), Rb)  
-    colnames(rp) = "Total"                    
-    colnames(rb) = "Total"                 
-    bs = reclass(rowSums((wp * Rb[, 1:ncol(wp)])), Rp) # Allocation notional fund returns
-    rs = reclass(rowSums((wb * Rp[, 1:ncol(wb)])), Rp) # Selection notional fund returns
+    WP = wp
+    WB = wb
+    wp = Weight.transform(wp, Rp)
+    wb = Weight.transform(wb, Rb)
+    if (is.vector(WP)  & is.vector(WB)){
+      rp = Return.portfolio(Rp, WP, geometric = FALSE)
+      rb = Return.portfolio(Rb, WB, geometric = FALSE)
+    } else{
+      rp = Return.rebalancing(Rp, WP, geometric = FALSE)
+      rb = Return.rebalancing(Rb, WB, geometric = FALSE)
+    }
+    colnames(rp) = "Total"
+    colnames(rb) = "Total"
+    bs = reclass(rowSums((wp * coredata(Rb[, 1:ncol(wp)]))), Rp) # Allocation notional fund returns
+    rs = reclass(rowSums((wb * coredata(Rp[, 1:ncol(wb)]))), Rp) # Selection notional fund returns
     a = apply(1 + bs, 2, prod) - apply(1 + rb, 2, prod)
     s = apply(1 + rs, 2, prod) - apply(1 + rb, 2, prod)
     i = apply(1 + rp, 2, prod) - apply(1 + rs, 2, prod) - apply(1 + bs, 2, prod) + apply(1 + rb, 2, prod)
     
     # Compute attribution effects (Brinson, Hood and Beebower model)
-    allocation = (wp - wb) * Rb
-    selection = wb * (Rp - Rb)
-    interaction = (wp - wb) * (Rp - Rb)
+    allocation = (wp - wb) * coredata(Rb)
+    selection = wb * (Rp - coredata(Rb))
+    interaction = (wp - wb) * (Rp - coredata(Rb))
     n = ncol(allocation)               # number of segments
     allocation = cbind(allocation, rowSums(allocation))
     names(allocation)[n + 1] = "Total"  
@@ -87,12 +96,13 @@
     rownames(selection)[nrow(selection)] = "Total"
     rownames(interaction)[nrow(allocation)] = "Total"
 
-    excess.returns = rp - rb
-    rp.a = prod(1 + rp) - 1              
-    rb.a = prod(1 + rb) - 1
-    aer.a = as.matrix(rp.a - rb.a)                  # Arithmetic (annualized) excess returns
-    rownames(aer.a) = "Total arithmetic"
-    excess.returns = rbind(as.matrix(excess.returns), aer.a)
+    # Arithmetic excess returns + annualized arithmetic excess returns
+    excess.returns = rp - coredata(rb)
+    if (nrow(rp) > 1){
+      er = Return.annualized.excess(rp, rb, geometric = FALSE)
+      excess.returns = rbind(as.matrix(excess.returns), er)
+    }
+    colnames(excess.returns) = "Arithmetic"
     
     result = list()
     result[[1]] = excess.returns

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/Frongello.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/Frongello.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/Frongello.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -59,12 +59,12 @@
     # FUNCTION:
     adj = attributions
     if (nrow(rp) > 1){
-        adj[2, ] = coredata(adj[2, ]) * drop((1 + rp[1, 1])) + drop(rb[2, 1]) * coredata(adj[1, ])
+      adj[2, ] = coredata(adj[2, ]) * drop((1 + rp[1, 1])) + drop(rb[2, 1]) * coredata(adj[1, ])
     }
     if (nrow(rp) > 2){
-        for(i in 3:nrow(rp)){
-            adj[i, ] = coredata(adj[i, ]) * drop(prod(1 + rp[1:(i-1), 1])) + drop(rb[i, ]) * coredata(colSums(adj[1:(i-1), ]))
-        }
+      for(i in 3:nrow(rp)){
+        adj[i, ] = coredata(adj[i, ]) * drop(prod(1 + rp[1:(i-1), 1])) + drop(rb[i, ]) * coredata(colSums(adj[1:(i-1), ]))
+      }
     }
     total = colSums(adj)
     if (adjusted == FALSE){

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/Grap.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/Grap.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/Grap.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -1,9 +1,9 @@
 #' calculates total attribution effects using GRAP smoothing 
 #' 
 #' Calculates total attribution effects over multiple periods using 
-#' GEAP linking method. Used internally by the \code{\link{Attribution}} 
-#' function. Arithmetic attribution effects do not naturally link over time. 
-#' This function uses GRAP smoothing algorithm to adjust attribution effects 
+#' GRAP linking method. Used internally by the \code{\link{Attribution}} 
+#' function. Arithmetic attribution effects do not naturally link over time.
+#' This function uses GRAP smoothing algorithm 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 G_{t}}, where 
@@ -66,17 +66,17 @@
     T = nrow(rp)
     G[1] = prod(1 + rb[2:T])           #GRAP factor for the first period
     if (T == 2){
-        G[2] = (1 + rp[1])
+      G[2] = (1 + rp[1])
     }
     if (T > 2){
-        G[T] = prod(1 + rp[1:(T - 1)]) #GRAP factor for the last period
+      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 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)
     adj = attributions * g

Added: pkg/PortfolioAnalytics/sandbox/attribution/R/HierarchyQuintiles.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/HierarchyQuintiles.R	                        (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/HierarchyQuintiles.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -0,0 +1,43 @@
+#' replaces numeric values in the hierarchy by quintiles
+#' 
+#' Replaces numeric values in the hierarchy by text with corresponding 
+#' quintiles
+#'
+#' @aliases HierarchyQuintiles
+#' @param h  data.frame with portfolio hierarchy
+#' @param level level from the hierarchy for which there are numeric values
+#' @author Andrii Babii
+#' @seealso  \code{\link{buildHierarchy}}
+#' @keywords attribution, hierarchy
+#' @examples
+#' 
+#' data(attrib)
+#' HierarchyQuintiles(h, "MarketCap")
+#' 
+#' @export
+HierarchyQuintiles <-
+function(h, level)
+{  # @author Andrii Babii
+    h = na.omit(h)
+    hnew = h[[level]]
+    quintiles = quantile(h[[level]], c(0, 0.2, 0.4, 0.6, 0.8, 1), na.rm = TRUE)
+    for (i in 1:length(h[[level]])){
+      if (h[[level]][i] >= quintiles[1] & h[[level]][i] < quintiles[2] & !is.na(h[[level]][i])){
+        hnew[i] = "Quintile 1"
+      }
+    if (h[[level]][i] >= quintiles[2] & h[[level]][i] < quintiles[3] & !is.na(h[[level]][i])){
+      hnew[i] = "Quintile 2"
+    }
+    if (h[[level]][i] >= quintiles[3] & h[[level]][i] < quintiles[4] & !is.na(h[[level]][i])){
+      hnew[i] = "Quintile 3"
+    }
+    if (h[[level]][i] >= quintiles[4] & h[[level]][i] < quintiles[5] & !is.na(h[[level]][i])){
+      hnew[i] = "Quintile 4"
+    }
+    if (h[[level]][i] >= quintiles[5] & h[[level]][i] <= quintiles[6] & !is.na(h[[level]][i])){
+      hnew[i] = "Quintile 5"
+    }
+    }
+    h[[level]] = hnew
+    return(h)
+}

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/Menchero.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/Menchero.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/Menchero.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -64,15 +64,15 @@
     # and total attribution effects over multiple periods
   
     # FUNCTION:
-    rp.a = prod(1 + rp) - 1              
-    rb.a = prod(1 + rb) - 1
+    rpc = prod(1 + rp) - 1    # Cumulative returns          
+    rbc = prod(1 + rb) - 1
     T = nrow(rp)
-    if (rp.a == rb.a){
-        M = (1 + rb.a)^((T - 1) / T)
-        at = 0
+    if (rpc == rbc){
+      M = (1 + rbc)^((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 = ((rpc - rbc) / T) / ((1 + rpc)^(1 / T) - (1 + rbc)^(1 / T))
+      at = (rpc - rbc - M * sum(rp - rb)) * (rp - coredata(rb)) / sum((rp - coredata(rb))^2)
     }
     m = matrix(rep(M + at, ncol(attributions)), nrow(attributions), ncol(attributions), byrow = FALSE)
     adj = attributions * m

Added: pkg/PortfolioAnalytics/sandbox/attribution/R/Return.annualized.excess.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/Return.annualized.excess.R	                        (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/Return.annualized.excess.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -0,0 +1,77 @@
+#' calculate an annualized excess return for comparing instruments with different
+#' length history
+#' 
+#' An average annualized excess return is convenient for comparing returns.
+#' 
+#' Annualized returns are useful for comparing two assets. To do so, you must
+#' scale your observations to an annual scale by raising the compound return to
+#' the number of periods in a year, and taking the root to the number of total 
+#' observations:
+#' \deqn{prod(1+R_{a})^{\frac{scale}{n}}-1=\sqrt[n]{prod(1+R_{a})^{scale}}-1}{prod(1
+#' + Ra)^(scale/n) - 1}
+#' 
+#' where scale is the number of periods in a year, and n is the total number of
+#' periods for which you have observations.
+#' 
+#' Finally having annualized returns for portfolio and benchmark we can compute
+#' annualized excess return as difference in the annualized portfolio and 
+#' benchmark returns in the arithmetic case:
+#' \deqn{er = R_{pa} - R_{ba}}
+#' 
+#' and as a geometric difference in the geometric case:
+#' \deqn{er = (1 + R_{pa}) / (1 + R_{ba}) - 1}
+#' 
+#' @param Rp an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' portfolio returns
+#' @param Rb an xts, vector, matrix, data frame, timeSeries or zoo object of 
+#' benchmark returns
+#' @param scale number of periods in a year (daily scale = 252, monthly scale =
+#' 12, quarterly scale = 4)
+#' @param geometric generate geometric (TRUE) or simple (FALSE) excess returns,
+#' default TRUE
+#' @author Andrii Babii
+#' @seealso \code{\link{Return.annualized}},
+#' @references Bacon, Carl. \emph{Practical Portfolio Performance Measurement
+#' and Attribution}. Wiley. 2004. p. 206-207
+#' @keywords ts multivariate distribution models
+#' @examples
+#' 
+#' data(attrib)
+#' Return.annualized.excess(rp, rb)
+#' 
+#' @export
+Return.annualized.excess <- 
+function (Rp, Rb, scale = NA, geometric = TRUE )
+{ # @author Andrii Babii
+    Rp = checkData(Rp)
+    Rb = checkData(Rb)
+    
+    Rp = na.omit(Rp)
+    Rb = na.omit(Rb)
+    n = nrow(Rp)
+    if(is.na(scale)) {
+      freq = periodicity(Rp)
+      switch(freq$scale,
+             minute = {stop("Data periodicity too high")},
+             hourly = {stop("Data periodicity too high")},
+             daily = {scale = 252},
+             eekly = {scale = 52},
+             monthly = {scale = 12},
+             quarterly = {scale = 4},
+             yearly = {scale = 1}
+             )
+    }
+    Rpa = apply(1 + Rp, 2, prod)^(scale/n) - 1
+    Rba = apply(1 + Rb, 2, prod)^(scale/n) - 1
+    if (geometric) {
+      # geometric excess returns
+      result = (1 + Rpa) / (1 + Rba) - 1
+    } else {
+      # arithmetic excess returns
+      result = Rpa - Rba
+    }
+    dim(result) = c(1,NCOL(Rp))
+    colnames(result) = colnames(Rp)
+    rownames(result) = "Annualized Return"
+    return(result)
+}
\ No newline at end of file

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/Return.level.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/Return.level.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/Return.level.R	2012-07-06 16:50:21 UTC (rev 2115)
@@ -1,10 +1,12 @@
 #' aggregate portfolio returns and weights up to the chosen level from the 
 #' hierarchy
 #' 
-#' Aggregate returns and weights up to the chosen level from the hierarchy. 
-#' Hierarchy can be used from the buildHierarchy function or 
-#' defined manually in the same way as the buildHierarchy's output.
-#' \code{Weight.transform} makes transformation of weigths to the xts object
+#' Aggregate returns and weights up to the chosen level from the hierarchy.
+#' Hierarchy can be used from the buildHierarchy function or defined manually
+#' in the same way as the buildHierarchy's output. If for the selected level 
+#' the values in the hierarchy are numeric, the aggregation of returns or 
+#' weights is performed by quintiles.
+#' \code{Weight.transform} makes transformation of weights to the xts object
 #' conformable with returns.
 #'
 #' @aliases Weight.transform Return.level Weight.level
@@ -24,7 +26,7 @@
 #' 
 #' data(attrib)
 #' Weight.transform(wp, Rp)
-#' Return.level(Rp, wp, h, level = "Sector")
+#' Return.level(Rp, wp, h, level = "MarketCap")
 #' Weight.level(wp, h, level = "Sector")
 #' 
 #' @export
@@ -45,21 +47,21 @@
   
     # FUNCTION:
     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 = as.xts(matrix(rep(wp, nrow(Rp)), nrow(Rp), ncol(Rp), byrow = TRUE), index(Rp))
+      colnames(wp) = colnames(Rp)
     } else{
-        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))
-        }
-        wp = checkData(wp, method = "xts")
-        wp = merge(wp, xts(, index(Rp)))
-        wp = na.locf(wp)
-        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)) 
-            wp = wp
-        } else{
-            wp = wp[2:nrow(wp)]
-        }
+      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))
+      }
+      wp = checkData(wp, method = "xts")
+      wp = merge(wp, xts(, index(Rp)))
+      wp = na.locf(wp)
+      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)) 
+        wp = wp
+      } else{
+        wp = wp[2:nrow(wp)]
+      }
     }
     return(wp)
 }
@@ -87,31 +89,12 @@
     
     # If level has numeric values we replace numeric values by quintiles
     if (is.numeric(h[[level]])){
-        hnew = h[[level]]
-        quintiles = quantile(h[[level]], c(0, 0.2, 0.4, 0.6, 0.8, 1))
-        for (i in 1:length(h[[level]])){
-            if (h[[level]][i] >= quintiles[1] & h[[level]][i] < quintiles[2]){
-                hnew[i] = "Quintile 1"
-            }
-            if (h[[level]][i] >= quintiles[2] & h[[level]][i] < quintiles[3]){
-              hnew[i] = "Quintile 2"
-            }
-            if (h[[level]][i] >= quintiles[3] & h[[level]][i] < quintiles[4]){
-              hnew[i] = "Quintile 3"
-            }
-            if (h[[level]][i] >= quintiles[4] & h[[level]][i] < quintiles[5]){
-              hnew[i] = "Quintile 4"
-            }
-            if (h[[level]][i] >= quintiles[5] & h[[level]][i] <= quintiles[6]){
-              hnew[i] = "Quintile 5"
-            }
-        }
-        h[[level]] = hnew
+      h = HierarchyQuintiles(h, level)
     }
     h = split(h$primary_id, h[level])
     returns = as.xts(matrix(NA, ncol = length(h), nrow = nrow(Rp)), index(Rp))
     for(i in 1:length(h)){
-        returns[, i] = rowSums(Rp[, h[[i]]] * wp[, h[[i]]])
+      returns[, i] = rowSums(Rp[, h[[i]]] * coredata(wp[, h[[i]]]))
     }
     colnames(returns) = names(h)
     return(returns)
@@ -135,12 +118,16 @@
     # FUNCTION:
     # Transform data to the xts objects
     wp = Weight.transform(wp, Rp)
-
+    
+    # If level has numeric values we replace numeric values by quintiles
+    if (is.numeric(h[[level]])){
+      h = HierarchyQuintiles(h, level)
+    }
     h = split(h$primary_id, h[level])
     weights = wp[, 1:length(h)]
     for(i in 1:length(h)){
-        weights[, i] = rowSums(wp[, h[[i]]])
+      weights[, i] = rowSums(wp[, h[[i]]])
     }
     colnames(weights) = names(h)
     return(weights)
-}
+}
\ No newline at end of file

Modified: pkg/PortfolioAnalytics/sandbox/attribution/R/attribution.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/R/attribution.R	2012-07-06 16:35:04 UTC (rev 2114)
+++ pkg/PortfolioAnalytics/sandbox/attribution/R/attribution.R	2012-07-06 16:50:21 UTC (rev 2115)
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/returnanalytics -r 2115


More information about the Returnanalytics-commits mailing list