Hinzufügen von Zählereinschränkungen in lpSolveAPI R

Question

Ich versuche, in die Optimierung einzutauchen und habe mit dem Paket lpSolveAPI herumgespielt. Beispiel zeigt meine einfache Einrichtung.

Daten (jede Zeile enthält verschiedene variable):

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) 

leeres Modell erstellen, mit 5 Variablen (Zeilen in test.df) und ich will mein Ziel maximieren.

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

Fügen wir einige Einschränkungen hinzu.

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) 

würde Ich mag ONEMORE Zwang erstellen, die nur x Anzahl der Variablen, die Verwendung wäre in lösen. Wenn ich es also auf 2 setze, würde es eine optimale Lösung mit 2 dieser Variablen schaffen. Ich habe versucht set.type = "binary", aber das war nicht erfolgreich.

Answer 1

Hier ein Code, der zeigt, wie man die von @ErwinKalvelagen erwähnte Methode auf lpSolveAPI in R anwendet. Der Hauptpunkt besteht darin, den Problemen zusätzliche binäre Variablen hinzuzufügen.

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) 
} 

Beachten Sie jedoch, dass das Problem wird nicht durchführbar, wenn Sie verlangen, dass nur zwei x (i) größer Null ist. Sie brauchen mindestens drei, um die gegebenen Einschränkungen zu erfüllen. (Dies geschieht durch den Parameter n). Beachten Sie auch, dass set.row auf lange Sicht effizienter ist als add.constraint.

Bei ErwanKalvelagens zweitem Kommentar besteht ein weiterer Ansatz darin, einfach jedes n aus den 5 möglichen Variablenkombinationen zu nehmen und diese n Variablen zu lösen. R-Code übersetzt zu, dies würde

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]]) 
} 

Beide Codes die gleiche Lösung zurückkehren, aber die erste Lösung ist viel schneller:

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 

Answer 2

Ich denke, dass Sie eine Einschränkung hinzufügen möchten, die die Anzahl der Variablen x(i) von 0 auf Null beschränkt. Zählen kann nicht wirklich in einem LP durchgeführt werden, aber es kann als ein MIP formuliert werden.

Eine Standardformulierung wäre Binärgrößen einzuführen y(i) mit:

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) 

Für größere Probleme kann dies viel effizienter als jede mögliche Kombination zu lösen. Obwohl k=2N nicht so schlecht ist: N choose k = N*(N-1)/2 mögliche Kombinationen.