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

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

Author: rossbennett34
Date: 2013-08-26 20:12:59 +0200 (Mon, 26 Aug 2013)
New Revision: 2893

Modified:
   pkg/PortfolioAnalytics/R/constrained_objective.R
Log:
modifying group constraint penalty block in constrained_objective to work with groups being specified as a list.

Modified: pkg/PortfolioAnalytics/R/constrained_objective.R
===================================================================
--- pkg/PortfolioAnalytics/R/constrained_objective.R	2013-08-26 17:50:35 UTC (rev 2892)
+++ pkg/PortfolioAnalytics/R/constrained_objective.R	2013-08-26 18:12:59 UTC (rev 2893)
@@ -420,23 +420,15 @@
     # Only go to penalty term if group constraint is violated
     if(any(group_fail(w, groups, cLO, cUP))){
       ngroups <- length(groups)
-      k <- 1
-      l <- 0
       for(i in 1:ngroups){
-        j <- groups[i]
-        tmp_w <- w[k:(l+j)]
-        # penalize weights for a given group that sum to less than specified group min
-        grp_min <- cLO[i]
-        if(sum(tmp_w) < grp_min) {
-          out <- out + penalty * (grp_min - sum(tmp_w))
+        tmp_w <- w[groups[[i]]]
+        # penalize for weights that are below cLO
+        if(sum(tmp_w) < cLO[i]){
+          out <- out + penalty * (cLO[i] - sum(tmp_w))
         }
-        # penalize weights for a given group that sum to greater than specified group max
-        grp_max <- cUP[i]
-        if(sum(tmp_w) > grp_max) {
-          out <- out + penalty * (sum(tmp_w) - grp_max)
+        if(sum(tmp_w) > cUP[i]){
+          out <- out + penalty * (sum(tmp_w) - cUP[i])
         }
-        k <- k + j
-        l <- k - 1
       }
     }
   } # End group constraint penalty