Setting Up a Linear Programming Scheduling Problem in R-CodePudding

I have a linear programming scheduling problem built in Excel that I would like to re-create in R.

I have seven items to schedule across five periods. A sample (non-optimal) schedule may look like:

S <- matrix(c(0,0,1,0,0,0,0,0,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,1,0), nrow=5, ncol=7, byrow=TRUE)

> S
     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    0    0    1    0    0    0    0
[2,]    0    1    0    0    0    0    1
[3,]    1    0    0    0    0    0    0
[4,]    0    0    0    0    1    0    0
[5,]    0    0    0    1    0    1    0

where each column is an item and each row is a period. They must be a binary selection of either scheduled or not-scheduled.

Each item/period selection comes with an associated 'reward'. These rewards are pre-defined, with an example as:

R <- matrix(c(1.78, .080, .46, 1.85, .18, .13, 2.65, 1.78, .080, .46, 3.15, .16, .13, 2.66, 1.78, .080, .40, 3.15, .16, .13, 2.17, 1.63, .072, .40, 3.06, .16, .12, 2.22, 1.66, .072, .40, 3.34, .16, .13, 2.19), nrow=5, ncol=7, byrow=TRUE)

> R
     [,1]  [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 1.78 0.080 0.46 1.85 0.18 0.13 2.65
[2,] 1.78 0.080 0.46 3.15 0.16 0.13 2.66
[3,] 1.78 0.080 0.40 3.15 0.16 0.13 2.17
[4,] 1.63 0.072 0.40 3.06 0.16 0.12 2.22
[5,] 1.66 0.072 0.40 3.34 0.16 0.13 2.19

So, in the example [R] above, if the 1st [,1] item was scheduled in the fifth period [5,] it would get a reward = 1.66.

The reward by each period-item is

> R*S
     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 0.00 0.00 0.46 0.00 0.00 0.00 0.00
[2,] 0.00 0.08 0.00 0.00 0.00 0.00 2.66
[3,] 1.78 0.00 0.00 0.00 0.00 0.00 0.00
[4,] 0.00 0.00 0.00 0.00 0.16 0.00 0.00
[5,] 0.00 0.00 0.00 3.34 0.00 0.13 0.00

I would like to schedule each item exactly once and to have no more than two items scheduled in a period. I would like to maximize the reward. I.e.,

max_select <- 2
# 
# maximize reward:
# maximize: sum([R]*[S])
# s.t.
# each item is only selected once:
# sum(S[,j]) = 1
# no more than two items selected per period:
# sum(S[i,]) <= max_select

I'm having some difficulty setting this up with lpSolveAPI.

CodePudding user response：

Set the objective function to c(R) and the constraints to c(row(R) == i) for each row index i and c(col(R) == j) for each column index j. Also set the variables to be binary.

library(lpSolveAPI)

nr <- nrow(R)
nc <- ncol(R)
L <- make.lp(nr nc, nr*nc)

set.objfn(L, c(R))
control <- lp.control(L, sense = "max")
for(i in 1:nr) add.constraint(L, c(row(R) == i), "<=", 2)
for(j in 1:nc) add.constraint(L, c(col(R) == j), "=", 1)
for(k in seq_along(R)) set.type(L, k, type = "binary")

solve(L) # 0 means succeeded
## [1] 0

matrix(get.variables(L), nr, nc)
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,]    0    1    0    0    1    0    0
## [2,]    0    0    1    0    0    0    1
## [3,]    1    0    0    0    0    1    0
## [4,]    0    0    0    0    0    0    0
## [5,]    0    0    0    1    0    0    0

get.objective(L)
## [1] 8.63

# check that we got a larger objective value than S
sum(R * S)
## [1] 8.61