[Returnanalytics-commits] r3232 - in pkg/PortfolioAnalytics: R demo vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 18 22:19:39 CEST 2013
Author: rossbennett34
Date: 2013-10-18 22:19:39 +0200 (Fri, 18 Oct 2013)
New Revision: 3232
Modified:
pkg/PortfolioAnalytics/R/optFUN.R
pkg/PortfolioAnalytics/demo/testing_ROI.R
pkg/PortfolioAnalytics/vignettes/ROI_vignette.Rnw
Log:
Adding handling of Inf and -Inf values for optFUN functions. Modified ROI demo and vignette.
Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-18 01:36:36 UTC (rev 3231)
+++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-18 20:19:39 UTC (rev 3232)
@@ -32,7 +32,7 @@
target <- 0
}
} else {
- tmp_means <- moments$mean
+ tmp_means <- rep(0, N)
target <- 0
}
Amat <- tmp_means
@@ -76,7 +76,18 @@
# dir.vec <- c(dir.vec, rep(">=", 2 * nrow(t.B)))
rhs.vec <- c(rhs.vec, constraints$lower, -constraints$upper)
}
+
+ # quadprog cannot handle infinite values so replace Inf with .Machine$double.xmax
+ # This is the strategy used in ROI
+ # Amat[ is.infinite(Amat) & (Amat <= 0) ] <- -.Machine$double.xmax
+ # Amat[ is.infinite(Amat) & (Amat >= 0) ] <- .Machine$double.xmax
+ # rhs.vec[is.infinite(rhs.vec) & (rhs.vec <= 0)] <- -.Machine$double.xmax
+ # rhs.vec[is.infinite(rhs.vec) & (rhs.vec >= 0)] <- .Machine$double.xmax
+ # Remove the rows of Amat and elements of rhs.vec where rhs.vec is Inf or -Inf
+ Amat <- Amat[!is.infinite(rhs.vec), ]
+ rhs.vec <- rhs.vec[!is.infinite(rhs.vec)]
+
# set up the quadratic objective
if(!is.null(lambda_hhi)){
if(length(lambda_hhi) == 1 & is.null(conc_groups)){
@@ -112,6 +123,7 @@
# roi.result <- ROI_solve(x=opt.prob, solver="quadprog")
result <- try(solve.QP(Dmat=Dmat, dvec=dvec, Amat=t(Amat), bvec=rhs.vec, meq=meq), silent=TRUE)
+ if(inherits(x=result, "try-error")) stop(paste("No solution found:", result))
weights <- result$solution[1:N]
names(weights) <- colnames(R)
@@ -139,8 +151,17 @@
N <- ncol(R)
# Applying box constraints
- bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)),
- upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max)))
+ # maxret_opt needs non infinite values for upper and lower bounds
+ lb <- constraints$min
+ ub <- constraints$max
+ if(any(is.infinite(lb)) | any(is.infinite(ub))){
+ warning("Inf or -Inf values detected in box constraints, maximum return
+ objectives must have finite box constraint values.")
+ ub[is.infinite(ub)] <- max(abs(c(constraints$min_sum, constraints$max_sum)))
+ lb[is.infinite(lb)] <- 0
+ }
+ bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(lb)),
+ upper=list(ind=seq.int(1L, N), val=as.numeric(ub)))
# set up initial A matrix for leverage constraints
Amat <- rbind(rep(1, N), rep(1, N))
@@ -615,9 +636,13 @@
d <- rep(-moments$mean, 3)
# print(Amat)
+ # Remove the rows of Amat and elements of rhs.vec where rhs is Inf or -Inf
+ Amat <- Amat[!is.infinite(rhs), ]
+ rhs <- rhs.vec[!is.infinite(rhs)]
+
qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V),
dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE)
- if(inherits(qp.result, "try-error")) stop("No solution found, consider adjusting constraints.")
+ if(inherits(qp.result, "try-error")) stop(paste("No solution found:", result))
wts <- qp.result$solution
# print(round(wts,4))
@@ -734,9 +759,13 @@
d <- rep(-moments$mean, 3)
+ # Remove the rows of Amat and elements of rhs.vec where rhs is Inf or -Inf
+ Amat <- Amat[!is.infinite(rhs), ]
+ rhs <- rhs.vec[!is.infinite(rhs)]
+
qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V),
dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE)
- if(inherits(qp.result, "try-error")) stop("No solution found, consider adjusting constraints.")
+ if(inherits(qp.result, "try-error")) stop(paste("No solution found:", result))
wts <- qp.result$solution
w.buy <- qp.result$solution[(N+1):(2*N)]
Modified: pkg/PortfolioAnalytics/demo/testing_ROI.R
===================================================================
--- pkg/PortfolioAnalytics/demo/testing_ROI.R 2013-10-18 01:36:36 UTC (rev 3231)
+++ pkg/PortfolioAnalytics/demo/testing_ROI.R 2013-10-18 20:19:39 UTC (rev 3232)
@@ -2,14 +2,6 @@
# OPTIMIZATION TESTING: ROI
#
-library(xts)
-library(quadprog)
-library(Rglpk)
-library(PerformanceAnalytics)
-library(ROI)
-library(ROI.plugin.glpk)
-library(ROI.plugin.quadprog)
-library(Ecdat)
library(PortfolioAnalytics)
# General Parameters for sample code
@@ -31,7 +23,7 @@
max.port$min <- rep(0.01,N)
max.port$max <- rep(0.30,N)
max.port$objectives[[1]]$enabled <- TRUE
-max.port$objectives[[1]]$target <- NULL
+max.port$objectives[[1]]$target <- NA
max.solution <- optimize.portfolio(R=edhec, constraints=max.port, optimize_method="ROI")
@@ -77,7 +69,7 @@
# Mean-variance: Fully invested, Global Minimum Variance Portfolio, Groups Constraints
#
groups.port <- gen.constr
-groups <- c(3,3,3,4)
+groups <- list(1:3, 4:6, 7:9, 10:13)
groups.port$groups <- groups
groups.port$cLO <- rep(0.15,length(groups))
groups.port$cUP <- rep(0.30,length(groups))
@@ -90,11 +82,11 @@
# Minimize CVaR with target return and group constraints
#
group.cvar.port <- gen.constr
-groups <- c(3,3,3,4)
+groups <- list(1:3, 4:6, 7:9, 10:13)
group.cvar.port$groups <- groups
group.cvar.port$cLO <- rep(0.15,length(groups))
group.cvar.port$cUP <- rep(0.30,length(groups))
group.cvar.port$objectives[[1]]$enabled <- TRUE
group.cvar.port$objectives[[3]]$enabled <- TRUE
-group.cvar.solution <- optimize.portfolio(R=edhec, constraints=group.cvar.port, optimize_method="ROI")
+group.cvar.solution <- optimize.portfolio(R=edhec, constraints=group.cvar.port, optimize_method="ROI", maxSTARR=FALSE)
Modified: pkg/PortfolioAnalytics/vignettes/ROI_vignette.Rnw
===================================================================
--- pkg/PortfolioAnalytics/vignettes/ROI_vignette.Rnw 2013-10-18 01:36:36 UTC (rev 3231)
+++ pkg/PortfolioAnalytics/vignettes/ROI_vignette.Rnw 2013-10-18 20:19:39 UTC (rev 3232)
@@ -23,12 +23,8 @@
Load the necessary packages.
<<>>=
suppressMessages(library(PortfolioAnalytics))
-suppressMessages(library(Rglpk))
suppressMessages(library(foreach))
suppressMessages(library(iterators))
-suppressMessages(library(ROI))
-suppressMessages(require(ROI.plugin.glpk))
-suppressMessages(require(ROI.plugin.quadprog))
@
\subsection{Data}
More information about the Returnanalytics-commits
mailing list