How to solve linear programming model in R - r

Question

I need to solve the following microeconomic problem:
I have six assets I can produce (asset 1 - 6) across five years (2011 - 2015).
Each asset can only be produced during one year.
Each asset must be produced in my five year period.
Production is not mutually exclusive; I can produce more than one good in a year without affecting the production of either.
Each asset has a fixed cost of production equal to 30.
I must have non-negative profit in each year; revenues must be at least 30.
Below is a matrix representing my potential revenue for producing each asset (i) in a given year (j).
2011 2012 2013 2014 2015
Asset1 35* 37 39 42 45
Asset2 16 17 18 19 20*
Asset3 125 130 136*139 144
Asset4 15 27 29 30* 33
Asset5 14 43* 46 50 52
Asset6 5 7 8 10 11*
The asterisks (*) represent what should be the optimal solution set.
How can I use R to solve for the production plan that maximizes my revenue (and therefore profit) subject to the constraints outlined. My output should be a similar 6x5 matrix of 0's and 1's, where 1's represent choosing to produce a good in a given year.

Answer 1

This is a classic problem, and one that needs to be reformulated.
Start by reformulating your problem
Max( sum_[i,t] (pi_[i,t] - C_[i,t]) * x_[i,t])
Sd.
sum_t x_[i,t] = 1 [ for all i ]
sum_i x_[i,t] >= 30 [ for all t ]
x_[i,t] >= 0 [for all i, t]
In the lpSolve package the maximization problem is given in a linear representation, eg. in non-matrix format. Lets start by making a vector representing our x_[i,t]. For ease let's name it (although this is not used), just so we can keep track.
n <- 6
t <- 5
#x ordered by column.
x <- c(35, 16, 125, 15, 14, 5, 37, 17, 130, 27, 43, 7, 39, 18, 136, 29, 46, 8, 42, 19, 139, 30, 50, 10, 45, 20, 144, 33, 52, 11)
# if x is matrix use:
# x <- as.vector(x)
names(x) <- paste0('x_[', seq(n), ',', rep(seq(t), each = n), ']')
head(x, n * 2)
x_[1,1] x_[2,1] x_[3,1] x_[4,1] x_[5,1] x_[6,1] x_[1,2] x_[2,2] x_[3,2] x_[4,2] x_[5,2] x_[6,2]
35 16 125 15 14 5 37 17 130 27 43 7
length(x)
[1] 30
Now now we need to create our conditions. Starting with the first condition
sum_t x_[i,t] = 1 [ for all i ]
we can create this rather simply. The thing to watch out for here, is that the dimension has to be right. We have a vector of length 30, so we'll need our conditions matrix to have 30 columns. In addition we have 6 assets, so we'll need 6 rows for this condition. Again lets name the rows and columns to keep track ourself.
cond1 <- matrix(0, ncol = t * n,
nrow = n,
dimnames = list(paste0('x_[', seq(n), ',t]'),
names(x)))
cond1[, seq(n + 1)]
x_[1,1] x_[2,1] x_[3,1] x_[4,1] x_[5,1] x_[6,1] x_[1,2]
x_[1,t] 0 0 0 0 0 0 0
x_[2,t] 0 0 0 0 0 0 0
x_[3,t] 0 0 0 0 0 0 0
x_[4,t] 0 0 0 0 0 0 0
x_[5,t] 0 0 0 0 0 0 0
x_[6,t] 0 0 0 0 0 0 0
Next we fill our the correct fields. x_[1,1] + x[1, 2] + ... = 1 and x_[2,1] + x_[2,2] + ... = 1 and so forth. Using a for loop is the simplest for this problem
for(i in seq(n)){
cond1[i, seq(i, 30, n)] <- 1
}
cond1[, seq(n + 1)]
x_[1,1] x_[2,1] x_[3,1] x_[4,1] x_[5,1] x_[6,1] x_[1,2]
x_[1,t] 1 0 0 0 0 0 1
x_[2,t] 0 1 0 0 0 0 0
x_[3,t] 0 0 1 0 0 0 0
x_[4,t] 0 0 0 1 0 0 0
x_[5,t] 0 0 0 0 1 0 0
x_[6,t] 0 0 0 0 0 1 0
We still have to create the RHS and specify direction but I'll wait with this for now.
So next lets create our matrix for the second condition
sum_i x_[i,t] >= 30 [ for all t ]
The process for this one is very similar, but now we need a row for each period, so the dimension of the matrix is 5x30. The main difference here, is we need to insert the values of x_[i, t]
cond2 <- matrix(0, ncol = t * n,
nrow = t,
dimnames = list(paste0('t=', seq(t)),
names(x)))
for(i in seq(t)){
cond2[i, seq(n) + n * (i - 1)] <- x[seq(n) + n * (i - 1)]
}
cond2[, seq(1, n * t, n)]
x_[1,1] x_[1,2] x_[1,3] x_[1,4] x_[1,5]
t=1 35 0 0 0 0
t=2 0 37 0 0 0
t=3 0 0 39 0 0
t=4 0 0 0 42 0
t=5 0 0 0 0 45
Note that I'm printing the result for x_[1, t] to illustrate we've got it right.
Last we have the final condition. For this we note the ?lpSolve::lp has an argument all.bin, and reading this, it states
Logical: should all variables be binary? Default: FALSE.
So since all variables are either 1 or 0, we simply set this value to TRUE. Before continuing lets combine our conditions into one matrix
cond <- rbind(cond1, cond2)
Now both the RHS and the direction are simply taken from the 2 conditions. From the documentation on the const.dir argument
Vector of character strings giving the direction of the constraint: each value should be one of "<," "<=," "=," "==," ">," or ">=". (In each pair the two values are identical.)
In our conditions we have 6 rows representing the first condition, and rows represeting condition 2. Thus we need n (6) times == and t (5) times >=.
cond_dir <- c(rep('==', n), rep('>=', t))
The RHS is created in a similar fashion
RHS <- c(rep(1, n), rep(30, t))
And that's it! Now we're ready to solve our problem using the lpSolve::lp function.
sol = lpSolve::lp(direction = 'max',
objective.in = x,
const.mat = cond,
const.dir = cond_dir,
const.rhs = RHS,
all.bin = TRUE)
sol$objval
[1] 275
The weights for the solution are stored in sol$solution
names(sol$solution) <- names(x)
sol$solution
x_[1,1] x_[2,1] x_[3,1] x_[4,1] x_[5,1] x_[6,1] x_[1,2] x_[2,2] x_[3,2] x_[4,2] x_[5,2] x_[6,2] x_[1,3] x_[2,3] x_[3,3]
1 0 0 0 0 0 0 0 0 0 1 0 0 0 1
x_[4,3] x_[5,3] x_[6,3] x_[1,4] x_[2,4] x_[3,4] x_[4,4] x_[5,4] x_[6,4] x_[1,5] x_[2,5] x_[3,5] x_[4,5] x_[5,5] x_[6,5]
0 0 0 0 0 0 1 0 0 0 1 0 0 0 1
matrix(sol$solution,
ncol = t,
dimnames = list(rownames(cond1),
rownames(cond2)))
t=1 t=2 t=3 t=4 t=5
x_[1,t] 1 0 0 0 0
x_[2,t] 0 0 0 0 1
x_[3,t] 0 0 1 0 0
x_[4,t] 0 0 0 1 0
x_[5,t] 0 1 0 0 0
x_[6,t] 0 0 0 0 1
Which we quickly see is the correct solution. :-)
Side note on costs
One may have noticed "Where the hell did the costs go?". In this specific case, costs are fixed and not very interesting. This means we can ignore these during the calculations because we know the total cost is going to be 30 * 6 = 180 (which has to be substracted from the objective value). However it is not uncommon that costs depend on various factors, and might affect the optimal solution. For illustration, I'll include how we could incorporate costs in this example here.
First we'll have to extend our objective vector to incorporate the costs for each product at each period
Fixed_C <- -30
x <- c(x, rep(Fixed_C, n * t))
Next we'll add a pseudo-constraint
x_[i,t] - C_[i,t] = 0 [for all i, t]
This constraint ensures that if x_[i,t] = 1 then the relevant cost is added to the problem. There's 2 ways to create this constraint. The first is to have a matrix with n * t rows, one for each cost and period. Alternatively we can use our first constraint and actually live with only a single constrant
sum_[i,t] x_[i,t] - C_[i,t] = 0
because our first constraint makes sure x[1, 1] != x[1, 2]. So our third constraint becomes
cond3 <- c(rep(1, n * t), rep(-1, n * t))
Lastly we have to extend our RHS and condition 1 and 2 matrices. Simply add 0's to the condition matrices to make the dimensions fit.
cond1 <- cbind(cond1, matrix(0, nrow = n, ncol = n * t))
cond2 <- cbind(cond2, matrix(0, nrow = n, ncol = n * t))
cond <- rbind(cond1, cond2, cond3)
cond_dir <- c(cond_dir, '==')
RHS <- c(RHS, 0)
And now we can once again find the optimal solution using lpSolve::lp
solC = lpSolve::lp(direction = 'max',
objective.in = x,
const.mat = cond,
const.dir = cond_dir,
const.rhs = RHS,
all.bin = TRUE)
solC$objval
[1] 95
which is equal to our previous value 275 minus our fixed costs Fixed_C * n = 180.