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

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

Author: rossbennett34
Date: 2013-08-18 21:54:43 +0200 (Sun, 18 Aug 2013)
New Revision: 2820

Modified:
   pkg/PortfolioAnalytics/R/constrained_objective.R
   pkg/PortfolioAnalytics/R/extractstats.R
   pkg/PortfolioAnalytics/R/generics.R
   pkg/PortfolioAnalytics/R/optimize.portfolio.R
Log:
 - add objective_measures as a slot returned by optimize.portfolio for optimize_method=ROI \n - add the returns object as a slot returned by optimize.portfolio \n - add ETL and mETL as aliases for the ES function in constrained_objective \n - fixing print method for optimize.portfolio objects

Modified: pkg/PortfolioAnalytics/R/constrained_objective.R
===================================================================
--- pkg/PortfolioAnalytics/R/constrained_objective.R	2013-08-18 14:02:14 UTC (rev 2819)
+++ pkg/PortfolioAnalytics/R/constrained_objective.R	2013-08-18 19:54:43 UTC (rev 2820)
@@ -542,6 +542,8 @@
                mES =,
                CVaR =,
                cVaR =,
+               ETL=,
+               mETL=,
                ES = {
                  fun = match.fun(ES)
                  if(!inherits(objective,"risk_budget_objective") & is.null(objective$arguments$portfolio_method)& is.null(nargs$portfolio_method)) nargs$portfolio_method='single'

Modified: pkg/PortfolioAnalytics/R/extractstats.R
===================================================================
--- pkg/PortfolioAnalytics/R/extractstats.R	2013-08-18 14:02:14 UTC (rev 2819)
+++ pkg/PortfolioAnalytics/R/extractstats.R	2013-08-18 19:54:43 UTC (rev 2820)
@@ -346,13 +346,8 @@
 #' @export
 extractObjectiveMeasures <- function(object){
   if(!inherits(object, "optimize.portfolio")) stop("object must be of class 'optimize.portfolio'")
-  if(inherits(object, "optimize.portfolio.ROI")){
-    # objective measures returned as $out for ROI solvers
-    out <- object$out
-  } else {
-    # objective measures returned as $objective_measures for all other solvers
-    out <- object$objective_measures
-  }
+  # objective measures returned as $objective_measures for all other solvers
+  out <- object$objective_measures
   return(out)
 }
 

Modified: pkg/PortfolioAnalytics/R/generics.R
===================================================================
--- pkg/PortfolioAnalytics/R/generics.R	2013-08-18 14:02:14 UTC (rev 2819)
+++ pkg/PortfolioAnalytics/R/generics.R	2013-08-18 19:54:43 UTC (rev 2820)
@@ -249,8 +249,14 @@
   cat("\n")
   
   # get objective measure
+  objective_measures <- object$objective_measures
+  tmp_obj <- as.numeric(unlist(objective_measures))
+  names(tmp_obj) <- names(objective_measures)
   cat("Objective Measure:\n")
-  print(as.numeric(object$out), digits=digits)
+  for(i in 1:length(objective_measures)){
+    print(tmp_obj[i], digits=4)
+    cat("\n")
+  }
   cat("\n")
 }
 

Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R	2013-08-18 14:02:14 UTC (rev 2819)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R	2013-08-18 19:54:43 UTC (rev 2820)
@@ -696,31 +696,36 @@
     if("var" %in% names(moments)){
       # Minimize variance if the only objective specified is variance
       # Maximize Quadratic Utility if var and mean are specified as objectives
-      out <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target)
-      out$call <- call
+      roi_result <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target)
+      weights <- roi_result$weights
+      out <- list(weights=weights, objective_measures=suppressWarnings(constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures), out=roi_result$out, call=call)
     }
     if(length(names(moments)) == 1 & "mean" %in% names(moments)) {
       # Maximize return if the only objective specified is mean
       if(!is.null(constraints$max_pos)) {
         # This is an MILP problem if max_pos is specified as a constraint
-        out <- maxret_milp_opt(R=R, constraints=constraints, moments=moments, target=target)
-        out$call <- call
+        roi_result <- maxret_milp_opt(R=R, constraints=constraints, moments=moments, target=target)
+        weights <- roi_result$weights
+        out <- list(weights=weights, objective_measures=constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures, out=roi_result$out, call=call)
       } else {
         # Maximize return LP problem
-        out <- maxret_opt(R=R, constraints=constraints, moments=moments, target=target)
-        out$call <- call
+        roi_result <- maxret_opt(R=R, constraints=constraints, moments=moments, target=target)
+        weights <- roi_result$weights
+        out <- list(weights=weights, objective_measures=constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures, out=roi_result$out, call=call)
       }
     }
     if( any(c("CVaR", "ES", "ETL") %in% names(moments)) ) {
       # Minimize sample ETL/ES/CVaR if CVaR, ETL, or ES is specified as an objective
       if(!is.null(constraints$max_pos)) {
         # This is an MILP problem if max_pos is specified as a constraint
-        out <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha)
-        out$call <- call
+        roi_result <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha)
+        weights <- roi_result$weights
+        out <- list(weights=weights, objective_measures=constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures, out=roi_result$out, call=call)
       } else {
         # Minimize sample ETL/ES/CVaR LP Problem
-        out <- etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha)
-        out$call <- call
+        roi_result <- etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha)
+        weights <- roi_result$weights
+        out <- list(weights=weights, objective_measures=constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures, out=roi_result$out, call=call)
       }
     }
   } ## end case for ROI
@@ -821,6 +826,7 @@
   # print(c("elapsed time:",round(end_t-start_t,2),":diff:",round(diff,2), ":stats: ", round(out$stats,4), ":targets:",out$targets))
   if(message) message(c("elapsed time:", end_t-start_t))
   out$portfolio <- portfolio
+  out$R <- R
   out$data_summary <- list(first=first(R), last=last(R))
   out$elapsed_time <- end_t - start_t
   out$end_t <- as.character(Sys.time())