[Returnanalytics-commits] r3374 - pkg/PortfolioAnalytics/inst/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Apr 19 06:03:18 CEST 2014
Author: rossbennett34
Date: 2014-04-19 06:03:15 +0200 (Sat, 19 Apr 2014)
New Revision: 3374
Added:
pkg/PortfolioAnalytics/inst/tests/test_cplex_gmv.R
pkg/PortfolioAnalytics/inst/tests/test_cplex_maxMean.R
pkg/PortfolioAnalytics/inst/tests/test_cplex_minES.R
pkg/PortfolioAnalytics/inst/tests/test_cplex_qu.R
pkg/PortfolioAnalytics/inst/tests/test_glpk_maxMean.R
pkg/PortfolioAnalytics/inst/tests/test_glpk_minES.R
pkg/PortfolioAnalytics/inst/tests/test_qp_gmv.R
pkg/PortfolioAnalytics/inst/tests/test_qp_qu.R
Removed:
pkg/PortfolioAnalytics/inst/tests/test_roi_max_ret.R
pkg/PortfolioAnalytics/inst/tests/test_roi_min_etl.R
pkg/PortfolioAnalytics/inst/tests/test_roi_min_var.R
pkg/PortfolioAnalytics/inst/tests/test_roi_qu.R
Log:
Removing bad test files and adding improved test files. Specifically testing output of PortfolioAnalytics with output of solver (e.g. PortfolioAnalytics using ROI.plugin.glpk against using Rglpk directly)
Added: pkg/PortfolioAnalytics/inst/tests/test_cplex_gmv.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_cplex_gmv.R (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_cplex_gmv.R 2014-04-19 04:03:15 UTC (rev 3374)
@@ -0,0 +1,166 @@
+library(PortfolioAnalytics)
+library(Rcplex)
+library(ROI)
+library(ROI.plugin.cplex)
+library(testthat)
+
+# Test that PortfolioAnalytics with ROI.plugin.cplex solutions equal Rcplex solutions
+context("GMV Portfolios: PortfolioAnalytics with ROI.plugin.cplex and Rcplex")
+
+# args(Rcplex)
+# ?Rcplex
+
+##### Data #####
+data(edhec)
+R <- edhec[, 1:5]
+funds <- colnames(R)
+m <- ncol(R)
+
+##### Parameters #####
+portf <- portfolio.spec(funds)
+portf <- add.constraint(portf, type="full_investment")
+portf <- add.constraint(portf, type="box", min=-Inf, max=Inf)
+portf <- add.objective(portf, type="risk", name="var")
+
+# Quadratic part of objective function
+objQ <- 2 * cov(R)
+
+# Linear part of objective function
+objL <- rep(0, m)
+
+# Constraints matrix
+Amat <- matrix(1, nrow=1, ncol=m)
+
+# right hand side of constraints
+rhs <- 1
+
+# direction of inequality of constraints
+dir <- "E"
+
+##### Unconstrained #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(-Inf, m)
+ub <- rep(Inf, m)
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Unconstrained: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Unconstrained: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Long Only #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(0, m)
+ub <- rep(1, m)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Long Only: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Long Only: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Long Only: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt >= lb) & all(opt.rcplex$xopt <= ub), is_true())
+})
+
+test_that("Long Only: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Box #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(0.05, m)
+ub <- rep(0.55, m)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+
+test_that("Box: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Box: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Box: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt >= lb) & all(opt.rcplex$xopt <= ub), is_true())
+})
+
+test_that("Box: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Box with Shorting #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(-0.05, m)
+ub <- rep(0.55, m)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+
+test_that("Box with Shorting: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Box with Shorting: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Box with Shorting: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt >= lb) & all(opt.rcplex$xopt <= ub), is_true())
+})
+
+test_that("Box with Shorting: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+Rcplex.close()
Added: pkg/PortfolioAnalytics/inst/tests/test_cplex_maxMean.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_cplex_maxMean.R (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_cplex_maxMean.R 2014-04-19 04:03:15 UTC (rev 3374)
@@ -0,0 +1,140 @@
+library(PortfolioAnalytics)
+library(Rcplex)
+library(ROI)
+library(ROI.plugin.cplex)
+library(testthat)
+
+# Test that ROI.plugin.cplex solutions equal Rcplex solutions
+context("Maximum Mean Return Portfolios: PortfolioAnalytics with ROI.plugin.cplex and Rcplex")
+
+# args(Rcplex)
+# ?Rcplex
+
+##### Data #####
+data(edhec)
+R <- edhec[, 1:5]
+funds <- colnames(R)
+m <- ncol(R)
+
+##### Parameters #####
+portf <- portfolio.spec(funds)
+portf <- add.constraint(portf, type="full_investment")
+portf <- add.constraint(portf, type="box", min=0, max=1)
+portf <- add.objective(portf, type="return", name="mean")
+
+# Quadratic part of objective function
+objQ <- NULL
+
+# Linear part of objective function
+objL <- -colMeans(R)
+
+# Constraints matrix
+Amat <- matrix(1, nrow=1, ncol=m)
+
+# right hand side of constraints
+rhs <- 1
+
+# direction of inequality of constraints
+dir <- "E"
+
+
+##### Long Only #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(0, m)
+ub <- rep(1, m)
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Long Only: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Long Only: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Long Only: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt >= lb) & all(opt.rcplex$xopt <= ub), is_true())
+})
+
+test_that("Long Only: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Box #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(0.05, m)
+ub <- rep(0.55, m)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Box: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Box: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Box: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt >= lb) & all(opt.rcplex$xopt <= ub), is_true())
+})
+
+test_that("Box: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Box with Shorting #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(-0.05, m)
+ub <- rep(0.55, m)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Box with Shorting: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Box with Shorting: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Box with Shorting: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt >= lb) & all(opt.rcplex$xopt <= ub), is_true())
+})
+
+test_that("Box with Shorting: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+Rcplex.close()
+
Added: pkg/PortfolioAnalytics/inst/tests/test_cplex_minES.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_cplex_minES.R (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_cplex_minES.R 2014-04-19 04:03:15 UTC (rev 3374)
@@ -0,0 +1,184 @@
+library(PortfolioAnalytics)
+library(Rcplex)
+library(ROI)
+library(ROI.plugin.cplex)
+library(testthat)
+
+# Test that ROI.plugin.cplex solutions equal Rcplex solutions
+context("Minimum ES Portfolios: PortfolioAnalytics with ROI.plugin.cplex and Rcplex")
+
+# args(Rcplex)
+# ?Rcplex
+
+##### Data #####
+data(edhec)
+R <- edhec[, 1:5]
+funds <- colnames(R)
+
+##### Parameters #####
+m <- ncol(R)
+n <- nrow(R)
+alpha <- 0.05
+
+portf <- portfolio.spec(funds)
+portf <- add.constraint(portf, type="full_investment")
+portf <- add.constraint(portf, type="box", min=-Inf, max=Inf)
+portf <- add.objective(portf, type="risk", name="ES", arguments=list(p=1-alpha))
+
+# Quadratic part of objective function
+objQ <- NULL
+
+# Linear part of objective function
+objL <- c(rep(0, m), rep(1 / (alpha * n), n), 1)
+
+# Constraints matrix
+Amat <- cbind(rbind(1, zoo::coredata(R)),
+ rbind(0, cbind(diag(n), 1)))
+
+# right hand side of constraints
+rhs <- c(1, rep(0, n))
+
+# direction of inequality of constraints
+dir <- c("E", rep("G", n))
+
+##### Unconstrained #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+min_box <- rep(-Inf, m)
+max_box <- rep(Inf, m)
+
+lb <- c(min_box, rep(0, n), -1)
+ub <- c(max_box, rep(Inf, n), 1)
+
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+
+test_that("Unconstrained: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt[1:m]))
+})
+
+test_that("Unconstrained: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+
+##### Long Only #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+min_box <- rep(0, m)
+max_box <- rep(1, m)
+
+lb <- c(min_box, rep(0, n), -1)
+ub <- c(max_box, rep(Inf, n), 1)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- min_box
+portf$constraints[[2]]$max <- max_box
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Long Only: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt[1:m]))
+})
+
+test_that("Long Only: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= min_box) & all(weights <= max_box), is_true())
+})
+
+test_that("Long Only: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt[1:m] >= min_box) & all(opt.rcplex$xopt[1:m] <= max_box), is_true())
+})
+
+test_that("Long Only: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Box #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+min_box <- rep(0.05, m)
+max_box <- rep(0.55, m)
+
+lb <- c(min_box, rep(0, n), -1)
+ub <- c(max_box, rep(Inf, n), 1)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- min_box
+portf$constraints[[2]]$max <- max_box
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Box: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt[1:m]))
+})
+
+test_that("Box: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= min_box) & all(weights <= max_box), is_true())
+})
+
+test_that("Box: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt[1:m] >= min_box) & all(opt.rcplex$xopt[1:m] <= max_box), is_true())
+})
+
+test_that("Box: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Box with Shorting #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+min_box <- rep(-0.05, m)
+max_box <- rep(0.55, m)
+
+lb <- c(min_box, rep(0, n), -1)
+ub <- c(max_box, rep(Inf, n), 1)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- min_box
+portf$constraints[[2]]$max <- max_box
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Box with Shorting: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt[1:m]))
+})
+
+test_that("Box with Shorting: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= min_box) & all(weights <= max_box), is_true())
+})
+
+test_that("Box with Shorting: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt[1:m] >= min_box) & all(opt.rcplex$xopt[1:m] <= max_box), is_true())
+})
+
+test_that("Box with Shorting: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+Rcplex.close()
+
Added: pkg/PortfolioAnalytics/inst/tests/test_cplex_qu.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_cplex_qu.R (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_cplex_qu.R 2014-04-19 04:03:15 UTC (rev 3374)
@@ -0,0 +1,171 @@
+library(PortfolioAnalytics)
+library(Rcplex)
+library(ROI)
+library(ROI.plugin.cplex)
+library(testthat)
+
+# Test that PortfolioAnalytics with ROI.plugin.cplex solutions equal Rcplex solutions
+context("Maximum Quadratic Utility Portfolios: PortfolioAnalytics with ROI.plugin.cplex and Rcplex")
+
+# args(Rcplex)
+# ?Rcplex
+
+##### Data #####
+data(edhec)
+R <- edhec[, 1:5]
+funds <- colnames(R)
+m <- ncol(R)
+
+##### Parameters #####
+
+# risk aversion parameter
+lambda <- 1
+
+portf <- portfolio.spec(funds)
+portf <- add.constraint(portf, type="full_investment")
+portf <- add.constraint(portf, type="box", min=-Inf, max=Inf)
+portf <- add.objective(portf, type="risk", name="var", risk_aversion=lambda)
+portf <- add.objective(portf, type="return", name="mean")
+
+# Quadratic part of objective function
+objQ <- lambda * 2 * cov(R)
+
+# Linear part of objective function
+objL <- -colMeans(R)
+
+# Constraints matrix
+Amat <- matrix(1, nrow=1, ncol=m)
+
+# right hand side of constraints
+rhs <- 1
+
+# direction of inequality of constraints
+dir <- "E"
+
+##### Unconstrained #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(-Inf, m)
+ub <- rep(Inf, m)
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Unconstrained: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Unconstrained: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Long Only #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(0, m)
+ub <- rep(1, m)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Long Only: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Long Only: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Long Only: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt >= lb) & all(opt.rcplex$xopt <= ub), is_true())
+})
+
+test_that("Long Only: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Box #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(0.05, m)
+ub <- rep(0.55, m)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+
+test_that("Box: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Box: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Box: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt >= lb) & all(opt.rcplex$xopt <= ub), is_true())
+})
+
+test_that("Box: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+##### Box with Shorting #####
+# Upper and lower bounds (i.e. box constraints)
+# Rcplex bounds
+lb <- rep(-0.05, m)
+ub <- rep(0.55, m)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rcplex
+opt.rcplex <- Rcplex(cvec=objL, Amat=Amat, bvec=rhs, Qmat=objQ, lb=lb, ub=ub,
+ sense=dir, control=list(trace=0))
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="cplex")
+weights <- as.numeric(extractWeights(opt.pa))
+
+
+test_that("Box with Shorting: PortfolioAnalytics and Rcplex solution weights are equal", {
+ expect_that(weights, equals(opt.rcplex$xopt))
+})
+
+test_that("Box with Shorting: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Box with Shorting: Rcplex bounds are respected", {
+ expect_that(all(opt.rcplex$xopt >= lb) & all(opt.rcplex$xopt <= ub), is_true())
+})
+
+test_that("Box with Shorting: PortfolioAnalytics and Rcplex solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.rcplex$obj))
+})
+
+Rcplex.close()
Added: pkg/PortfolioAnalytics/inst/tests/test_glpk_maxMean.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_glpk_maxMean.R (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_glpk_maxMean.R 2014-04-19 04:03:15 UTC (rev 3374)
@@ -0,0 +1,141 @@
+library(PortfolioAnalytics)
+library(ROI)
+library(ROI.plugin.glpk)
+library(Rglpk)
+library(testthat)
+
+# Test that ROI.plugin.glpk solutions equal Rglpk solutions
+context("Maximum Mean Return Portfolios: PortfolioAnalytics with ROI.plugin.glpk and Rglpk")
+
+
+##### Data #####
+data(edhec)
+R <- edhec[, 1:5]
+funds <- colnames(R)
+
+##### Parameters #####
+m <- ncol(R)
+
+portf <- portfolio.spec(funds)
+portf <- add.constraint(portf, type="full_investment")
+portf <- add.constraint(portf, type="box", min=-Inf, max=Inf)
+portf <- add.objective(portf, type="return", name="mean")
+
+# Linear part of objective function
+objL <- -colMeans(R)
+
+# Constraints matrix
+Amat <- matrix(1, nrow=1, ncol=m)
+
+# right hand side of constraints
+rhs <- 1
+
+# direction of inequality of constraints
+dir <- "=="
+
+##### Long Only #####
+# Upper and lower bounds (i.e. box constraints)
+lb <- rep(0, m)
+ub <- rep(1, m)
+
+bnds <- list(lower = list(ind = seq.int(1L, m), val = lb),
+ upper = list(ind = seq.int(1L, m), val = ub))
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rglpk
+opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Long Only: PortfolioAnalytics and Rglpk solution weights are equal", {
+ expect_that(weights, equals(opt.glpk$solution[1:m]))
+})
+
+test_that("Long Only: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Long Only: Rglpk bounds are respected", {
+ expect_that(all(opt.glpk$solution[1:m] >= lb) & all(opt.glpk$solution[1:m] <= ub), is_true())
+})
+
+test_that("Long Only: PortfolioAnalytics and Rglpk solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.glpk$optimum))
+})
+
+##### Box #####
+# Upper and lower bounds (i.e. box constraints)
+lb <- rep(0.05, m)
+ub <- rep(0.55, m)
+
+bnds <- list(lower = list(ind = seq.int(1L, m), val = lb),
+ upper = list(ind = seq.int(1L, m), val = ub))
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rglpk
+opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Box: PortfolioAnalytics and Rglpk solution weights are equal", {
+ expect_that(weights, equals(opt.glpk$solution[1:m]))
+})
+
+test_that("Box: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Box: Rglpk bounds are respected", {
+ expect_that(all(opt.glpk$solution[1:m] >= lb) & all(opt.glpk$solution[1:m] <= ub), is_true())
+})
+
+test_that("Box: PortfolioAnalytics and Rglpk solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.glpk$optimum))
+})
+
+##### Box with Shorting #####
+# Upper and lower bounds (i.e. box constraints)
+lb <- rep(-0.05, m)
+ub <- rep(0.55, m)
+
+bnds <- list(lower = list(ind = seq.int(1L, m), val = lb),
+ upper = list(ind = seq.int(1L, m), val = ub))
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
+# Solve optimization with Rglpk
+opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Box with Shorting: PortfolioAnalytics and Rglpk solution weights are equal", {
+ expect_that(weights, equals(opt.glpk$solution[1:m]))
+})
+
+test_that("Box with Shorting: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= lb) & all(weights <= ub), is_true())
+})
+
+test_that("Box with Shorting: Rglpk bounds are respected", {
+ expect_that(all(opt.glpk$solution[1:m] >= lb) & all(opt.glpk$solution[1:m] <= ub), is_true())
+})
+
+test_that("Box with Shorting: PortfolioAnalytics and Rglpk solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.glpk$optimum))
+})
+
+
Added: pkg/PortfolioAnalytics/inst/tests/test_glpk_minES.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_glpk_minES.R (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_glpk_minES.R 2014-04-19 04:03:15 UTC (rev 3374)
@@ -0,0 +1,153 @@
+library(PortfolioAnalytics)
+library(ROI)
+library(ROI.plugin.glpk)
+library(Rglpk)
+library(testthat)
+
+# Test that ROI.plugin.glpk solutions equal Rglpk solutions
+context("Minimum ES Portfolios: PortfolioAnalytics with ROI.plugin.glpk and Rglpk")
+
+
+##### Data #####
+data(edhec)
+R <- edhec[, 1:5]
+funds <- colnames(R)
+
+##### Parameters #####
+m <- ncol(R)
+n <- nrow(R)
+alpha <- 0.05
+
+portf <- portfolio.spec(funds)
+portf <- add.constraint(portf, type="full_investment")
+portf <- add.constraint(portf, type="box", min=-Inf, max=Inf)
+portf <- add.objective(portf, type="risk", name="ES", arguments=list(p=1-alpha))
+
+# Linear part of objective function
+objL <- c(rep(0, m), rep(1 / (alpha * n), n), 1)
+
+# Constraints matrix
+Amat <- cbind(rbind(1, zoo::coredata(R)),
+ rbind(0, cbind(diag(n), 1)))
+
+# right hand side of constraints
+rhs <- c(1, rep(0, n))
+
+# direction of inequality of constraints
+dir <- c("==", rep(">=", n))
+
+##### Long Only #####
+# Upper and lower bounds (i.e. box constraints)
+min_box <- rep(0, m)
+max_box <- rep(1, m)
+
+lb <- c(min_box, rep(0, n), -1)
+ub <- c(max_box, rep(Inf, n), 1)
+
+bnds <- list(lower = list(ind = seq.int(1L, m+n+1), val = lb),
+ upper = list(ind = seq.int(1L, m+n+1), val = ub))
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- min_box
+portf$constraints[[2]]$max <- max_box
+
+# Solve optimization with Rglpk
+opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Long Only: PortfolioAnalytics and Rglpk solution weights are equal", {
+ expect_that(weights, equals(opt.glpk$solution[1:m]))
+})
+
+test_that("Long Only: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= min_box) & all(weights <= max_box), is_true())
+})
+
+test_that("Long Only: Rglpk bounds are respected", {
+ expect_that(all(opt.glpk$solution[1:m] >= min_box) & all(opt.glpk$solution[1:m] <= max_box), is_true())
+})
+
+test_that("Long Only: PortfolioAnalytics and Rglpk solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.glpk$optimum))
+})
+
+##### Box #####
+# Upper and lower bounds (i.e. box constraints)
+min_box <- rep(0.05, m)
+max_box <- rep(0.55, m)
+
+lb <- c(min_box, rep(0, n), -1)
+ub <- c(max_box, rep(Inf, n), 1)
+
+bnds <- list(lower = list(ind = seq.int(1L, m+n+1), val = lb),
+ upper = list(ind = seq.int(1L, m+n+1), val = ub))
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- min_box
+portf$constraints[[2]]$max <- max_box
+
+# Solve optimization with Rglpk
+opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Box: PortfolioAnalytics and Rglpk solution weights are equal", {
+ expect_that(weights, equals(opt.glpk$solution[1:m]))
+})
+
+test_that("Box: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= min_box) & all(weights <= max_box), is_true())
+})
+
+test_that("Box: Rglpk bounds are respected", {
+ expect_that(all(opt.glpk$solution[1:m] >= min_box) & all(opt.glpk$solution[1:m] <= max_box), is_true())
+})
+
+test_that("Box: PortfolioAnalytics and Rglpk solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.glpk$optimum))
+})
+
+##### Box with Shorting #####
+# Upper and lower bounds (i.e. box constraints)
+min_box <- rep(-0.05, m)
+max_box <- rep(0.55, m)
+
+lb <- c(min_box, rep(0, n), -1)
+ub <- c(max_box, rep(Inf, n), 1)
+
+bnds <- list(lower = list(ind = seq.int(1L, m+n+1), val = lb),
+ upper = list(ind = seq.int(1L, m+n+1), val = ub))
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- min_box
+portf$constraints[[2]]$max <- max_box
+
+# Solve optimization with Rglpk
+opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Box with Shorting: PortfolioAnalytics and Rglpk solution weights are equal", {
+ expect_that(weights, equals(opt.glpk$solution[1:m]))
+})
+
+test_that("Box with Shorting: PortfolioAnalytics bounds are respected", {
+ expect_that(all(weights >= min_box) & all(weights <= max_box), is_true())
+})
+
+test_that("Box with Shorting: Rglpk bounds are respected", {
+ expect_that(all(opt.glpk$solution[1:m] >= min_box) & all(opt.glpk$solution[1:m] <= max_box), is_true())
+})
+
+test_that("Box with Shorting: PortfolioAnalytics and Rglpk solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.glpk$optimum))
+})
+
+
Added: pkg/PortfolioAnalytics/inst/tests/test_qp_gmv.R
===================================================================
--- pkg/PortfolioAnalytics/inst/tests/test_qp_gmv.R (rev 0)
+++ pkg/PortfolioAnalytics/inst/tests/test_qp_gmv.R 2014-04-19 04:03:15 UTC (rev 3374)
@@ -0,0 +1,162 @@
+library(PortfolioAnalytics)
+library(ROI)
+library(ROI.plugin.quadprog)
+library(quadprog)
+library(testthat)
+
+# Test that PortfolioAnalytics with ROI.plugin.quadprog solutions equal quadprog solutions
+context("GMV Portfolios: PortfolioAnalytics with ROI.plugin.quadprog and quadprog")
+
+
+##### Data #####
+data(edhec)
+R <- edhec[, 1:5]
+funds <- colnames(R)
+m <- ncol(R)
+
+##### Parameters #####
+portf <- portfolio.spec(funds)
+portf <- add.constraint(portf, type="full_investment")
+portf <- add.constraint(portf, type="box", min=-Inf, max=Inf)
+portf <- add.objective(portf, type="risk", name="var")
+
+# Quadratic part of objective function
+objQ <- 2 * cov(R)
+
+# Linear part of objective function
+objL <- rep(0, m)
+
+# Constraints matrix
+Amat <- matrix(1, nrow=1, ncol=m)
+
+# right hand side of constraints
+rhs <- 1
+
+
+##### Unconstrained #####
+
+# Solve optimization with quadprog
+opt.qp <- solve.QP(Dmat=objQ, dvec=objL, Amat=t(Amat), bvec=rhs, meq=1)
+
+# Solve optimization with PortfolioAnalytics
+opt.pa <- optimize.portfolio(R, portf, optimize_method="quadprog")
+weights <- as.numeric(extractWeights(opt.pa))
+
+test_that("Unconstrained: PortfolioAnalytics and quadprog solution weights are equal", {
+ expect_that(weights, equals(opt.qp$solution))
+})
+
+test_that("Unconstrained: PortfolioAnalytics and quadprog solution objective values are equal", {
+ expect_that(opt.pa$out, equals(opt.qp$value))
+})
+
+##### Long Only #####
+# Upper and lower bounds (i.e. box constraints)
+lb <- rep(0, m)
+ub <- rep(1, m)
+
+Amat <- rbind(1, diag(m), -diag(m))
+rhs <- c(1, lb, -ub)
+
+# Update box constraints in portfolio
+portf$constraints[[2]]$min <- lb
+portf$constraints[[2]]$max <- ub
+
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3374
More information about the Returnanalytics-commits
mailing list