CoCalc -- test_qp

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

7
# Test that PortfolioAnalytics with ROI.plugin.quadprog solutions equal quadprog solutions
8
context("Maximum Quadratic Utility Portfolios: PortfolioAnalytics with ROI.plugin.quadprog and quadprog")
9

10

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

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

24
# Quadratic part of objective function
25
objQ <- 2 * cov(R)
26

27
# Linear part of objective function
28
# solve.QP minimizes 1/2 b^T D b - d^T b so we do not need a negative here
29
objL <- colMeans(R)
30

31
# Constraints matrix
32
Amat <- matrix(1, nrow=1, ncol=m)
33

34
# right hand side of constraints
35
rhs <- 1
36

37

38
##### Unconstrained #####
39

40
# Solve optimization with quadprog
41
opt.qp <- solve.QP(Dmat=objQ, dvec=objL, Amat=t(Amat), bvec=rhs, meq=1)
42

43
# Solve optimization with PortfolioAnalytics
44
opt.pa <- optimize.portfolio(R, portf, optimize_method="quadprog")
45
weights <- as.numeric(extractWeights(opt.pa))
46

47
test_that("Unconstrained: PortfolioAnalytics and quadprog solution weights are equal", {
48
  expect_that(weights, equals(opt.qp$solution))
49
})
50

51
test_that("Unconstrained: PortfolioAnalytics and quadprog solution objective values are equal", {
52
  expect_that(opt.pa$out, equals(opt.qp$value))
53
})
54

55
##### Long Only #####
56
# Upper and lower bounds (i.e. box constraints)
57
lb <- rep(0, m)
58
ub <- rep(1, m)
59

60
Amat <- rbind(1, diag(m), -diag(m))
61
rhs <- c(1, lb, -ub)
62

63
# Update box constraints in portfolio
64
portf$constraints[[2]]$min <- lb
65
portf$constraints[[2]]$max <- ub
66

67
# Solve optimization with quadprog
68
opt.qp <- solve.QP(Dmat=objQ, dvec=objL, Amat=t(Amat), bvec=rhs, meq=1)
69

70
# Solve optimization with PortfolioAnalytics
71
opt.pa <- optimize.portfolio(R, portf, optimize_method="quadprog")
72
weights <- round(as.numeric(extractWeights(opt.pa)), 10)
73

74
test_that("Long Only: PortfolioAnalytics and quadprog solution weights are equal", {
75
  expect_that(weights, equals(opt.qp$solution))
76
})
77

78
test_that("Long Only: PortfolioAnalytics bounds are respected", {
79
  expect_that(all(weights >= lb) & all(weights <= ub), is_true())
80
})
81

82
test_that("Long Only: quadprog bounds are respected", {
83
  expect_that(all(round(opt.qp$solution, 10) >= lb) & all(round(opt.qp$solution, 10) <= ub), is_true())
84
})
85

86
test_that("Long Only: PortfolioAnalytics and quadprog solution objective values are equal", {
87
  expect_that(opt.pa$out, equals(opt.qp$value))
88
})
89

90
##### Box #####
91
# Upper and lower bounds (i.e. box constraints)
92
lb <- rep(0.05, m)
93
ub <- rep(0.55, m)
94

95
Amat <- rbind(1, diag(m), -diag(m))
96
rhs <- c(1, lb, -ub)
97

98
# Update box constraints in portfolio
99
portf$constraints[[2]]$min <- lb
100
portf$constraints[[2]]$max <- ub
101

102
# Solve optimization with quadprog
103
opt.qp <- solve.QP(Dmat=objQ, dvec=objL, Amat=t(Amat), bvec=rhs, meq=1)
104

105
# Solve optimization with PortfolioAnalytics
106
opt.pa <- optimize.portfolio(R, portf, optimize_method="quadprog")
107
weights <- round(as.numeric(extractWeights(opt.pa)), 10)
108

109

110
test_that("Box: PortfolioAnalytics and quadprog solution weights are equal", {
111
  expect_that(weights, equals(opt.qp$solution))
112
})
113

114
test_that("Box: PortfolioAnalytics bounds are respected", {
115
  expect_that(all(weights >= lb) & all(weights <= ub), is_true())
116
})
117

118
test_that("Box: quadoprog bounds are respected", {
119
  expect_that(all(round(opt.qp$solution, 10) >= lb) & all(round(opt.qp$solution, 10) <= ub), is_true())
120
})
121

122
test_that("Box: PortfolioAnalytics and quadprog solution objective values are equal", {
123
  expect_that(opt.pa$out, equals(opt.qp$value))
124
})
125

126
##### Box with Shorting #####
127
# Upper and lower bounds (i.e. box constraints)
128
lb <- rep(-0.05, m)
129
ub <- rep(0.55, m)
130

131
Amat <- rbind(1, diag(m), -diag(m))
132
rhs <- c(1, lb, -ub)
133

134
# Update box constraints in portfolio
135
portf$constraints[[2]]$min <- lb
136
portf$constraints[[2]]$max <- ub
137

138
# Solve optimization with quadprog
139
opt.qp <- solve.QP(Dmat=objQ, dvec=objL, Amat=t(Amat), bvec=rhs, meq=1)
140

141
# Solve optimization with PortfolioAnalytics
142
opt.pa <- optimize.portfolio(R, portf, optimize_method="quadprog")
143
weights <- round(as.numeric(extractWeights(opt.pa)), 10)
144

145

146
test_that("Box with Shorting: PortfolioAnalytics and quadprog solution weights are equal", {
147
  expect_that(weights, equals(opt.qp$solution))
148
})
149

150
test_that("Box with Shorting: PortfolioAnalytics bounds are respected", {
151
  expect_that(all(weights >= lb) & all(weights <= ub), is_true())
152
})
153

154
test_that("Box with Shorting: quadprog bounds are respected", {
155
  expect_that(all(round(opt.qp$solution, 10) >= lb) & all(round(opt.qp$solution, 10) <= ub), is_true())
156
})
157

158
test_that("Box with Shorting: PortfolioAnalytics and quadprog solution objective values are equal", {
159
  expect_that(opt.pa$out, equals(opt.qp$value))
160
})
161

162

163

164
Product

Resources

Company
