[Returnanalytics-commits] r2767 - in pkg/PortfolioAnalytics: . R man

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

Author: rossbennett34
Date: 2013-08-12 05:14:38 +0200 (Mon, 12 Aug 2013)
New Revision: 2767

Added:
   pkg/PortfolioAnalytics/man/return_constraint.Rd
Modified:
   pkg/PortfolioAnalytics/NAMESPACE
   pkg/PortfolioAnalytics/R/constrained_objective.R
   pkg/PortfolioAnalytics/R/constraints.R
   pkg/PortfolioAnalytics/R/optimize.portfolio.R
Log:
adding functionality to specify target return as a constraint per conversations with Doug. Target return can now be specified both as an objective, just as it has always been, and as a constraint.

Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE	2013-08-11 12:23:23 UTC (rev 2766)
+++ pkg/PortfolioAnalytics/NAMESPACE	2013-08-12 03:14:38 UTC (rev 2767)
@@ -82,6 +82,7 @@
 export(randomize_portfolio_v1)
 export(randomize_portfolio_v2)
 export(randomize_portfolio)
+export(return_constraint)
 export(return_objective)
 export(risk_budget_objective)
 export(rp_transform)

Modified: pkg/PortfolioAnalytics/R/constrained_objective.R
===================================================================
--- pkg/PortfolioAnalytics/R/constrained_objective.R	2013-08-11 12:23:23 UTC (rev 2766)
+++ pkg/PortfolioAnalytics/R/constrained_objective.R	2013-08-12 03:14:38 UTC (rev 2767)
@@ -518,6 +518,14 @@
         out = out + penalty * mult * abs(to - turnover_target)
       }
     } # End turnover constraint penalty
+  
+  # penalize weights that violate return target constraint
+  if(!is.null(constraints$return_target)){
+    return_target <- constraints$return_target
+    mean_return <- mean(R %*% w)
+    mult <- 1
+    out = out + penalty * mult * abs(mean_return - return_target)
+  } # End return constraint penalty
     
   nargs <- list(...)
   if(length(nargs)==0) nargs <- NULL

Modified: pkg/PortfolioAnalytics/R/constraints.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraints.R	2013-08-11 12:23:23 UTC (rev 2766)
+++ pkg/PortfolioAnalytics/R/constraints.R	2013-08-12 03:14:38 UTC (rev 2767)
@@ -272,6 +272,12 @@
                                                                        message=message,
                                                                        ...=...)
          },
+         # Return constraint
+         return = {tmp_constraint <- return_constraint(type=type,
+                                                       enabled=enabled,
+                                                       message=message,
+                                                       ...=...)
+         },
          # Do nothing and return the portfolio object if type is NULL
          null = {return(portfolio)}
   )
@@ -604,6 +610,9 @@
         out$max_pos_long <- constraint$max_pos_long
         out$max_pos_short <- constraint$max_pos_short
       }
+      if(inherits(constraint, "return_constraint")){
+        out$return_target <- constraint$return_target
+      }
     }
   }
   
@@ -681,6 +690,30 @@
   return(Constraint)
 }
 
+#' constructor for return_constraint
+#' 
+#' This function is called by add.constraint when type="return" is specified, \code{\link{add.constraint}}
+#' 
+#' @param type character type of the constraint
+#' @param return_target return target value
+#' @param enabled TRUE/FALSE
+#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE.
+#' @param \dots any other passthru parameters
+#' @author Ross Bennett
+#' @examples
+#' data(edhec)
+#' ret <- edhec[, 1:4]
+#' 
+#' pspec <- portfolio.spec(assets=colnames(ret))
+#' 
+#' pspec <- add.constraint(portfolio=pspec, type="return", div_target=mean(colMeans(ret)))
+#' @export
+return_constraint <- function(type="return", return_target, enabled=TRUE, message=FALSE, ...){
+  Constraint <- constraint_v2(type, enabled=enabled, constrclass="return_constraint", ...)
+  Constraint$return_target <- return_target
+  return(Constraint)
+}
+
 #' constructor for position_limit_constraint
 #' 
 #' This function is called by add.constraint when type="position_limit" is specified, \code{\link{add.constraint}}

Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R	2013-08-11 12:23:23 UTC (rev 2766)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R	2013-08-12 03:14:38 UTC (rev 2767)
@@ -775,7 +775,11 @@
     # we can either miniminze variance or maximize quiadratic utility (we will be minimizing the neg. quad. utility)
     moments <- list(mean=rep(0, N))
     alpha <- 0.05
-    target <- NA
+    if(!is.null(constraints$return_target)){
+      target <- constraints$return_target
+    } else {
+      target <- NA
+    }
     lambda <- 1
     for(objective in portfolio$objectives){
       if(objective$enabled){

Added: pkg/PortfolioAnalytics/man/return_constraint.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/return_constraint.Rd	                        (rev 0)
+++ pkg/PortfolioAnalytics/man/return_constraint.Rd	2013-08-12 03:14:38 UTC (rev 2767)
@@ -0,0 +1,35 @@
+\name{return_constraint}
+\alias{return_constraint}
+\title{constructor for return_constraint}
+\usage{
+  return_constraint(type = "return", return_target,
+    enabled = TRUE, message = FALSE, ...)
+}
+\arguments{
+  \item{type}{character type of the constraint}
+
+  \item{return_target}{return target value}
+
+  \item{enabled}{TRUE/FALSE}
+
+  \item{message}{TRUE/FALSE. The default is message=FALSE.
+  Display messages if TRUE.}
+
+  \item{\dots}{any other passthru parameters}
+}
+\description{
+  This function is called by add.constraint when
+  type="return" is specified, \code{\link{add.constraint}}
+}
+\examples{
+data(edhec)
+ret <- edhec[, 1:4]
+
+pspec <- portfolio.spec(assets=colnames(ret))
+
+pspec <- add.constraint(portfolio=pspec, type="return", div_target=mean(colMeans(ret)))
+}
+\author{
+  Ross Bennett
+}
+