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

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

Author: rossbennett34
Date: 2013-10-23 01:45:22 +0200 (Wed, 23 Oct 2013)
New Revision: 3237

Modified:
   pkg/PortfolioAnalytics/R/extract.efficient.frontier.R
   pkg/PortfolioAnalytics/R/optFUN.R
Log:
minor fixes to gmv_opt and meanvar.efficient.frontier

Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R
===================================================================
--- pkg/PortfolioAnalytics/R/extract.efficient.frontier.R	2013-10-22 23:43:37 UTC (rev 3236)
+++ pkg/PortfolioAnalytics/R/extract.efficient.frontier.R	2013-10-22 23:45:22 UTC (rev 3237)
@@ -109,7 +109,7 @@
   }
   
   # for a mean-var efficient frontier, there must be two objectives 1) "mean" and 2) "var"
-  if(!((length(objnames) >= 2) & ("var" %in% objnames) & ("mean" %in% objnames))){
+  if(!((length(objnames) >= 2) & ("var" %in% objnames | "StdDev" %in% objnames | "sd" %in% objnames) & ("mean" %in% objnames))){
     stop("The portfolio object must have both 'mean' and 'var' specified as objectives")
   }
   
@@ -121,7 +121,7 @@
   }
   
   # get the index number of the var objective 
-  var_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == "var")
+  var_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name))  %in% c("var", "StdDev", "sd"))
   # get the index number of the mean objective
   mean_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == "mean")
   

Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R	2013-10-22 23:43:37 UTC (rev 3236)
+++ pkg/PortfolioAnalytics/R/optFUN.R	2013-10-22 23:45:22 UTC (rev 3237)
@@ -29,7 +29,6 @@
       tmp_means <- colMeans(R)
     } else {
       tmp_means <- moments$mean
-      target <- 0
     }
   } else {
     tmp_means <- rep(0, N)
@@ -93,7 +92,7 @@
     if(length(lambda_hhi) == 1 & is.null(conc_groups)){
       # ROI_objective <- Q_objective(Q=2*lambda*(moments$var + lambda_hhi * diag(N)), L=-moments$mean) # ROI
       Dmat <- 2*lambda*(moments$var + lambda_hhi * diag(N)) # solve.QP
-      dvec <- -moments$mean # solve.QP
+      dvec <- moments$mean # solve.QP
     } else if(!is.null(conc_groups)){
       # construct the matrix with concentration aversion values by group
       hhi_mat <- matrix(0, nrow=N, ncol=N)
@@ -109,12 +108,12 @@
       }
       # ROI_objective <- Q_objective(Q=2*lambda*(moments$var + hhi_mat), L=-moments$mean) # ROI
       Dmat <- 2 * lambda * (moments$var + hhi_mat) # solve.QP
-      dvec <- -moments$mean # solve.QP
+      dvec <- moments$mean # solve.QP
     }
   } else {
     # ROI_objective <- Q_objective(Q=2*lambda*moments$var, L=-moments$mean) # ROI
     Dmat <- 2 * lambda * moments$var # solve.QP
-    dvec <- -moments$mean # solve.QP
+    dvec <- moments$mean # solve.QP
   }
   # set up the optimization problem and solve
   # opt.prob <- OP(objective=ROI_objective, 
@@ -560,7 +559,6 @@
       tmp_means <- colMeans(R)
     } else {
       tmp_means <- moments$mean
-      target <- 0
     }
   } else {
     tmp_means <- moments$mean
@@ -900,7 +898,7 @@
   fmean <- matrix(moments$mean, ncol=1)
   
   # Find the maximum return
-  max_ret <- PortfolioAnalytics:::maxret_opt(R=R, moments=moments, constraints=constraints, target=NA)
+  max_ret <- maxret_opt(R=R, moments=moments, constraints=constraints, target=NA)
   max_mean <- as.numeric(-max_ret$out)
   
   # Calculate the sr at the maximum mean return portfolio
@@ -911,7 +909,7 @@
   ub_sr <- ub_mean / ub_sd
   
   # Calculate the sr at the miminum var portfolio
-  lb_sr <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=NA, lambda_hhi=lambda_hhi, conc_groups=conc_groups)
+  lb_sr <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=NA, lambda_hhi=lambda_hhi, conc_groups=conc_groups)
   lb_weights <- matrix(lb_sr$weights)
   lb_mean <- as.numeric(t(lb_weights) %*% fmean)
   lb_sd <- as.numeric(sqrt(t(lb_weights) %*% moments$var %*% lb_weights))
@@ -925,7 +923,7 @@
     
     # Find the starr at the mean return midpoint
     new_ret <- (lb_mean + ub_mean) / 2
-    mid <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups)
+    mid <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups)
     mid_weights <- matrix(mid$weights, ncol=1)
     mid_mean <- as.numeric(t(mid_weights) %*% fmean)
     mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights))
@@ -941,7 +939,7 @@
       ub_mean <- mid_mean
       ub_sr <- mid_sr
       new_ret <- (lb_mean + ub_mean) / 2
-      mid <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups)
+      mid <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups)
       mid_weights <- matrix(mid$weights, ncol=1)
       mid_mean <- as.numeric(t(mid_weights) %*% fmean)
       mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights))
@@ -951,7 +949,7 @@
       lb_mean <- mid_mean
       lb_sr <- mid_sr
       new_ret <- (lb_mean + ub_mean) / 2
-      mid <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups)
+      mid <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups)
       mid_weights <- matrix(mid$weights, ncol=1)
       mid_mean <- as.numeric(t(mid_weights) %*% fmean)
       mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights))