Линейное программирование с условными ограничениями в R

Question

У меня проблема с линейным программированием, где я пытаюсь выбрать из нескольких бинарных ресурсов, чтобы оптимизировать значение, в основном проблему с рюкзаком. Проблема, с которой я сталкиваюсь, заключается в том, что разные ресурсы имеют общие характеристики, и я хочу, чтобы мое окончательное решение имело либо 0, либо 2 ресурсов с определенным признаком. Есть ли способ сделать это? Я не мог думать об одном или найти его, несмотря на обширный поиск. В моих данных переменные решения являются ресурсами, а ограничения являются характеристиками этих ресурсов. Рассмотрим следующий код:

library(lpSolve) 
const_mat_so<-matrix(c(
    c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,1,0,0,1,0,1) 
    ,c(0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0,1,1,0,0,1,1) 
    ,c(0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1,0,1,0,1,0,0) 
    ,c(1, 1, 0, 1, 1, 0, 0, 0, 1, 0, 0,0,0,0,0,0,0) 
    ,c(8800, 8500, 7600, 8600, 8400, 7500, 7000, 8500, 8800, 7700, 6700,5500,1200,6700,9500,8700,6500) 
    ,c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,0,0,0,0,0,0) 
    ,c(0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,0,0,0,0,0,0) 
    ,c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,0,0,0,0,0,0) 
    ,c(0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1,0,0,1,0,1,0) 
    ,c(0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0,1,1,0,0,0,0) 
    ,c(0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0,0,0,0,0,0,0) 
    ,c(0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0,1,1,1,0,1,0) 
    ,c(0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0,0,0,0,0,1,0) 
    ,c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,0,0,0,1,0,0) 
    ,c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1,0,0,0,0,0,0) 
    ),nrow=15,byrow = TRUE) 

const_dir_so<-c("=","=","=","=","<=","<=","<=","<=","<=","<=","<=","<=","<=","<=","<=") 

max_cost_so = 25000 

objective_so = c(21.0, 19.3, 19.2, 18.8, 18.5, 16.6, 16.4, 16.4, 16.0, 16.0, 14.9, 14.6, 14.0, 13.9,12.0,5.5,24.6) 

const_rhs_so<-c(1,1,1,1,25000,3,3,3,2,2,2,2,2,2,2) 

x = lp ("max", objective_so, const_mat_so, const_dir_so, const_rhs_so,  all.bin=TRUE, all.int=TRUE 
    ) 

> x 
Success: the objective function is 68.1 

> x$solution 
[1] 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 

Хотя выше производит решение, это не решение, которое я хочу, потому что я на самом деле хочу последние семь ограничений должно быть> = 2 или 0. Я понятия не имею, как закодировать это или это возможно. Любая помощь будет оценена по достоинству. Я не являюсь линейным программированием, поэтому, пожалуйста, простите любые заблуждения относительно подхода.

Answer 1

Я понимаю, что каждый из последних 7 ограничений должны быть больше, чем 2 или равен нулю, т.е. не 1.

1) Есть только 7 таких ограничений, так есть 2^7 = 128 возможностей, которые достаточно малы, чтобы мы могли просто запускать каждого из них, используя формулировку, учитывая, что он задает вопрос без чрезмерного времени исполнения, а затем набирает максимальное количество.

dec2bin принимает основание 10 (то есть десятичное) число и преобразует его в двоичный вектор 0s и 1s. Запуск его на каждое число между 0 и 127 дает двоичные числа, так что 1s соответствуют ограничениям, которые составляют> = 2 (при этом остальные равны 0).

dec2bin <- function(dec, digits = 7) { 
    # see http://stackoverflow.com/questions/6614283/converting-decimal-to-binary-in-r 
    tail(rev(as.integer(intToBits(dec))), digits) 
} 

runLP <- function(i) { 
    bin <- dec2bin(i) 
    n <- length(const_rhs_so) # 15 
    ix <- seq(to = n, length = length(bin)) # indexes of last 7 constraints, i.e. 9:15 
    const_dir_so[ix] <- ifelse(bin, ">=", "=") 
    const_rhs_so[ix] <- 2*bin 
    lp("max", objective_so, const_mat_so, const_dir_so, const_rhs_so, all.bin = TRUE) 
} 

lpout <- lapply(0:127, runLP) 
ixmax <- which.max(sapply(lpout, "[[", "objval")) 
ans <- lpout[[ixmax]] 
ans 
ans$solution 
tail(c(const_mat_so %*% ans$solution), 7) 

дает:

> ans 
Success: the objective function is 62 
> ans$solution 
[1] 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 
> tail(c(const_mat_so %*% ans$solution), 7) # last 7 constraint values 
[1] 0 0 0 0 0 0 0 

2) Во второй альтернативе @Erwin Kalvelagen в это относится к сдерживающим переменные, но я думаю, что имел в виду, что x в своем ответе является значение LHS из одно из последних 7 ограничений. То есть, если C является матрицей исходных последних 7 ограничений затем заменить эти оригинальные 7 ограничений с этими 14 ограничений:

Cx + D1 y <= 0 
Cx + D2 y >= 0 

где D1 представляет собой диагональная матрица, диагональные элементы которой являются любым достаточно большим отрицательным числом и D2 является диагональная матрица, диагональные элементы которой равны -2. Здесь мы оптимизируем более x и y векторов двоичных переменных. Переменные x находятся в вопросе, и есть 7 новых двоичных переменных y, так что y [i] равно 0, чтобы ограничить i-е из последних 7 исходных ограничений 0 или 1, чтобы ограничить его до 2 или более. Переменные y называются bin в (1). Коэффициенты переменных y в объекте равны нулю.

В терминах lpSolve R кода:

objective_so2 <- c(objective_so, numeric(7)) 
const_mat_so2 <- cbind(rbind(const_mat_so, const_mat_so[9:15, ]), 
         rbind(matrix(0, 8, 7), diag(-100, 7), diag(-2, 7))) 
const_dir_so2 <- c(const_dir_so, rep(">=", 7)) 
const_rhs_so2 <- c(const_rhs_so[1:8], numeric(14)) 
x2 = lp ("max", objective_so2, const_mat_so2, const_dir_so2, const_rhs_so2, all.bin = TRUE) 

дает то же значение, что и в 62 (1). Переменные y (последние 7) - все 0, что также соответствует (1). Это также обеспечивает двойную проверку, поскольку теперь два метода дают согласованные ответы.

> x2 
Success: the objective function is 62 
> x2$solution 
[1] 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 

Answer 2

Я считаю, что LpSolve поддерживает полунепрерывные переменные.Полунепрерывная переменная с нижней границей L и верхней границей U может принимать значения 0 или между L и U. Я не уверен, что пакет R lpSolve поддерживает этот тип переменной.

Однако мы можем имитировать это с дополнительной двоичной переменной y и дополнительными ограничениями. Таким образом, вы должны сделать свой x переменного непрерывного (или целым число, если вы хотите только целые значения), и добавить ограничение:

2*y <= x <= U*y 

где U является верхней границей для x.

Answer 3

lpSolveAPI пакет обеспечивает более продвинутый интерфейс к «lp_solve». Как отметил @Erwin Kalvelagen, «lp_solve» и lpSolveAPI поддерживают полунепрерывную переменную (полунепрерывные переменные решения могут принимать допустимые значения между их верхней и нижней границей, а также нулями). А матрица ограничений позволяет передавать выходы 9-15-х формул ограничения в 18-24-ю переменные. Например (около 9-го ограничения), когда x6 + x11 + x14 + x16 - x18 = 0, x6 + x11 + x14 + x16 = x18. Поэтому я думаю, что вы можете управлять x6 + x11 + x14 + x16 через полунепрерывную переменную, x18.

library(lpSolveAPI) 

    ## add 18-24th cols to define the 18-24th variables 
const_mat_so2 <- cbind(const_mat_so, rbind(matrix(0, nrow = 8, ncol = 7), diag(-1, 7))) 

    ## [EDITED] make a model and set a constraint matrix and objective coefs 
model <- make.lp(nrow(const_mat_so2), 0) 

for(i in 1:ncol(const_mat_so2)) add.column(model, const_mat_so2[,i]) 
set.constr.type(model, c(const_dir_so[-c(9:15)], rep("=", 7))) 
set.rhs(model, c(const_rhs_so[-c(9:15)], rep(0, 7))) # each original output - 18-24th = 0 

set.objfn(model, c(objective_so, rep(0, 7)))   # 18-24th are 0 

    ## define semi-continuous and bounds. 
set.semicont(model, col = 18:24) 
set.bounds(model, lower = rep(1.9, 7), col = 18:24) # default upper is Inf. 

    ## define other things 
set.type(model, col = 1:17, type = "binary")  # original variable 
set.type(model, col = 18:24, type = "integer") # outputs of original constraint formulas 
lp.control(model, sense = "max")     # do maximize 

# write.lp(model, "filename.lp", "lp") # if you want to watch the whole model 

solve(model) 
get.variables(model) 
# [1] 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 [18] 0 0 0 0 0 0 0 
get.objective(model) 
# [1] 62 
t(const_mat_so %*% res[1:17]) 
#  [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] 
# [1,] 1 1 1 1 22300 1 0 0 0  0  0  0  0  0  0