[Returnanalytics-commits] r3399 - pkg/PortfolioAnalytics/R

[noreply at r-forge.r-project.org]

Author: rossbennett34
Date: 2014-05-28 07:30:52 +0200 (Wed, 28 May 2014)
New Revision: 3399

Modified:
   pkg/PortfolioAnalytics/R/charts.risk.R
   pkg/PortfolioAnalytics/R/extractstats.R
Log:
Adding support for risk budget charts with regime switching

Modified: pkg/PortfolioAnalytics/R/charts.risk.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.risk.R	2014-05-27 21:31:20 UTC (rev 3398)
+++ pkg/PortfolioAnalytics/R/charts.risk.R	2014-05-28 05:30:52 UTC (rev 3399)
@@ -21,12 +21,15 @@
 #' should contain properly named contribution and pct_contrib columns. 
 #' 
 #' @param object optimal portfolio object created by \code{\link{optimize.portfolio}}
+#' or \code{\link{optimize.portfolio.rebalancing}}
 #' @param \dots any other passthru parameters to \code{\link{plot}}
 #' @param neighbors risk contribution or pct_contrib of neighbor portfolios to be plotted, see Details.
 #' @param match.col string of risk column to match. The \code{opt.list} object 
 #' may contain risk budgets for ES or StdDev and this will match the proper 
 #' column names of the objectives list outp (e.g. ES.contribution).
 #' @param risk.type "absolute" or "percentage" to plot risk contribution in absolute terms or percentage contribution.
+#' @param regime integer of the regime number. For use with 
+#' \code{\link{optimize.portfolio.rebalancing}} run with regime switching portfolios.
 #' @param main main title for the chart.
 #' @param plot.type "line" or "barplot".
 #' @param ylab label for the y-axis.
@@ -212,11 +215,20 @@
 #' @rdname chart.RiskBudget
 #' @method chart.RiskBudget optimize.portfolio.rebalancing
 #' @S3method chart.RiskBudget optimize.portfolio.rebalancing
-chart.RiskBudget.optimize.portfolio.rebalancing <- function(object, ..., match.col="ES", risk.type="absolute", main="Risk Contribution"){
+chart.RiskBudget.optimize.portfolio.rebalancing <- function(object, ..., match.col="ES", risk.type="absolute", regime=NULL, main="Risk Contribution"){
   
   # Get the objective measures at each rebalance period
   rebal.obj <- extractObjectiveMeasures(object)
   
+  if(inherits(opt.rebal$portfolio, "regime.portfolios")){
+    # If the optimize.portfolio.rebalancing object is run with regime switching,
+    # the output of extractObjectiveMeasures is a list of length N where each
+    # element is the objective measures of the corresponding regime. (i.e.
+    # rebal.obj[[1]] is the objective measures for portfolio 1 with regime 1)
+    if(is.null(regime)) regime=1
+    rebal.obj <- rebal.obj[[regime]]
+  }
+  
   if(risk.type == "absolute"){
     rbcols <- grep(paste(match.col, "contribution", sep="."), colnames(rebal.obj))
     if(length(rbcols) < 1) stop(paste("No ", match.col, ".contribution columns.", sep=""))

Modified: pkg/PortfolioAnalytics/R/extractstats.R
===================================================================
--- pkg/PortfolioAnalytics/R/extractstats.R	2014-05-27 21:31:20 UTC (rev 3398)
+++ pkg/PortfolioAnalytics/R/extractstats.R	2014-05-28 05:30:52 UTC (rev 3399)
@@ -519,11 +519,13 @@
 # contains the objective measures for a given regime
 extractObjRegime <- function(object){
   tmp.regimes <- unlist(lapply(object$opt_rebalancing, function(x) x$regime))
-  unique.regimes <- unique(tmp.regimes)
+  unique.regimes <- sort(unique(tmp.regimes))
+  #print(tmp.regimes)
+  #print(unique.regimes)
   
   # Initialize a list to hold the objective measures for each regime
   out.list <- vector("list", length(unique.regimes))
-  names(out.list) <- paste("regime", 1:length(unique.regimes), sep=".")
+  names(out.list) <- paste("regime", unique.regimes, sep=".")
   
   # Outer loop over each regime
   for(i in 1:length(unique.regimes)){
@@ -544,7 +546,7 @@
     colnames(obj) <- PortfolioAnalytics:::name.replace(colnames(obj))
     obj <- xts(obj, as.Date(names(tmp.idx)))
     # insert the objective measures into the list
-    out.list[[i]] <- obj
+    out.list[[unique.regimes[i]]] <- obj
   }
   out.list
 }