[Returnanalytics-commits] r1983 - pkg/PortfolioAnalytics/sandbox/attribution
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jun 5 16:35:40 CEST 2012
Author: ababii
Date: 2012-06-05 16:35:39 +0200 (Tue, 05 Jun 2012)
New Revision: 1983
Added:
pkg/PortfolioAnalytics/sandbox/attribution/attrib.RData
pkg/PortfolioAnalytics/sandbox/attribution/attribution.R
Removed:
pkg/PortfolioAnalytics/sandbox/attribution/attribution.arithmetic.R
pkg/PortfolioAnalytics/sandbox/attribution/attribution.geometric.R
Modified:
pkg/PortfolioAnalytics/sandbox/attribution/attribution.levels.R
Log:
- added dataset for examples
- united arithmetic and geometric attribution functions to attribution.R
- added multiperiod support (Carino and Menchero)
Added: pkg/PortfolioAnalytics/sandbox/attribution/attrib.RData
===================================================================
(Binary files differ)
Property changes on: pkg/PortfolioAnalytics/sandbox/attribution/attrib.RData
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: pkg/PortfolioAnalytics/sandbox/attribution/attribution.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/attribution.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/attribution/attribution.R 2012-06-05 14:35:39 UTC (rev 1983)
@@ -0,0 +1,168 @@
+#' 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"),
+linking = c("carino", "menchero", "grap", "frongello", "geometric"))
+{ # @author Andrii Babii
+
+ # DESCRIPTION:
+ # This is a wrapper for attribution analysis.
+ # TODO: add GRAP and Frongello linking, Geometric attribution
+
+ # Inputs:
+ # Rp: portfolio returns
+ # wp: portfolio weights
+ # Rb: benchmark returns
+ # wb: benchmark weights
+ # method:
+
+ # Outputs:
+ # This function returns the attribution effects
+ # FUNCTION:
+
+ # 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
+ allocation = cbind(allocation, rowSums(allocation)) # Total allocation effect for each period
+ names(allocation)[ncol(allocation)] = "Total"
+ selection = wb * (Rp - Rb)
+ selection = cbind(selection, rowSums(selection)) # Total selection effect for each period
+ names(selection)[ncol(selection)] = "Total"
+ interaction = (wp - wb) * (Rp - Rb)
+ interaction = cbind(interaction, rowSums(interaction)) # Total interaction effect for each period
+ names(interaction)[ncol(interaction)] = "Total"
+
+
+ # Get aggregated 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
+
+ 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)
+ for(i in 1:ncol(allocation)){
+ allocation[, i] = allocation[, i] * kt / k
+ selection[, i] = selection[, i] * kt / k
+ interaction[, i] = interaction[, i] * kt / k
+ }
+ }
+
+ 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)
+ for(i in 1:ncol(allocation)){
+ allocation[, i] = allocation[, i] * (M + at)
+ selection[, i] = selection[, i] * (M + at)
+ interaction[, i] = interaction[, i] * (M + at)
+ }
+ }
+
+ if(linking == "grap"){
+ # GRAP linking
+
+ }
+
+ if(linking == "frongello"){
+ # Frongello linking
+
+ }
+
+ if(linking == "geometric"){
+ k = (log(1 + Rp) - log(1 + Rb)) / (Rp - Rb)
+ allocation = exp(allocation * k) - 1
+ selection = exp(selection * k) - 1
+ interaction = exp(interaction * k) - 1
+ }
+
+ # Get attribution effects for the whole period
+ allocation = as.data.frame(allocation)
+ allocation = rbind(allocation, colSums(allocation))
+ rownames(allocation)[nrow(allocation)] = "Total"
+ selection = as.data.frame(selection)
+ selection = rbind(selection, colSums(selection))
+ rownames(selection)[nrow(selection)] = "Total"
+ interaction = as.data.frame(interaction)
+ interaction = rbind(interaction, colSums(interaction))
+ rownames(interaction)[nrow(interaction)] = "Total"
+ total = as.data.frame(total)
+ total = rbind(total, colSums(total))
+ rownames(total)[nrow(total)] = "Total"
+ total = allocation + selection + interaction
+
+ # Select the appropriate result corresponding to the chosen method
+ result = list()
+ result[[1]] = allocation
+ result[[2]] = selection
+ result[[3]] = total
+ if(method == "top.down"){ # Top-down attribution
+ result[[2]] = result[[2]] + interaction
+ }
+ if(method == "bottom.up"){ # Bottom-up attribution
+ result[[1]] = result[[1]] + interaction
+ }
+ if(method == "simple"){
+ result[[4]] = result[[3]]
+ result[[3]] = interaction
+ }
+
+
+ # Label the output
+ if(method == "simple"){
+ names(result) = c("Allocation", "Selection", "Interaction", "Total")
+ } else{
+ names(result) = c("Allocation", "Selection", "Total")
+ }
+ return(result)
+}
+
+#EXAMPLE:
+data(attrib) # !!! Load attrib.RData workspace
+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.arithmetic(Rp, wp, Rb, wb, method = "top.down", linking = "carino")
+attribution.arithmetic(Rp, wp, Rb, wb, method = "bottom.up", linking = "menchero")
+attribution.arithmetic(Rp, wp, Rb, wb, method = "simple", linking = "carino")
+
+#' @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/PortfolioAnalytics/sandbox/attribution/attribution.arithmetic.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/attribution.arithmetic.R 2012-06-05 06:46:16 UTC (rev 1982)
+++ pkg/PortfolioAnalytics/sandbox/attribution/attribution.arithmetic.R 2012-06-05 14:35:39 UTC (rev 1983)
@@ -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/PortfolioAnalytics/sandbox/attribution/attribution.geometric.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/attribution.geometric.R 2012-06-05 06:46:16 UTC (rev 1982)
+++ pkg/PortfolioAnalytics/sandbox/attribution/attribution.geometric.R 2012-06-05 14:35:39 UTC (rev 1983)
@@ -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
Modified: pkg/PortfolioAnalytics/sandbox/attribution/attribution.levels.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/attribution/attribution.levels.R 2012-06-05 06:46:16 UTC (rev 1982)
+++ pkg/PortfolioAnalytics/sandbox/attribution/attribution.levels.R 2012-06-05 14:35:39 UTC (rev 1983)
@@ -78,21 +78,7 @@
}
# 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)
- }
-}
+data(attrib) # !!! Load attrib.RData workspace
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)
More information about the Returnanalytics-commits
mailing list