使用lpSolveAPI设置依赖于所选变量的求解器约束

时间:2018-05-15 05:04:09

标签: r mathematical-optimization linear-programming

我使用lpSolveAPI运行线性编程模型。我能够让模型工作,但我想添加一个约束,我不知道该怎么做,或者它是否可行。模型的细节:

  1. 共选择5项,最大化价值并将成本保持在5k以下。
  2. 每个项目都有2"类型"。它们标记为type1 = A,B,C,D或E,type2 = X或Y.
  3. 4项必须是X型,1必须是Y型
  4. 以下示例效果很好,但我想再添加两个约束,我不确定如何做到这一点。另外两个限制因素:

    1. 我希望每次优化至少有2个type1个实例。我不在乎哪种类型有多种或两种不同的类型是倍数(例如2 A&2和C')这就是为什么我想到的它作为"或"约束(A> 2或B> 2或......)。

    2. 这个可能会有点困难:无论是哪种类型的"键入Y"被选中,我不希望type1再次出现。所以说Y项目是type1 = C,我希望所有其他选择的项目都不是C.我想我还需要添加另一个虚拟矩阵,交互type1type2

    3. 期望结果的示例:

         id type1 type2 value cost 
      10 10     B     X    19  865
      11 11     C     Y    19 1097 
      18 18     D     X    19 1005
      40 40     B     X    20  956
      45 45     A     X    20  980
      

      工作示例:

      library(dplyr)
      library(lpSolveAPI)
      
      # setup df
      id <- 1:50
      type1 <- sample(c('A', 'B', 'C', 'D', 'E'), length(id), replace = T)
      type2 <- sample(c('X', 'X', 'X', 'Y'), length(id), replace = T)
      value <- round(runif(length(id), 0, 20),0)
      cost <- round(runif(length(id), 750, 1250),0)
      
      df <- data.frame(id, type1, type2, value, cost) %>% 
        mutate(total = 1)
      
      # Attach dummy vars
      type1Dummy <- as.data.frame.matrix(table(df$id, df$type1))
      type2Dummy <- as.data.frame.matrix(table(df$id, df$type2))
      df <- cbind(df, type1Dummy, type2Dummy)
      
      # constraints
      totalNum <- 5
      totalCost <- 5000
      totalX <- 4
      totalY <- 1
      rhs <- c(totalNum, totalCost, totalX, totalY)
      
      # Direction vector
      numDir <- '=='
      costDir <- '<='
      xDir <- '=='
      yDir <- '=='
      dir <- c(numDir, costDir, xDir, yDir)
      
      # Setup opt
      obj <- df$value
      mat <- data.frame(total = df$total, cost = df$cost, X = df$X, Y = df$Y)
      
      
      # Solver Setup
      lprec <- make.lp(4, nrow(mat))
      
      for(i in 1:nrow(mat)){
        vals <- mat[i,] %>% as.numeric(.)
        set.column(lprec, i, vals)
      }
      
      set.objfn(lprec, df$value)
      set.constr.type(lprec, dir)
      set.rhs(lprec, rhs)
      
      for(i in 1:nrow(mat)){
        set.type(lprec, i, "binary")
      }
      
      # Add constraint with dummy variables that are {0,1} if more than 1 are selected.
      # z1 <- ifelse(sum(x[type1 == 'A']) > 1, 1, 0)
      # z2 <- ifelse(sum(x[type1 == 'B']) > 1, 1, 0)
      # etc...
      # add.constraint(lprec, z1 + z2 + z3 + z4 + z5, ">", 1) # "at least one of the groupings needs more than 1.
      
      lp.control(lprec,sense='max')
      
      solve(lprec)
      get.objective(lprec)
      sol <- get.variables(lprec)
      
      
      df$selected <- sol
      dfSolved <- df[df$selected == 1,]
      dfSolved
      

      感谢您的帮助!

1 个答案:

答案 0 :(得分:1)

这个花了一段时间。约束集1.是可行的,但第二个(如果Y是C,任何X不能是C)都需要一些杂耍。

我让它工作,但代码看起来不太好。也许很难遵循。所以我建议你先看看下面我印刷的LP。一旦你按照我介绍的新变量和新变量进行操作,代码可能会更容易理解。

为方便起见,我清楚地命名了变量和约束。看看这是否有帮助。

At least 2 instances of Type 1要求进行建模

为了强制执行此操作,我们需要5个新变量和6个新约束。 让我们创建五个新的0/1变量,称为dblAdblB,... dblE

现在简单的约束是:

 dblA +dblB +dblC +dblD +dblE >= 1

现在,如何强制执行:

如果所选项目中至少有两个A,则dblA应为1?

sum(over all items that have Type 1 = A) >= 2 dblA

dblA是0/1变量。如果为0,则带有A的项目可以是任意数字。     如果dblA为1,那么不等式会强制所选项目中的至少两个Type 1 A.有五个这样的约束,每个约束从A到E调用在下面的表述中AAEE

配方,使用LPSolveAPI打印

/* Objective function */
max: +6 x1 +6 x2 +8 x3 +16 x4 +6 x5 +5 x6 +17 x7 +11 x8 +10 x9 +7 x10 +9 x11 +4 x12 +3 x13 +11 x14 +15 x15
 +17 x16 +13 x17 +19 x18 +12 x19 +8 x20 +16 x21 +4 x22 +16 x23 +16 x24 +x26 +16 x27 +16 x28 +18 x29 +16 x30
 +4 x31 +7 x32 +12 x33 +19 x34 +4 x35 +13 x36 +5 x37 +20 x38 +4 x39 +3 x40 +x41 +6 x42 +5 x43 +13 x44
 +11 x45 +16 x46 +16 x47 +3 x48 +x49 +8 x50;

/* Constraints */
Take_5: +x1 +x2 +x3 +x4 +x5 +x6 +x7 +x8 +x9 +x10 +x11 +x12 +x13 +x14 +x15 +x16 +x17 +x18 +x19 +x20 +x21 +x22
 +x23 +x24 +x25 +x26 +x27 +x28 +x29 +x30 +x31 +x32 +x33 +x34 +x35 +x36 +x37 +x38 +x39 +x40 +x41 +x42
 +x43 +x44 +x45 +x46 +x47 +x48 +x49 +x50 <= 5;
budget: +1161 x1 +795 x2 +962 x3 +996 x4 +825 x5 +788 x6 +846 x7 +977 x8 +1130 x9 +1092 x10 +1168 x11 +1113 x12
 +757 x13 +803 x14 +936 x15 +1001 x16 +830 x17 +1138 x18 +1179 x19 +970 x20 +1206 x21 +1008 x22 +793 x23
 +803 x24 +834 x25 +923 x26 +1056 x27 +815 x28 +798 x29 +1075 x30 +872 x31 +808 x32 +796 x33 +781 x34
 +1224 x35 +1165 x36 +1238 x37 +1114 x38 +935 x39 +1212 x40 +803 x41 +1086 x42 +869 x43 +921 x44 +941 x45
 +758 x46 +1108 x47 +927 x48 +1009 x49 +921 x50 <= 5000;
X_4: +x1 +x3 +x4 +x5 +x6 +x7 +x8 +x10 +x11 +x12 +x13 +x14 +x16 +x17 +x18 +x20 +x21 +x22 +x23 +x24 +x25 +x26
 +x27 +x28 +x29 +x30 +x32 +x33 +x34 +x35 +x36 +x38 +x39 +x40 +x41 +x42 +x43 +x44 +x46 +x48 +x49 +x50 <= 4;
Y_1: +x2 +x9 +x15 +x19 +x31 +x37 +x45 +x47 <= 1;

/* Constraints: Must pick at least one of the Double variables */
AA: +x2 +x3 +x7 +x8 +x12 +x18 +x24 +x25 +x26 +x43 +x45 -2 dblA >= 0;
BB: +x10 +x13 +x23 +x30 +x32 +x35 +x37 +x39 +x40 +x46 +x48 -2 dblB >= 0;
CC: +x4 +x16 +x28 +x41 +x44 +x47 -2 dblC >= 0;
DD: +x1 +x6 +x9 +x11 +x14 +x15 +x17 +x20 +x21 +x29 +x31 +x34 -2 dblD >= 0;
EE: +x5 +x19 +x22 +x27 +x33 +x36 +x38 +x42 +x49 +x50 -2 dblE >= 0;
Pick2of1: +dblA +dblB +dblC +dblD +dblE >= 1;

/* Constraints: if Y is A, then none of the X's can be. */
totYA: +x2 +x45 -100 anyYA <= 0;
totYB: +x37 -100 anyYB <= 0;
totYC: +x47 -100 anyYC <= 0;
totYD: +x9 +x15 +x31 -100 anyYD <= 0;
totYE: +x19 -100 anyYE <= 0;
totXA: +x3 +x7 +x8 +x12 +x18 +x24 +x25 +x26 +x43 -100 anyXA <= 0;
totXB: +x10 +x13 +x23 +x30 +x32 +x35 +x39 +x40 +x46 +x48 -100 anyXB <= 0;
totXC: +x4 +x16 +x28 +x41 +x44 -100 anyXC <= 0;
totXD: +x1 +x6 +x11 +x14 +x17 +x20 +x21 +x29 +x34 -100 anyXD <= 0;
totXE: +x5 +x22 +x27 +x33 +x36 +x38 +x42 +x49 +x50 -100 anyXE <= 0;

YAorXA: +anyYA +anyXA <= 1;
YBorXB: +anyYB +anyXB <= 1;
YCorXC: +anyYC +anyXC <= 1;
YDorXD: +anyYD +anyXD <= 1;
YEorXE: +anyYE +anyXE <= 1;

/* Variable bounds */
x1 <= 1; (all variables are binary)

/* Integer definitions */
int x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40,x41,x42,x43,x44,x45,x46,x47,x48,x49,x50,dblA,dblB,dblC,dblD,dblE,xYA,xYB,xYC,xYD,xYE,xXA,xXB,xXC,xXD,xXE,anyYA,anyYB,anyYC,anyYD,anyYE,anyXA,anyXB,anyXC,anyXD,anyXE;

这是我的R代码。(功能齐全,未优化)

library(lpSolveAPI)
library(dplyr)

# setup df
opt <- function(){
  id <- 1:50
  type1 <- sample(c('A', 'B', 'C', 'D', 'E'), length(id), replace = T)
  type2 <- sample(c('X', 'X', 'X', 'Y'), length(id), replace = T)
  value <- round(runif(length(id), 0, 20),0)
  cost <- round(runif(length(id), 750, 1250),0)

  df <- data.frame(id, type1, type2, value, cost) %>% 
    mutate(total = 1)

# Attach dummy vars
  type1Dummy <- as.data.frame.matrix(table(df$id, df$type1))
  type2Dummy <- as.data.frame.matrix(table(df$id, df$type2))
  df <- cbind(df, type1Dummy, type2Dummy)

  #Add 10 new columns. XY and ABCDE combined.
  df$YA <- ifelse(df$A  & df$Y, 1, 0)
  df$YB <- ifelse(df$B  & df$Y, 1, 0)
  df$YC <- ifelse(df$C  & df$Y, 1, 0)
  df$YD <- ifelse(df$D  & df$Y, 1, 0)
  df$YE <- ifelse(df$E  & df$Y, 1, 0)
  df$XA <- ifelse(df$A  & df$X, 1, 0)
  df$XB <- ifelse(df$B  & df$X, 1, 0)
  df$XC <- ifelse(df$C  & df$X, 1, 0)
  df$XD <- ifelse(df$D  & df$X, 1, 0)
  df$XE <- ifelse(df$E  & df$X, 1, 0)

# constraints
  totalNum <- 5
  totalCost <- 5000
  totalX <- 4
  totalY <- 1
  rhs <- c(totalNum, totalCost, totalX, totalY)
  rhs2 <- c(rhs, 0,0,0,0,0, 1)
  rhs3 <- c(rhs2, rep(0, 10), rep(1, 5))  

  # Direction vector
  numDir <- '=='
  costDir <- '<='
  xDir <- '=='
  yDir <- '=='
  dir <- c(numDir, costDir, xDir, yDir)

  gt <- '>='
  lt <- '<='
  eq <- "=="
  dir2 <- c(dir, rep(gt, 5), gt)
  dir3 <- c(dir2, rep(eq, 10),
            rep(lt, 5))


  #constraints df  
  df$atleast2 <- 0
  cons <- data.frame(df$total, df$cost, df$X, df$Y, 
                     df$A, df$B, df$C, df$D, df$E, df$atleast2,
                     df$YA, df$YB, df$YC, df$YD, df$YE,
                     df$XA, df$XB, df$XC, df$XD, df$XE) #shape is 50 x 20

  tenzeros <- rep(0, 10)
  z20 <- rep(0, 20)
  z75 <- rep(0, 75)

  #New 2 of 1-kind constraints...
  cons <- rbind(cons, c(0,0,0,0,-2,0,0,0,0, 1,tenzeros)) # adding a new 0-1 variable for dbl_A
  cons <- rbind(cons, c(0,0,0,0,0,-2,0,0,0, 1,tenzeros))
  cons <- rbind(cons, c(0,0,0,0,0,0,-2,0,0, 1,tenzeros))
  cons <- rbind(cons, c(0,0,0,0,0,0,0,-2,0, 1,tenzeros))
  cons <- rbind(cons, c(0,0,0,0,0,0,0,0,-2, 1,tenzeros)) # adding a new 0-1 variable for dbl_E

  # Add 20 rows to cons: 10 for YA...XE and 10 more for anyYA to anyXE
  for(i in 1:20){
    cons <- rbind(cons, z20)
  }  

  BIGM <- 100
  print(dim(cons))
  for(j in 1:10){ #make the anyYA to anyYE variables -1
    cons[65+j,10+j] <- -1 * BIGM
  }  

  #finally add the one of AnyXA or AnyYA constraints
  for(xcol in 1:5){
    cons <- cbind(cons, z75)
  }  
  for(j in 1:5){ #make the anyYA and anyxA variables 1 is YAorXA
    cons[65+j, 20+j] <- 1 #coeff of YA
    cons[70+j, 20+j] <- 1  #coeff of XA
  }  

  dim(cons)

  # Setup opt
  obj <- c(df$value, rep(0, 25))


  # Solver Setup
  lprec <- make.lp(ncol(cons), nrow(cons))
  lprec

  for(i in 1:nrow(cons)){
    vals <- cons[i, ] %>% as.numeric(.)
    set.column(lprec, i, vals)
  }

  lprec
  length(obj)
  set.objfn(lprec, obj)
  set.constr.type(lprec, dir3)
  set.rhs(lprec, rhs3)

  for(xcol in 1:75){
    set.type(lprec, xcol, "binary")
  }


  lp.control(lprec,sense='max')

  row_names <- c('Take_5', 'budget', 'X_4', 'Y_1', 
                 'AA', 'BB', 'CC', 'DD', 'EE', 'Pick2of1',
                 'totYA', 'totYB', 'totYC', 'totYD', 'totYE',
                 'totXA', 'totXB', 'totXC', 'totXD', 'totXE',
                  'YAorXA', 'YBorXB', 'YCorXC', 'YDorXD', 'YEorXE'
                 )
  col_names <- c(paste0('x', 1:50), 'dblA', 'dblB', 'dblC', 'dblD', 'dblE', 
                 'xYA', 'xYB', 'xYC', 'xYD', 'xYE',
                 'xXA', 'xXB', 'xXC', 'xXD', 'xXE',
                 'anyYA', 'anyYB', 'anyYC', 'anyYD', 'anyYE',
                 'anyXA', 'anyXB', 'anyXC', 'anyXD', 'anyXE'
                 )
  dimnames(lprec) <- list(row_names, col_names)

  #write out the LP (useful for debugging)
  write.lp(lprec, filename = "test.lp")

  solve(lprec)
  print(get.objective(lprec))
  sol <- get.variables(lprec)
  print(sol)  

  df$selected <- sol[1:50]
  dfSolved <- df[df$selected == 1,]
  print(dfSolved)
  print(sol[-10:-1])
  #print(get.sensitivity.rhs(lprec))
  return(df)
}

df <- opt()

以下是一个示例解决方案:

   id type1 type2 value cost total A B C D E X Y YA YB YC YD YE XA XB XC XD XE atleast2 selected
18 18     A     X    19 1138     1 1 0 0 0 0 1 0  0  0  0  0  0  1  0  0  0  0        0        1
29 29     D     X    18  798     1 0 0 0 1 0 1 0  0  0  0  0  0  0  0  0  1  0        0        1
34 34     D     X    19  781     1 0 0 0 1 0 1 0  0  0  0  0  0  0  0  0  1  0        0        1
38 38     E     X    20 1114     1 0 0 0 0 1 1 0  0  0  0  0  0  0  0  0  0  1        0        1
47 47     C     Y    16 1108     1 0 0 1 0 0 0 1  0  0  1  0  0  0  0  0  0  0        0        1

我检查了它确实满足了你所有的限制。如果有任何不清楚的地方,请询问。