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

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

Author: rossbennett34
Date: 2013-10-04 02:57:54 +0200 (Fri, 04 Oct 2013)
New Revision: 3204

Modified:
   pkg/PortfolioAnalytics/R/charts.DE.R
   pkg/PortfolioAnalytics/R/charts.GenSA.R
   pkg/PortfolioAnalytics/R/charts.PSO.R
   pkg/PortfolioAnalytics/R/charts.ROI.R
   pkg/PortfolioAnalytics/R/charts.RP.R
Log:
Modifying chart.Scatter.* to use the arguments from the portfolio slot to calculate risk and return metrics for the assets.

Modified: pkg/PortfolioAnalytics/R/charts.DE.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.DE.R	2013-10-04 00:04:21 UTC (rev 3203)
+++ pkg/PortfolioAnalytics/R/charts.DE.R	2013-10-04 00:57:54 UTC (rev 3204)
@@ -155,10 +155,19 @@
   # print(colnames(head(xtract)))
   
   if(chart.assets){
+    # Get the arguments from the optimize.portfolio$portfolio object
+    # to calculate the risk and return metrics for the scatter plot. 
+    # (e.g. arguments=list(p=0.925, clean="boudt")
+    arguments <- NULL # maybe an option to let the user pass in an arguments list?
+    if(is.null(arguments)){
+      tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE)
+      tmp.args <- tmp.args[!duplicated(names(tmp.args))]
+      if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single"
+      arguments <- tmp.args
+    }
     # Include risk reward scatter of asset returns
-    asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...)
-    asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...)
-    rnames <- colnames(R)
+    asset_ret <- scatterFUN(R=R, FUN=return.col, arguments)
+    asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments)
     xlim <- range(c(xtract[,risk.column], asset_risk))
     ylim <- range(c(xtract[,return.column], asset_ret))
   } else {

Modified: pkg/PortfolioAnalytics/R/charts.GenSA.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.GenSA.R	2013-10-04 00:04:21 UTC (rev 3203)
+++ pkg/PortfolioAnalytics/R/charts.GenSA.R	2013-10-04 00:57:54 UTC (rev 3204)
@@ -99,14 +99,20 @@
   # cbind the optimal weights and random portfolio weights
   rp <- rbind(wts, rp)
   
-  returnpoints <- applyFUN(R=R, weights=rp, FUN=return.col, ...=...)
-  riskpoints <- applyFUN(R=R, weights=rp, FUN=risk.col, ...=...)
+  # Get the arguments from the optimize.portfolio$portfolio object
+  # to calculate the risk and return metrics for the scatter plot
+  tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE)
+  tmp.args <- tmp.args[!duplicated(names(tmp.args))]
+  if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single"
+  arguments <- tmp.args
   
+  returnpoints <- applyFUN(R=R, weights=rp, FUN=return.col, arguments)
+  riskpoints <- applyFUN(R=R, weights=rp, FUN=risk.col, arguments)
+  
   if(chart.assets){
     # Include risk reward scatter of asset returns
-    asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...)
-    asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...)
-    rnames <- colnames(R)
+    asset_ret <- scatterFUN(R=R, FUN=return.col, arguments)
+    asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments)
   } else {
     asset_ret <- NULL
     asset_risk <- NULL

Modified: pkg/PortfolioAnalytics/R/charts.PSO.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.PSO.R	2013-10-04 00:04:21 UTC (rev 3203)
+++ pkg/PortfolioAnalytics/R/charts.PSO.R	2013-10-04 00:57:54 UTC (rev 3204)
@@ -135,10 +135,19 @@
     }
   }
   if(chart.assets){
+    # Get the arguments from the optimize.portfolio$portfolio object
+    # to calculate the risk and return metrics for the scatter plot. 
+    # (e.g. arguments=list(p=0.925, clean="boudt")
+    arguments <- NULL # maybe an option to let the user pass in an arguments list?
+    if(is.null(arguments)){
+      tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE)
+      tmp.args <- tmp.args[!duplicated(names(tmp.args))]
+      if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single"
+      arguments <- tmp.args
+    }
     # Include risk reward scatter of asset returns
-    asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...)
-    asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...)
-    rnames <- colnames(R)
+    asset_ret <- scatterFUN(R=R, FUN=return.col, arguments)
+    asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments)
     xlim <- range(c(xtract[,risk.column], asset_risk))
     ylim <- range(c(xtract[,return.column], asset_ret))
   } else {

Modified: pkg/PortfolioAnalytics/R/charts.ROI.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.ROI.R	2013-10-04 00:04:21 UTC (rev 3203)
+++ pkg/PortfolioAnalytics/R/charts.ROI.R	2013-10-04 00:57:54 UTC (rev 3204)
@@ -100,14 +100,20 @@
   # cbind the optimal weights and random portfolio weights
   rp <- rbind(wts, rp)
   
-  returnpoints <- applyFUN(R=R, weights=rp, FUN=return.col, ...=...)
-  riskpoints <- applyFUN(R=R, weights=rp, FUN=risk.col, ...=...)
+  # Get the arguments from the optimize.portfolio$portfolio object
+  # to calculate the risk and return metrics for the scatter plot
+  tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE)
+  tmp.args <- tmp.args[!duplicated(names(tmp.args))]
+  if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single"
+  arguments <- tmp.args
   
+  returnpoints <- applyFUN(R=R, weights=rp, FUN=return.col, arguments)
+  riskpoints <- applyFUN(R=R, weights=rp, FUN=risk.col, arguments)
+  
   if(chart.assets){
   # Include risk reward scatter of asset returns
-  asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...)
-  asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...)
-  rnames <- colnames(R)
+  asset_ret <- scatterFUN(R=R, FUN=return.col, arguments)
+  asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments)
   } else {
     asset_ret <- NULL
     asset_risk <- NULL

Modified: pkg/PortfolioAnalytics/R/charts.RP.R
===================================================================
--- pkg/PortfolioAnalytics/R/charts.RP.R	2013-10-04 00:04:21 UTC (rev 3203)
+++ pkg/PortfolioAnalytics/R/charts.RP.R	2013-10-04 00:57:54 UTC (rev 3204)
@@ -155,10 +155,19 @@
   # print(colnames(head(xtract)))
   
   if(chart.assets){
+    # Get the arguments from the optimize.portfolio$portfolio object
+    # to calculate the risk and return metrics for the scatter plot. 
+    # (e.g. arguments=list(p=0.925, clean="boudt")
+    arguments <- NULL # maybe an option to let the user pass in an arguments list?
+    if(is.null(arguments)){
+      tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE)
+      tmp.args <- tmp.args[!duplicated(names(tmp.args))]
+      if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single"
+      arguments <- tmp.args
+    }
     # Include risk reward scatter of asset returns
-    asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...)
-    asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...)
-    rnames <- colnames(R)
+    asset_ret <- scatterFUN(R=R, FUN=return.col, arguments)
+    asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments)
     xlim <- range(c(xtract[,risk.column], asset_risk))
     ylim <- range(c(xtract[,return.column], asset_ret))
   } else {