Question

我正在尝试深入研究优化并且一直在使用lpSolveAPI包。示例将演示我的简单设置。

数据（每行包含不同的变量）：

M.update({key:((M[key] + value) if key in M else value) for key, value in N.items()})

创建空模型，包含5个变量（test.df中的行），我希望最大化我的目标。

dput(test.df)
    structure(list(objective = c(-0.162235888601422, -0.168597233981057, 
    -0.165558234725657, -0.156096491294958, -0.15294764940114), constrain1 = c(1.045, 
    1.259, 1.792, 2.195, 2.802)), .Names = c("objective", "constrain1"
    ), row.names = c(NA, -5L), class = "data.frame")

library(lpSolveAPI)

让我们添加一些约束。

test.lp <- make.lp(0, NROW(test.df))
set.objfn(test.lp, test.df$objective)
lp.control(test.lp,sense='max')

我想创建一个更多的约束，即在solve中只使用x个变量。因此，如果我将其设置为2，它将使用其中2个变量创建最佳解决方案。我试过了add.constraint(test.lp, test.df$constrain1, "=", 2) add.constraint(test.lp, rep(1, nrow(test.df)), "=", 1) set.bounds(test.lp, upper = rep(0.5, nrow(test.df))) set.bounds(test.lp, lower = rep(0, nrow(test.df))) RowNames <- c("constraint1", "constraint2") ColNames <- paste0("var", seq(1, nrow(test.df))) dimnames(test.lp) <- list(RowNames, ColNames)但是没有成功。

Answer 1

我认为你想添加一个限制，将非零变量x(i)的数量限制为2.计数不能在LP中真正完成，但可以表示为MIP。

标准公式是将二进制变量y(i)引入：

x(i) <= y(i)*xup(i)      (implication: y(i)=0 => x(i)=0)
sum(i, y(i)) <= 2     
0 <= x(i) <= xup(i)      (bounds)
y(i) in {0,1}            (binary variables)

对于较大的问题，这可能比解决每个可能的组合更有效。虽然k=2中的N并不是那么糟糕：N choose k = N*(N-1)/2可能的组合。

Answer 2

这里有一些代码，展示了如何将@ErwinKalvelagen提到的技术应用于R中的lpSolveAPI。主要是为问题添加额外的二进制变量。

library(lpSolveAPI)
fun1 <- function(n=3) {
    nx <- 5

    # set up lp
    lprec <- make.lp(0, 2*nx) # one var for the value x(i) and one var y(i) binary if x(i) > 0
    set.objfn(lprec, c(-0.162235888601422, -0.168597233981057, -0.165558234725657, -0.156096491294958, -0.15294764940114, rep(0, nx)))
    lp.control(lprec,sense='max')
    set.type(lprec, columns=seq(nx+1,2*nx), "binary") # y(i) are binary vars

    # add constraints as in the question
    set.bounds(lprec, upper=rep(0.5, nx), columns=seq(1,nx)) # lpsolve implicitly assumes x(i) >= 0, so no need to define bounds for that
    add.constraint(lprec, c(1.045, 1.259, 1.792, 2.195, 2.802, rep(0, nx)), "=", 2)
    add.constraint(lprec, c(rep(1, nx), rep(0, nx)), "=", 1)

    # additional constraints as suggested by @ErvinKarvelagen
    for (i in seq(1,nx)) add.constraint(lprec, xt=c(1, -0.5), type="<=", rhs=0, indices=c(i, nx+i)) # x(i)<=y(i)*0.5
    add.constraint(lprec, c(rep(0,nx), rep(1,nx)), "<=", n) # sum(y(i))<=2 (if set to 3, it finds a solution)

    # solve and print solution
    status <- solve(lprec)
    if(status!=0) stop("no solution found, error code=", status)
    sol <- get.variables(lprec)[seq(1, nx)]
    return(sol)
}

但请注意，如果您只需要两个x（i）大于零，则问题变得不可行。您至少需要三个才能满足给定的约束条件。（这由参数n完成）。另请注意，set.row从长远来看比add.constraint效率更高。

阐述@ ErwinKalvelagen的第二个评论，另一种方法是简单地从5个可能的变量组合中取出每个n并解决这些n个变量。转换为R代码，这将成为

fun2 <- function(n=3) {
    nx <- 5

    solve_one <- function(indices) {
        lprec <- make.lp(0, n) # only n variables
        lp.control(lprec,sense='max')
        set.objfn(lprec, c(-0.162235888601422, -0.168597233981057, -0.165558234725657, -0.156096491294958, -0.15294764940114)[indices])
        set.bounds(lprec, upper=rep(0.5, n))
        add.constraint(lprec, c(1.045, 1.259, 1.792, 2.195, 2.802)[indices],"=", 2)
        add.constraint(lprec, rep(1, n), "=", 1)
        status <- solve(lprec)
        if(status==0) 
            return(list(obj = get.objective(lprec), ind=indices, sol=get.variables(lprec)))
        else
            return(list(ind=indices, obj=-Inf))
    }

    sol <- combn(nx, n, FUN=solve_one, simplify=FALSE)
    best <- which.max(sapply(sol, function(x) x[["obj"]]))
    return(sol[[best]])
}

两个代码都返回相同的解决方案，但第一个解决方案要快得多：

library(microbenchmark)
microbenchmark(fun1(), fun2(), times=1000, unit="ms")
#Unit: milliseconds
#   expr      min       lq      mean   median       uq       max neval
# fun1() 0.429826 0.482172 0.5817034 0.509234 0.563555  6.590409  1000
# fun2() 2.514169 2.812638 3.2253093 2.966711 3.202958 13.950398  1000

在lpSolveAPI R中添加计数约束

2 个答案: