How to set up a Linear Programming Problem with lpSolveAPI in R

Question

I'm running into a problem setting up a linear programming problem in R using lpSolveAPI.

I have up to seven decision variables and would like to select the variables that maximize a linear reward function within some budget. An additional constraint is added that determines if a particular variable is able to be selected.

# set the minimum number of variables to be chosen
min_select <- 3
# set a budget
budget <- 381
# set a cost for each variable, incurred if selected
costs <- c(4289.31047,   36.80011,  247.96872, 5493.60997,   59.53517,   36.80011, 5984.42040)
# set an availabiliy vector. When a value is 1, that variable can be selected. If 0, it cannot
var_availability <- c(1,1,1,1,1,1,1)
# set the reward function coefficients
rewards <- c(1.78341784, 0.07973014, 0.45745560, 1.84883011, 0.17699768, 0.12815014, 2.65000395)

I have tried to set up a function that returns the result vector that denotes which variables are selected. If the problem is infeasible due to the constraints, I want it to print out how much the budget would need to be increased to make the problem feasible.

get_lp_result <- function(min_select, budget, costs, var_availability, rewards)
{
  var_count <- length(var_availability)
  # set up with constraints, +2 for the budget and availability constraints
  my.lp <- make.lp(var_count+2, var_count)
  reward <- matrix(rewards, nrow=1, byrow=TRUE)
  # determines what variables can be selected
  selection_coeff <- matrix(rep(1, times=length(var_availability)), nrow=1, byrow=TRUE)
  costs <- matrix(costs, nrow=1, byrow=TRUE)
  
  # set budget constraint
  set.row(my.lp, 1, selection_coeff)
  set.row(my.lp, 2, costs)

  # set availability constraints
  diag.mat <- diag(1, nrow=length(var_availability), ncol=length(var_availability))
  for(i in 1:length(var_availability))
  {
    set.row(my.lp, i+2, diag.mat[i,])
  }
  
  # set objective function
  set.objfn(my.lp, rewards)
  set.type(my.lp, 1:length(reward), "binary")
  
  # set equality symbols
  eq <- rep("<=", times=var_count + 2) # + 2 for constraints
  # set the first eq. to ensure minimum number of variables is selected
  eq[1] <- ">="
  set.constr.type(my.lp, eq)
  
  # set RHS of the equation
  set.rhs(my.lp, c(min_select, budget, var_availability))
  
  delay=30
  # set to maximize criticality scores
  lp.control(my.lp, timeout=delay, sense="max") # set timeout reset in seconds
  solve(my.lp)
  result <- get.variables(my.lp)
  ## write the model to file to review
  write.lp(my.lp,'_lp_model_setup.lp',type='lp')
  # if an optimal result isn't obtained, looks at the duals
  if(sum(result) == 0)
  {
    sens <- get.sensitivity.rhs(my.lp)
    # is this the additional value that needs to be added to the budget
    # in order to meet the constraints?
    return(print(paste("Budget needs to increase by", sens$dualstill[2])))
  }else
  {
    return(result)
  }
}

With this initial setup everything seems to be working:

result <- get_lp_result(min_select, budget, costs, var_availability, rewards)
# min number of selections constraint is met
result
[1] 0 0 1 0 1 1 0
# budget constraint is met
sum(costs*result)
[1] 344.304
# availability constraint is met
(var_availability - result >= 0)
[1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE

If I increase the minimum variable selection constraint for the problem to become infeasible, the output indicates how much more the budget must increase:

min_select <- 4

get_lp_result(min_select, budget, costs, var_availability, rewards)
[1] "Budget needs to increase by 0.104109999999262"

If I go ahead and increase the budget accordingly, I get a feasible result that meets the constraints:

budget <- budget + 0.11
get_lp_result(min_select, budget, costs, var_availability, rewards)
[1] 0 1 1 0 1 1 0

All seems to be working. However, if I continue to increase the minimum variable selection constraint, I get a non-sensical result:

min_select <- 6
get_lp_result(min_select, budget, costs, var_availability, rewards)
[1] "Budget needs to increase by 15767.3349499933"

The above doesn't make sense because the sum of the cost of the six lowest cost variables is less than the budget increase above:

sum(costs[order(costs)[1:6]])
[1] 10164.02

I shouldn't need a budget above this amount to get a feasible solution. If I increase the budget to exactly the cost of the six lowest cost variables, I get a feasible result, which contradicts the previously reported necessary budget increase:

budget <- sum(costs[order(costs)[1:6]])
get_lp_result(min_select, budget, costs, var_availability, rewards)
[1] 1 1 1 1 1 1 0

Obviously, I'm either setting up the problem incorrectly or misinterpreting the sensitivity results. How should this problem be set up?

Note that sensitivity analysis is only available for pure, continuous LPs. Your model has binary variables. — Erwin Kalvelagen, Dec 24 '21 at 06:53
@Erwin Kalvelahen is there another way to determine the budget increase necessary? — coolhand, Dec 24 '21 at 17:50
Use an elastic formulation where you can increase the budget but at a hefty price. — Erwin Kalvelagen, Dec 25 '21 at 06:22
@Erwin Kalvelager I’m assuming you mean at a hefty increase in compute time? Or do you literally mean increase the budget itself? — coolhand, Dec 26 '21 at 15:19
Increase the budget. An extra dollar costs n dollars where n is large. — Erwin Kalvelagen, Dec 26 '21 at 16:10

How to set up a Linear Programming Problem with lpSolveAPI in R

0 Answers0