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

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

Author: rossbennett34
Date: 2013-07-31 22:12:51 +0200 (Wed, 31 Jul 2013)
New Revision: 2687

Modified:
   pkg/PortfolioAnalytics/R/optFUN.R
   pkg/PortfolioAnalytics/R/optimize.portfolio.R
Log:
modifying the way moments is calculated in optimize.portfolio for optimize_method=ROI

Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R	2013-07-31 18:54:23 UTC (rev 2686)
+++ pkg/PortfolioAnalytics/R/optFUN.R	2013-07-31 20:12:51 UTC (rev 2687)
@@ -1,6 +1,7 @@
 
 ##### GMV and QU QP Function #####
 gmv_opt <- function(R, constraints, moments, lambda, target){
+  
   N <- ncol(R)
   # Applying box constraints
   bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)),
@@ -57,11 +58,12 @@
 
 ##### Maximize Return LP Function #####
 maxret_opt <- function(R, moments, constraints, target){
+  
   N <- ncol(R)
   # Applying box constraints
   bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)),
                upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max)))
-  print(bnds)
+  
   # set up initial A matrix for leverage constraints
   Amat <- rbind(rep(1, N), rep(1, N))
   dir.vec <- c(">=","<=")
@@ -95,12 +97,14 @@
   
   # set up the linear objective
   ROI_objective <- L_objective(L=-moments$mean)
+  # objL <- -moments$mean
   
   # set up the optimization problem and solve
   opt.prob <- OP(objective=ROI_objective, 
-                       constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec),
-                       bounds=bnds)
+                 constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec),
+                 bounds=bnds)
   roi.result <- ROI_solve(x=opt.prob, solver="glpk")
+  # roi.result <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir.vec, rhs=rhs.vec, bounds=bnds)
   
   # The Rglpk solvers status returns an an integer with status information
   # about the solution returned: 0 if the optimal solution was found, a 
@@ -121,6 +125,7 @@
 
 ##### Maximize Return MILP Function #####
 maxret_milp_opt <- function(R, constraints, moments, target){
+  
   N <- ncol(R)
   
   max_pos <- constraints$max_pos
@@ -205,6 +210,7 @@
 
 ##### Minimize ETL LP Function #####
 etl_opt <- function(R, constraints, moments, target, alpha){
+  
   N <- ncol(R)
   T <- nrow(R)
   # Applying box constraints

Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R	2013-07-31 18:54:23 UTC (rev 2686)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R	2013-07-31 20:12:51 UTC (rev 2687)
@@ -304,7 +304,13 @@
       if(objective$enabled){
         if(!any(c(objective$name == "mean", objective$name == "var", objective$name == "CVaR")))
           stop("ROI only solves mean, var, or sample CVaR type business objectives, choose a different optimize_method.")
-        moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE)
+        # I'm not sure what changed, but moments$mean used to be a vector of the column means
+        # now it is a scalar value of the mean of the entire R object
+        if(objective$name == "mean"){
+          moments[[objective$name]] <- try(as.vector(apply(R, 2, "mean", na.rm=TRUE)), silent=TRUE)
+        } else {
+          moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE)
+        }
         target <- ifelse(!is.null(objective$target),objective$target, target)
         alpha <- ifelse(!is.null(objective$alpha), objective$alpha, alpha)
         lambda <- ifelse(!is.null(objective$risk_aversion), objective$risk_aversion, 1)
@@ -775,7 +781,13 @@
       if(objective$enabled){
         if(!any(c(objective$name == "mean", objective$name == "var", objective$name == "CVaR", objective$name == "ES", objective$name == "ETL")))
           stop("ROI only solves mean, var, or sample ETL/ES/CVaR type business objectives, choose a different optimize_method.")
-        moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE)
+        # I'm not sure what changed, but moments$mean used to be a vector of the column means
+        # now it is a scalar value of the mean of the entire R object
+        if(objective$name == "mean"){
+          moments[[objective$name]] <- try(as.vector(apply(R, 2, "mean", na.rm=TRUE)), silent=TRUE)
+        } else {
+          moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE)
+        }
         target <- ifelse(!is.null(objective$target), objective$target, target)
         alpha <- ifelse(!is.null(objective$alpha), objective$alpha, alpha)
         lambda <- ifelse(!is.null(objective$risk_aversion), objective$risk_aversion, lambda)