CoCalc -- test_glpk

GitHub Repository: braverock/portfolioanalytics
Path: blob/master/inst/tests/test_glpk_maxMean.R
¹⁴³³ views
1
library(PortfolioAnalytics)
2
library(ROI)
3
library(ROI.plugin.glpk)
4
library(Rglpk)
5
library(testthat)
6

7
# Test that ROI.plugin.glpk solutions equal Rglpk solutions
8
context("Maximum Mean Return Portfolios: PortfolioAnalytics with ROI.plugin.glpk and Rglpk")
9

10

11
##### Data #####
12
data(edhec)
13
R <- edhec[, 1:5]
14
funds <- colnames(R)
15

16
##### Parameters #####
17
m <- ncol(R)
18

19
portf <- portfolio.spec(funds)
20
portf <- add.constraint(portf, type="full_investment")
21
portf <- add.constraint(portf, type="box", min=-Inf, max=Inf)
22
portf <- add.objective(portf, type="return", name="mean")
23

24
# Linear part of objective function
25
objL <- -colMeans(R)
26

27
# Constraints matrix
28
Amat <- matrix(1, nrow=1, ncol=m)
29

30
# right hand side of constraints
31
rhs <- 1
32

33
# direction of inequality of constraints
34
dir <- "=="
35

36
##### Long Only #####
37
# Upper and lower bounds (i.e. box constraints)
38
lb <- rep(0, m)
39
ub <- rep(1, m)
40

41
bnds <- list(lower = list(ind = seq.int(1L, m), val = lb),
42
             upper = list(ind = seq.int(1L, m), val = ub))
43

44
# Update box constraints in portfolio
45
portf$constraints[[2]]$min <- lb
46
portf$constraints[[2]]$max <- ub
47

48
# Solve optimization with Rglpk
49
opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
50

51
# Solve optimization with PortfolioAnalytics
52
opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
53
weights <- as.numeric(extractWeights(opt.pa))
54

55
test_that("Long Only: PortfolioAnalytics and Rglpk solution weights are equal", {
56
  expect_that(weights, equals(opt.glpk$solution[1:m]))
57
})
58

59
test_that("Long Only: PortfolioAnalytics bounds are respected", {
60
  expect_that(all(weights >= lb) & all(weights <= ub), is_true())
61
})
62

63
test_that("Long Only: Rglpk bounds are respected", {
64
  expect_that(all(opt.glpk$solution[1:m] >= lb) & all(opt.glpk$solution[1:m] <= ub), is_true())
65
})
66

67
test_that("Long Only: PortfolioAnalytics and Rglpk solution objective values are equal", {
68
  expect_that(opt.pa$out, equals(opt.glpk$optimum))
69
})
70

71
##### Box #####
72
# Upper and lower bounds (i.e. box constraints)
73
lb <- rep(0.05, m)
74
ub <- rep(0.55, m)
75

76
bnds <- list(lower = list(ind = seq.int(1L, m), val = lb),
77
             upper = list(ind = seq.int(1L, m), val = ub))
78

79
# Update box constraints in portfolio
80
portf$constraints[[2]]$min <- lb
81
portf$constraints[[2]]$max <- ub
82

83
# Solve optimization with Rglpk
84
opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
85

86
# Solve optimization with PortfolioAnalytics
87
opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
88
weights <- as.numeric(extractWeights(opt.pa))
89

90
test_that("Box: PortfolioAnalytics and Rglpk solution weights are equal", {
91
  expect_that(weights, equals(opt.glpk$solution[1:m]))
92
})
93

94
test_that("Box: PortfolioAnalytics bounds are respected", {
95
  expect_that(all(weights >= lb) & all(weights <= ub), is_true())
96
})
97

98
test_that("Box: Rglpk bounds are respected", {
99
  expect_that(all(opt.glpk$solution[1:m] >= lb) & all(opt.glpk$solution[1:m] <= ub), is_true())
100
})
101

102
test_that("Box: PortfolioAnalytics and Rglpk solution objective values are equal", {
103
  expect_that(opt.pa$out, equals(opt.glpk$optimum))
104
})
105

106
##### Box with Shorting #####
107
# Upper and lower bounds (i.e. box constraints)
108
lb <- rep(-0.05, m)
109
ub <- rep(0.55, m)
110

111
bnds <- list(lower = list(ind = seq.int(1L, m), val = lb),
112
             upper = list(ind = seq.int(1L, m), val = ub))
113

114
# Update box constraints in portfolio
115
portf$constraints[[2]]$min <- lb
116
portf$constraints[[2]]$max <- ub
117

118
# Solve optimization with Rglpk
119
opt.glpk <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, bounds=bnds)
120

121
# Solve optimization with PortfolioAnalytics
122
opt.pa <- optimize.portfolio(R, portf, optimize_method="glpk")
123
weights <- as.numeric(extractWeights(opt.pa))
124

125
test_that("Box with Shorting: PortfolioAnalytics and Rglpk solution weights are equal", {
126
  expect_that(weights, equals(opt.glpk$solution[1:m]))
127
})
128

129
test_that("Box with Shorting: PortfolioAnalytics bounds are respected", {
130
  expect_that(all(weights >= lb) & all(weights <= ub), is_true())
131
})
132

133
test_that("Box with Shorting: Rglpk bounds are respected", {
134
  expect_that(all(opt.glpk$solution[1:m] >= lb) & all(opt.glpk$solution[1:m] <= ub), is_true())
135
})
136

137
test_that("Box with Shorting: PortfolioAnalytics and Rglpk solution objective values are equal", {
138
  expect_that(opt.pa$out, equals(opt.glpk$optimum))
139
})
140

141

142

143
Product

Resources

Company
