[Returnanalytics-commits] r2500 - in pkg/PortfolioAnalytics: . R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 4 20:03:37 CEST 2013
Author: rossbennett34
Date: 2013-07-04 20:03:37 +0200 (Thu, 04 Jul 2013)
New Revision: 2500
Added:
pkg/PortfolioAnalytics/man/fn_map.Rd
pkg/PortfolioAnalytics/sandbox/testing_fn_map.R
Modified:
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/R/constraint_fn_map.R
Log:
adding improved constraint mapping function fn_map with testing script
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2013-07-04 14:20:24 UTC (rev 2499)
+++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-04 18:03:37 UTC (rev 2500)
@@ -24,6 +24,7 @@
export(extractStats.optimize.portfolio.ROI)
export(extractStats)
export(extractWeights.rebal)
+export(fn_map)
export(generatesequence)
export(get_constraints)
export(group_constraint)
Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-04 14:20:24 UTC (rev 2499)
+++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-04 18:03:37 UTC (rev 2500)
@@ -89,6 +89,122 @@
return(w)
}
+#' mapping function to transform or penalize weights that violate constraints
+#'
+#' The purpose of the mapping function is to transform a weights vector
+#' that does not meet all the constraints into a weights vector that
+#' does meet the constraints, if one exists, hopefully with a minimum
+#' of transformation.
+#'
+#' I think our first step should be to test each constraint type, in
+#' some sort of hierarchy, starting with box constraints (almost all
+#' solvers support box constraints, of course), since some of the other
+#' transformations will violate the box constraints, and we'll need to
+#' transform back again.
+#'
+#' This function will replace constraint_fn_map
+#'
+#' leverage, box, group, and position limit constraints are transformed
+#' diversification and turnover constraints are penalized
+#'
+#' @param weights vector of weights
+#' @param portfolio object of class portfolio
+#' @return
+#' \itemize{
+#' \item{weights: }{vector of transformed weights meeting constraints}
+#' \item{out: }{penalty term}
+#' }
+#' @author Ross Bennett
+#' @export
+fn_map <- function(weights, portfolio, ...){
+
+ if(!is.portfolio(portfolio)) stop("portfolio passed in is not of class 'portfolio'")
+
+ nassets <- length(portfolio$assets)
+
+ # step 1: Get the constraints out of the portfolio object
+ constraints <- get_constraints(portfolio)
+ min_sum <- constraints$min_sum
+ max_sum <- constraints$max_sum
+ # rp_transform will rarely find a feasible portfolio if there is not some
+ # 'wiggle room' between min_sum and max_sum
+ if((max_sum - min_sum) < 0.02){
+ min_sum <- min_sum - 0.01
+ max_sum <- max_sum + 0.01
+ }
+ min <- constraints$min
+ max <- constraints$max
+ groups <- constraints$groups
+ cLO <- constraints$cLO
+ cUP <- constraints$cUP
+ div_target <- constraints$div_target
+ turnover_target <- constraints$turnover_target
+ max_pos <- constraints$max_pos
+ tolerance <- .Machine$double.eps^0.5
+ if(!hasArg(penalty)) penalty <- 1e4
+ if(!hasArg(multiplier)) multiplier <- 1
+
+ out <- 0
+
+ tmp_weights <- weights
+
+ # step 2: check that the vector of weights satisfies the constraints,
+ # transform weights if constraint is violated
+ # TRUE if the weights vector is in compliance with the constraints
+ # FALSE if the weights vector violates the constraint
+
+ # check leverage constraints
+ if(!is.null(min_sum) & !is.null(max_sum)){
+ if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){
+ print("leverage constraint violated, transforming weights.")
+ tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500)
+ # tmp_weights <- txfrm_weight_sum_constraint(tmp_weights, min_sum, max_sum)
+ }
+ }
+
+ # check box constraints
+ if(!is.null(min) & !is.null(max)){
+ if(!(all(tmp_weights >= min) & all(tmp_weights <= max))){
+ print("box constraints violated, transforming weights.")
+ tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500)
+ # tmp_weights <- txfrm_box_constraint(tmp_weights, min, max)
+ }
+ }
+
+ # check group constraints
+ if(!is.null(groups) & !is.null(cLO) & !is.null(cUP)){
+ if(any(group_fail(tmp_weights, groups, cLO, cUP))){
+ print("group constraints violated, transforming weights.")
+ tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500)
+ # tmp_weights <- txfrm_group_constraint(tmp_weights, groups, cLO, cUP)
+ }
+ }
+
+ # check position_limit constraints
+ if(!is.null(max_pos)){
+ if(!(sum(abs(tmp_weights) > tolerance) <= max_pos)){
+ # print("position_limit constraint violated, transforming weights.")
+ # tmp_weights <- txfrm_position_limit_constraint(tmp_weights, max_pos, nassets)
+ }
+ }
+
+ # check diversification constraint
+ if(!is.null(div_target)){
+ print("transform or penalize to meet diversification target")
+ # penalize instead of transform?
+ div <- diversification(tmp_weights)
+ out = out + penalty * abs(multiplier) * abs(div - div_target)
+ }
+
+ if(!is.null(turnover_target)){
+ # print("transform or penalize to meet turnover target")
+ # penalize instead of transform
+ to <- turnover(tmp_weights)
+ out = out + penalty * abs(multiplier) * abs(to - turnover_target)
+ }
+ return(list(weights=tmp_weights, out=out))
+}
+
#' Transform weights that violate min or max box constraints
#'
#' This is a helper function called inside constraint_fnMap to transform the weights vector to satisfy box constraints.
Added: pkg/PortfolioAnalytics/man/fn_map.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/fn_map.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/fn_map.Rd 2013-07-04 18:03:37 UTC (rev 2500)
@@ -0,0 +1,39 @@
+\name{fn_map}
+\alias{fn_map}
+\title{mapping function to transform or penalize weights that violate constraints}
+\usage{
+ fn_map(weights, portfolio, ...)
+}
+\arguments{
+ \item{weights}{vector of weights}
+
+ \item{portfolio}{object of class portfolio}
+}
+\value{
+ \itemize{ \item{weights: }{vector of transformed weights
+ meeting constraints} \item{out: }{penalty term} }
+}
+\description{
+ The purpose of the mapping function is to transform a
+ weights vector that does not meet all the constraints
+ into a weights vector that does meet the constraints, if
+ one exists, hopefully with a minimum of transformation.
+}
+\details{
+ I think our first step should be to test each constraint
+ type, in some sort of hierarchy, starting with box
+ constraints (almost all solvers support box constraints,
+ of course), since some of the other transformations will
+ violate the box constraints, and we'll need to transform
+ back again.
+
+ This function will replace constraint_fn_map
+
+ leverage, box, group, and position limit constraints are
+ transformed diversification and turnover constraints are
+ penalized
+}
+\author{
+ Ross Bennett
+}
+
Added: pkg/PortfolioAnalytics/sandbox/testing_fn_map.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_fn_map.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-04 18:03:37 UTC (rev 2500)
@@ -0,0 +1,37 @@
+library(PortfolioAnalytics)
+
+data(edhec)
+ret <- edhec[, 1:4]
+funds <- colnames(ret)
+
+pspec <- portfolio.spec(assets=funds)
+
+pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=T)
+pspec <- add.constraint(portfolio=pspec, type="box", min=0.05, max=0.65, enabled=T)
+pspec <- add.constraint(portfolio=pspec, type="group", groups=c(2, 2),
+ group_min=c(0.08, 0.05), group_max=c(0.55, 0.85), enabled=T)
+pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.4, enabled=T)
+pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.6, enabled=T)
+pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3, enabled=F)
+portfolio <- pspec
+
+
+# leverage constraints are violated
+weights <- c(0.15, 0.25, 0.4, 0.1)
+sum(weights)
+
+fn_map(weights, portfolio)
+
+# box constraints are violated
+weights <- c(0.05, 0.7, 0.1, 0.15)
+sum(weights)
+
+fn_map(weights, portfolio)
+
+# group constraints are violated
+weights <- c(0.1, 0.65, 0.1, 0.15)
+sum(weights)
+
+fn_map(weights, portfolio)
+
+
More information about the Returnanalytics-commits
mailing list