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

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

Author: hezkyvaron
Date: 2012-06-16 03:57:30 +0200 (Sat, 16 Jun 2012)
New Revision: 2017

Modified:
   pkg/PortfolioAnalytics/R/constraints.R
   pkg/PortfolioAnalytics/R/optimize.portfolio.R
Log:
- completed simple constraint object for using ROI and added simple if-block in optimize.portfolio to handle this constraint_ROI object.

Modified: pkg/PortfolioAnalytics/R/constraints.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraints.R	2012-06-14 22:20:45 UTC (rev 2016)
+++ pkg/PortfolioAnalytics/R/constraints.R	2012-06-16 01:57:30 UTC (rev 2017)
@@ -210,3 +210,33 @@
 }
 
 
+#' constructor for class constraint_ROI
+#' 
+#' @param assets number of assets, or optionally a named vector of assets specifying seed weights
+#' @param op.problem an object of type "OP" (optimization problem, of \code{ROI}) specifying the complete optimization problem, see ROI help pages for proper construction of OP object.
+#' @param solver string argument for what solver package to use, must have ROI plugin installed for that solver.  Currently support is for \code{\link{glpk}} and \code{\link{quadprog}}.
+#' @param weight_seq seed sequence of weights, see \code{\link{generatesequence}}
+#' @author Hezky Varon
+#' @export
+constraint_ROI <- function(assets, op.problem, solver=c("glpk", "quadprog"),
+                           weight_seq=NULL)
+{
+  if(problem == NULL) stop("Need to pass in optimiztion problem.")
+  solver <- solver[1]
+  require(solver, character.only=TRUE)
+  require(ROI, character.only=TRUE)
+  require(paste("ROI.plugin.", solver.method, sep=""), character.only=TRUE)
+  ## now structure and return
+  return(structure(
+    list(
+      assets = assets,
+      op.problem = op.problem,
+      solver = solver,
+      weight_seq = weight_seq,
+      objectives = list(),
+      call = match.call()
+    ), 
+    class=c("constraint_ROI","constraint")
+  ))
+}
+

Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R	2012-06-14 22:20:45 UTC (rev 2016)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R	2012-06-16 01:57:30 UTC (rev 2017)
@@ -35,8 +35,8 @@
 #' itermax, if not passed in dots, defaults to the number of parameters (assets/weights) *50.
 #'  
 #' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns
-#' @param constraints an object of type "constraints" specifying the constraints for the optimization, see \code{\link{constraint}}
-#' @param optimize_method one of "DEoptim" or "random"
+#' @param constraints an object of type "constraints" specifying the constraints for the optimization, see \code{\link{constraint}}, if using closed for solver, need to pass a \code{\link{constraint_ROI}} object.
+#' @param optimize_method one of "DEoptim", "random", "ROI".  For using ROI, need to use a constraint_ROI object in constraints.
 #' @param search_size integer, how many portfolios to test, default 20,000
 #' @param trace TRUE/FALSE if TRUE will attempt to return additional information on the path or portfolios searched
 #' @param \dots any other passthru parameters
@@ -236,12 +236,13 @@
     # This will take a new constraint object that is of the same structure of a 
     # ROI constraint object, but with an additional solver arg.
     # then we can do something like this
-    #
-    # roi.result <- ROI_solve(x=ROI_constraint$constraint, ROI_constraint$solver)
-    # out$weights <- roi.result$solution
-    # out$objective_measures <- roi.result$objval
-    
-  }
+    weights <- ROI_solve(x=constraints$constraint, constraints$solver)$solution
+    names(weights) <- colnames(R)
+    out$weights<-weights
+    out$objective_measures <- roi.result$objval
+    out$call<-call
+  } ## end case for ROI
+  
     end_t<-Sys.time()
     # print(c("elapsed time:",round(end_t-start_t,2),":diff:",round(diff,2), ":stats: ", round(out$stats,4), ":targets:",out$targets))
     message(c("elapsed time:",end_t-start_t))