[Returnanalytics-commits] r3043 - in pkg/PortfolioAnalytics: R demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 10 18:49:13 CEST 2013
Author: rossbennett34
Date: 2013-09-10 18:49:13 +0200 (Tue, 10 Sep 2013)
New Revision: 3043
Added:
pkg/PortfolioAnalytics/demo/demo_proportional_cost_ROI.R
Modified:
pkg/PortfolioAnalytics/R/constraints.R
pkg/PortfolioAnalytics/R/optFUN.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/demo/00Index
Log:
Added transaction cost as a constraint type. Added demo script for proportional cost constraint.
Modified: pkg/PortfolioAnalytics/R/constraints.R
===================================================================
--- pkg/PortfolioAnalytics/R/constraints.R 2013-09-10 15:34:34 UTC (rev 3042)
+++ pkg/PortfolioAnalytics/R/constraints.R 2013-09-10 16:49:13 UTC (rev 3043)
@@ -345,6 +345,13 @@
message=message,
...=...)
},
+ # transaction cost constraint
+ transaction=, transaction_cost = {tmp_constraint <- transaction_cost_constraint(assets=assets,
+ type=type,
+ enabled=enabled,
+ message=message,
+ ...=...)
+ },
# Do nothing and return the portfolio object if type is NULL
null = {return(portfolio)}
)
@@ -718,6 +725,9 @@
out$lower <- constraint$lower
out$upper <- constraint$upper
}
+ if(inherits(constraint, "transaction_cost_constraint")){
+ out$ptc <- constraint$ptc
+ }
}
}
@@ -963,6 +973,39 @@
return(Constraint)
}
+#' constructor for transaction_cost_constraint
+#'
+#' The transaction cost constraint specifies a proportional cost value.
+#' This function is called by add.constraint when type="transaction_cost" is specified, see \code{\link{add.constraint}}.
+#'
+#' Note that with the ROI solvers, proportional transaction cost constraint is
+#' currently only supported for the global minimum variance and quadratic
+#' utility problems with ROI quadprog plugin.
+#'
+#' @param type character type of the constraint
+#' @param ptc proportional transaction cost value
+#' @param enabled TRUE/FALSE
+#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE.
+#' @param \dots any other passthru parameters to specify box and/or group constraints
+#' @author Ross Bennett
+#' @seealso \code{\link{add.constraint}}
+#' @examples
+#' data(edhec)
+#' ret <- edhec[, 1:4]
+#'
+#' pspec <- portfolio.spec(assets=colnames(ret))
+#'
+#' pspec <- add.constraint(portfolio=pspec, type="transaction_cost", ptc=0.01)
+#' @export
+transaction_cost_constraint <- function(type="transaction_cost", assets, ptc, enabled=TRUE, message=FALSE, ...){
+ nassets <- length(assets)
+ if(length(ptc) == 1) ptc <- rep(ptc, nassets)
+ if(length(ptc) != nassets) stop("length of ptc must be equal to number of assets")
+ Constraint <- constraint_v2(type, enabled=enabled, constrclass="transaction_cost_constraint", ...)
+ Constraint$ptc <- ptc
+ return(Constraint)
+}
+
#' function for updating constrints, not well tested, may be broken
#'
#' can we use the generic update.default function?
Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R 2013-09-10 15:34:34 UTC (rev 3042)
+++ pkg/PortfolioAnalytics/R/optFUN.R 2013-09-10 16:49:13 UTC (rev 3043)
@@ -679,10 +679,10 @@
wts <- qp.result$solution
w.buy <- qp.result$solution[(N+1):(2*N)]
w.sell <- qp.result$solution[(2*N+1):(3*N)]
- w.total <- w.initial + w.buy + w.sell
- # wts.final <- wts[(1:N)] + wts[(1+N):(2*N)] + wts[(2*N+1):(3*N)]
+ w.total <- init_weights + w.buy + w.sell
+ wts.final <- wts[(1:N)] + wts[(1+N):(2*N)] + wts[(2*N+1):(3*N)]
- weights <- w.total
+ weights <- wts.final
names(weights) <- colnames(R)
out <- list()
out$weights <- weights
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-09-10 15:34:34 UTC (rev 3042)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-09-10 16:49:13 UTC (rev 3043)
@@ -742,13 +742,13 @@
qp_result <- gmv_opt_toc(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, init_weights=portfolio$assets)
weights <- qp_result$weights
obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures
- out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call)
+ out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=qp_result$out, call=call)
}
if(!is.null(constraints$ptc) & is.null(constraints$turnover_target)){
qp_result <- gmv_opt_ptc(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, init_weights=portfolio$assets)
weights <- qp_result$weights
obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures
- out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call)
+ out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=qp_result$out, call=call)
}
} else {
roi_result <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, lambda_hhi=lambda_hhi, conc_groups=conc_groups)
Modified: pkg/PortfolioAnalytics/demo/00Index
===================================================================
--- pkg/PortfolioAnalytics/demo/00Index 2013-09-10 15:34:34 UTC (rev 3042)
+++ pkg/PortfolioAnalytics/demo/00Index 2013-09-10 16:49:13 UTC (rev 3043)
@@ -13,4 +13,5 @@
demo_weight_concentration Demonstrate how to use the weight concentration objective.
backwards_compat Demonstrate how to solve optimization problems using v1 specification with a v1_constraint object.
demo_random_portfolios Demonstrate examples from script.workshop2012.R using random portfolios
+demo_proportional_cost_ROI Demonstrate how to use proportional transaction cost constraint with quadprog solver
Added: pkg/PortfolioAnalytics/demo/demo_proportional_cost_ROI.R
===================================================================
--- pkg/PortfolioAnalytics/demo/demo_proportional_cost_ROI.R (rev 0)
+++ pkg/PortfolioAnalytics/demo/demo_proportional_cost_ROI.R 2013-09-10 16:49:13 UTC (rev 3043)
@@ -0,0 +1,32 @@
+library(PortfolioAnalytics)
+library(quadprog)
+
+data(edhec)
+N <- 4
+R <- edhec[, 1:N]
+colnames(R) <- c("CA", "CTAG", "DS", "EM")
+funds <- colnames(R)
+
+# set up initial portfolio specification object
+pspec <- portfolio.spec(assets=funds)
+pspec <- add.constraint(portfolio=pspec, type="full_investment")
+pspec <- add.constraint(portfolio=pspec, type="long_only")
+pspec <- add.constraint(portfolio=pspec, type="transaction", ptc=0.01)
+
+# add var objective to minimize portfolio variance
+minvar <- add.objective(portfolio=pspec, type="risk", name="var")
+
+# Note that if a return target is not specified, the results may not make sense
+optimize.portfolio(R=R, portfolio=minvar, optimize_method="ROI")
+
+# Add a target return constraint
+minvar <- add.constraint(portfolio=minvar, type="return", return_target=0.007)
+optimize.portfolio(R=R, portfolio=minvar, optimize_method="ROI")
+
+# Add return and risk objective for quadratic utility
+# Note that target return can be specified as a constraint or in the return
+# objective as shown below
+qu <- add.objective(portfolio=pspec, type="risk", name="var", risk_aversion=0.3)
+qu <- add.objective(portfolio=qu, type="return", name="mean", target=0.007)
+optimize.portfolio(R=R, portfolio=qu, optimize_method="ROI")
+
More information about the Returnanalytics-commits
mailing list