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

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

Author: rossbennett34
Date: 2013-06-28 05:43:03 +0200 (Fri, 28 Jun 2013)
New Revision: 2458

Modified:
   pkg/PortfolioAnalytics/R/constrained_objective.R
   pkg/PortfolioAnalytics/R/constraints.R
Log:
Added names to constraint classes. Changed penalty for turnover_objective target.

Modified: pkg/PortfolioAnalytics/R/constrained_objective.R
===================================================================
--- pkg/PortfolioAnalytics/R/constrained_objective.R	2013-06-27 23:09:58 UTC (rev 2457)
+++ pkg/PortfolioAnalytics/R/constrained_objective.R	2013-06-28 03:43:03 UTC (rev 2458)
@@ -256,7 +256,13 @@
               # I would expect this to be the same result when multiplier=0, but it is not.
               # max(tmp_measure - objective$target, 0) should equal 0 when tmp_measure is less than objective$target
               # print(max(tmp_measure - objective$target, 0))
-              out = out + penalty * objective$multiplier * max(tmp_measure - objective$target, 0)
+              # Only penalize if tmp_measure violates target to the upside
+              # if(tmp_measure > objective$target) {
+              #  print(tmp_measure)
+              #  out = out + penalty*abs(objective$multiplier)*abs(tmp_measure-objective$target)
+              # }
+              # out = out + penalty * objective$multiplier * max(tmp_measure - objective$target, 0)
+              out = out + penalty*abs(objective$multiplier)*abs(tmp_measure-objective$target)
             }  
             # target is null or doesn't exist, just maximize, or minimize violation of constraint
             out = out + abs(objective$multiplier)*tmp_measure

Modified: pkg/PortfolioAnalytics/R/constraints.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraints.R	2013-06-27 23:09:58 UTC (rev 2457)
+++ pkg/PortfolioAnalytics/R/constraints.R	2013-06-28 03:43:03 UTC (rev 2458)
@@ -336,7 +336,7 @@
     max[which(tmp_max < max)] <- tmp_max[which(tmp_max < max)]
   }
   
-  Constraint <- constraint_v2(type=type, enabled=enabled, ...)
+  Constraint <- constraint_v2(type=type, enabled=enabled, constrclass="box_constraint", ...)
   Constraint$min <- min
   Constraint$max <- max
   return(Constraint)
@@ -378,7 +378,7 @@
   }
   if (length(group_max) != ngroups) stop(paste("length of group_max must be equal to 1 or the length of groups:", ngroups))
   
-  Constraint <- constraint_v2(type, enabled=enabled, ...)
+  Constraint <- constraint_v2(type, enabled=enabled, constrclass="group_constraint", ...)
   Constraint$groups <- groups
   Constraint$cLO <- group_min
   Constraint$cUP <- group_max
@@ -398,7 +398,7 @@
 #' @author Ross Bennett
 #' @export
 weight_sum_constraint <- function(type, min_sum=0.99, max_sum=1.01, enabled=FALSE, ...){
-  Constraint <- constraint_v2(type, enabled=enabled, ...)
+  Constraint <- constraint_v2(type, enabled=enabled, constrclass="weight_sum_constraint", ...)
   Constraint$min_sum <- min_sum
   Constraint$max_sum <- max_sum
   return(Constraint)
@@ -493,7 +493,7 @@
 #' @author Ross Bennett
 #' @export
 turnover_constraint <- function(type, max.turnover, enabled=FALSE, ...){
-  Constraint <- constraint_v2(type, enabled=enabled, ...)
+  Constraint <- constraint_v2(type, enabled=enabled, constrclass="turnover_constraint", ...)
   Constraint$toc <- max.turnover
   return(Constraint)
 }
@@ -509,7 +509,7 @@
 #' @author Ross Bennett
 #' @export
 diversification_constraint <- function(type, div.target, enabled=FALSE, ...){
-  Constraint <- constraint_v2(type, enabled=enabled, ...)
+  Constraint <- constraint_v2(type, enabled=enabled, constrclass="diversification_constraint", ...)
   Constraint$div <- div.target
   return(Constraint)
 }
@@ -528,7 +528,7 @@
 #' @author Ross Bennett
 #' @export
 volatility_constraint <- function(type, min.vol, max.vol, enabled=FALSE, ...){
-  Constraint <- constraint_v2(type, enabled=enabled, ...)
+  Constraint <- constraint_v2(type, enabled=enabled, constrclass="volatility_constraint", ...)
   Constraint$min.vol <- min.vol
   Constraint$max.vol <- max.vol
   return(Constraint)