Given the similarities of the optimization problem here to your previous question, I will borrow some language directly from my answer to that question. However they are quite a bit different (the previous problem was a linear programming problem and this is a quadratic programming problem, and the constraints differ), so they are not duplicates.
Expanding out the optimization objective we get Quw*ruw^2 - 2*Quw*ruw*yuw + Quw*yuw^2
. We see that this is a quadratic function of the decision variables yuw
, and thus the solve.QP
method of the quadProg
package can be used to solve the optimization problem.
To abstract this out a bit, let's assume R=20
and C=10
describe the dimensions of the input matrices. Then there are R*C
decision variables and we can assign them order y11, y21, ... yR1, y12, y22, ... yR2, ..., y1C, y2C, ..., yRC
, reading down the columns of the matrix of variables.
From ?solve.QP
, we read that the objective takes the form -d'b + 0.5b'Db
for decision variables b
. The element of d
corresponding to decision variable yuw
has value 2*Quw*ruw
and D
is a diagonal matrix with the element corresponding to decision variable yuw
taking value 2*Quw
. Note that the solve.QP
function requires the D
matrix to be positive definite, so we require Quw > 0
for every u, w
pair.
The first R*(C-1)
constraints correspond to the yuw >= yu,w+1
constraints, and the next (R-1)*C
constraints correspond to the yuw >= yu-1,w
constraints. The next 2*R
constraints correspond to the yuC = 0
constraints (which are inputted as yuC >= 0
and -yuC >= 0
), and the last constraint is -yR1 >= -100
(which is logically equivalent to yR0 = 100
).
We can input this model into the quadProg
package with the following R commands, using random input data:
# Sample data
set.seed(144)
Quw <- matrix(runif(200), nrow=20)
ruw <- matrix(runif(200), nrow=20)
R <- nrow(Quw)
C <- ncol(Quw)
# Build constraint matrix
part1 <- matrix(0, nrow=R*(C-1), ncol=R*C)
part1[cbind(1:(R*C-R), 1:(R*C-R))] <- 1
part1[cbind(1:(R*C-R), (R+1):(R*C))] <- -1
part2 <- matrix(0, nrow=(R-1)*C, ncol=R*C)
pos2 <- as.vector(sapply(2:R, function(r) r+seq(0, R*(C-1), by=R)))
part2[cbind(1:nrow(part2), pos2)] <- 1
part2[cbind(1:nrow(part2), pos2-1)] <- -1
part3 <- matrix(0, nrow=2*R, ncol=R*C)
part3[cbind(1:R, (R*C-R+1):(R*C))] <- 1
part3[cbind((R+1):(2*R), (R*C-R+1):(R*C))] <- -1
part4 <- rep(0, R*C)
part4[R] <- -1
const.mat <- rbind(part1, part2, part3, part4)
library(quadProg)
mod <- solve.QP(Dmat = 2*diag(as.vector(Quw)),
dvec = 2*as.vector(ruw)*as.vector(Quw),
Amat = t(const.mat),
bvec = c(rep(0, nrow(const.mat)-1), -100))
We can now access the model solution:
# Objective (including the constant term):
mod$value + sum(Quw*ruw^2)
# [1] 9.14478
matrix(mod$solution, nrow=R)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,] 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.3215992 0.1818095 0.1818095 0.1818095 0.000000e+00
# [2,] 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.2882339 0.2882339 0.000000e+00
# [3,] 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.2882339 0.2882339 2.775558e-17
# [4,] 0.5728478 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.2882339 0.2882339 0.000000e+00
# [5,] 0.5728478 0.5111456 0.5111456 0.4699046 0.4346995 0.4346995 0.4346995 0.2882339 0.2882339 0.000000e+00
# [6,] 0.5728478 0.5111456 0.5111456 0.4699046 0.4346995 0.4346995 0.4346995 0.2882339 0.2882339 0.000000e+00
# [7,] 0.5728478 0.5111456 0.5111456 0.4699046 0.4346995 0.4346995 0.4346995 0.2882339 0.2882339 0.000000e+00
# [8,] 0.5728478 0.5111456 0.5111456 0.5111456 0.4346995 0.4346995 0.4346995 0.2882339 0.2882339 0.000000e+00
# [9,] 0.5728478 0.5111456 0.5111456 0.5111456 0.4346995 0.4346995 0.4346995 0.4346995 0.2882339 1.110223e-16
# [10,] 0.5728478 0.5111456 0.5111456 0.5111456 0.4346995 0.4346995 0.4346995 0.4346995 0.4346995 0.000000e+00
# [11,] 0.6298100 0.5111456 0.5111456 0.5111456 0.4518205 0.4346995 0.4346995 0.4346995 0.4346995 0.000000e+00
# [12,] 0.6298100 0.5111456 0.5111456 0.5111456 0.4518205 0.4346995 0.4346995 0.4346995 0.4346995 0.000000e+00
# [13,] 0.6298100 0.5111456 0.5111456 0.5111456 0.4518205 0.4346995 0.4346995 0.4346995 0.4346995 0.000000e+00
# [14,] 0.6298100 0.5111456 0.5111456 0.5111456 0.4518205 0.4346995 0.4346995 0.4346995 0.4346995 0.000000e+00
# [15,] 0.6298100 0.6009718 0.5111456 0.5111456 0.4518205 0.4346995 0.4346995 0.4346995 0.4346995 0.000000e+00
# [16,] 0.6298100 0.6009718 0.6009718 0.6009718 0.4518205 0.4346995 0.4346995 0.4346995 0.4346995 0.000000e+00
# [17,] 0.6298100 0.6009718 0.6009718 0.6009718 0.6009718 0.4346995 0.4346995 0.4346995 0.4346995 0.000000e+00
# [18,] 0.6298100 0.6009718 0.6009718 0.6009718 0.6009718 0.6009718 0.4346995 0.4346995 0.4346995 0.000000e+00
# [19,] 0.6298100 0.6009718 0.6009718 0.6009718 0.6009718 0.6009718 0.4346995 0.4346995 0.4346995 0.000000e+00
# [20,] 0.6298100 0.6009718 0.6009718 0.6009718 0.6009718 0.6009718 0.5643033 0.5643033 0.5643033 0.000000e+00