线性规划-类别的唯一数量

时间:2019-10-19 13:44:06

标签: r linear-programming

TL; DR:我试图在满足某些线性约束的集合中找到“最便宜”的一组物品。但是,每个元素都可以是多个“类别”的一部分,我也想混合使用这些独特的类别,而且我不确定这是否可以以LP方式实现,以及如何处理。

示例-第1部分 假设我有7个项目,它们具有不同的成本和与之相关的不同值。

library(tidyverse)
library(lpSolve)

# Fake data
kd = tibble(
  Item = 1:7,
  Cost = c(1, 1, 1, 1, 2, 3, 4),
  Value =c(1, 1, 3, 4, 6, 3, 2),
  Type = c("A", "A", "A", "B", "C", "D", "E")
)

我想选择其中的3个元素,以使Cost最小化,并且其Value> =5。我可以使用lp通过以下代码轻松地做到这一点:

# Objective function
knapsack.obj = kd$Cost

# Constraints
knapsack.con = matrix(
  c(
    rep(1, nrow(kd)), 
    kd$Value 
  ),
  nrow = 2, byrow = TRUE
)
knapsack.dir = c("==", ">=")
knapsack.rhs = c(3, 5)

# Solve
knapsackSolution = lp("min", knapsack.obj, knapsack.con, knapsack.dir, knapsack.rhs, all.bin = TRUE) 

# Results
kd[knapsackSolution$solution == 1, ]

如预期的那样,这将返回第1、2和3项,其合并Value = 5,并且显然使价格最小化。

示例-第2部分

我现在还不知道如何解决的额外麻烦是添加代码,以确保所选择的项目至少来自两个独特的类别。 现在,我期望的解决方案是项目1、2和4(或1、3和4),它们的总成本仍然为3,而值6(或8)的值大于等于5,但并非全部都是“ A” ”元素,但还包含第4项,即“ B”元素。

关于如何在LP框架中实现这一点的任何想法?

3 个答案:

答案 0 :(得分:1)

数学模型

如果我们引入零一(数据)矩阵

Category[i,j] = 1  if item i has type j
                0  otherwise

和一个二进制变量:

y[j] = 1 if an item with type j is selected
       0 otherwise

我们可以开发一个简单的数学模型:

enter image description here

蓝色符号代表数据,红色符号代表决策变量。

请注意,变量y[j]可以放宽到0到1之间的连续值。

首先写下一个数学模型的优点是,比一堆R代码(至少对我而言)更容易推理。

实施

我在这里使用OMPR的原因有两个:

  • 以基于方程的方式实现模型的直接方法。我们会更接近数学模型。
  • 获得比LpSolve更好的求解器。

这是R代码:

library(tidyverse)
library(ROI)
library(ROI.plugin.symphony)
library(ompr)
library(ompr.roi)

# Fake data
kd = tibble(
  Item = 1:7,
  Cost = c(1, 1, 1, 1, 2, 3, 4),
  Value =c(1, 1, 3, 4, 6, 3, 2),
  Type = c("A", "A", "A", "B", "C", "D", "E")
)

Types <- c("A","B","C","D","E")
Category <- 1*outer(kd$Type,Types,FUN="==")
Type <- 1:length(Types)

numItems <- 3
MinValue <- 5
MinItems <- 2

m <- MIPModel() %>%
  add_variable(x[i], i=kd$Item, type="binary") %>%
  add_variable(y[j], j=Type, type="binary") %>%
  add_constraint(sum_expr(x[i], i=kd$Item) == numItems) %>% 
  add_constraint(sum_expr(kd$Value[i]*x[i], i=kd$Item) >= MinValue) %>% 
  add_constraint(y[j] <= sum_expr(Category[i,j]*x[i], i=kd$Item), j=Type) %>% 
  add_constraint(sum_expr(y[j], j=Type) >= MinItems) %>% 
  set_objective(sum_expr(kd$Cost[i]*x[i], i=kd$Item),"min") %>% 
  solve_model(with_ROI(solver = "symphony", verbosity=1))

cat("Status:",solver_status(m),"\n")
cat("Objective:",objective_value(m),"\n")
m$solution

这里最复杂的部分可能是类别矩阵的计算。

解决方案

解决方案如下:

Status: optimal 
Objective: 3 
x[1] x[2] x[3] x[4] x[5] x[6] x[7] y[1] y[2] y[3] y[4] y[5] 
   1    1    0    1    0    0    0    1    1    0    0    0          

答案 1 :(得分:0)

由于我们知道该解决方案必须具有k = 3个元素,因此每个组必须限制为k-1个或更少的元素,从而迫使至少要使用2个组。

incid <- +outer(unique(kd$Type), kd$Type, "==")
ntypes <- nrow(incid)

knapsack.con = rbind(
    rep(1, nrow(kd)), 
    kd$Value,
    incid)

k <- 3
knapsack.dir = c("==", ">=", rep("<=", ntypes))
knapsack.rhs = c(k, 5, rep(k-1, ntypes))
res <- lp("min", knapsack.obj, knapsack.con, knapsack.dir, knapsack.rhs, all.bin = TRUE) 

res$status
## [1] 0

res$solution
## [1] 1 1 0 1 0 0 0

简化

正如我们在评论中讨论的那样,对于此特定数据,我们可以省略最后4个约束,因为由于最后4个组中的每个元素中只有一个元素,因此它们总是很令人满意。

res2 <- lp("min", knapsack.obj, knapsack.con[1:3, ], knapsack.dir[1:3], 
  disknapsack.rhs[1:3], all.bin = TRUE) 

res2$status
## [1] 0

res2$solution
## [1] 1 1 0 1 0 0 0

概括

正如我们在评论中所讨论的,概括地说,让我们假设我们要在解决方案中至少包含3个不同的类别,而不是2。在此特定数据中,我们可以简单地要求每个类别的解决方案的总数不超过1,那是行不通的,因此让我们一次获取第2组的所有组合并产生以下所示的约束。 5是问题中的类别总数,2是解决方案中所需的类别总数之一。

combos <- combn(5, 2, function(x) colSums(incid[x, ]))

对于每个约束,即组合中的每一行,我们都要求其小于或等于2,以排除仅具有1个或2个类别的任何解决方案。然后,以与添加剩余约束之前类似的方式构造LP。

答案 2 :(得分:0)

实际上,我们不必强制解决方案每个组中包含k-1个元素或更少元素。相反,我们可以强制每个组最多包含g_i-1个元素,其中g_i是每个组中的元素数。

这是实现:

library(purrr)
library(lpSolve)
library(fastmatch)

# Fake data
  kd = tibble(
  Item = 1:7,
  Cost = c(1, 1, 1, 1, 2, 3, 4),
  Value =c(1, 1, 3, 4, 6, 3, 2),
  Type = c("A", "A", "A", "B", "C", "D", "E")
)

# number of elements to choose
k = 3

  type_match <- fmatch(kd$Type, unique(kd$Type))
  unique_cat <- unique(type_match)

  add_con <- map(unique_cat,function(x) {
    type_match[type_match != x] = 0
    type_match[type_match > 0] = 1
    return(type_match)}) %>% 
    do.call(rbind,.)

  knapsack.obj = kd$Cost
  knapsack.con = 
    rbind(
      rep(1, nrow(kd)), 
      kd$Value,
      add_con
    )
rhs_add <- apply(add_con, 1, function(x) ifelse(sum(x)>1,sum(x) - 1,1))

  knapsack.dir = c("==", ">=", rep("<=",length(rhs_add)))
  knapsack.rhs = c(k, 5, rhs_add)

  knapsackSolution = lp("min", 
                        knapsack.obj, 
                        knapsack.con, 
                        knapsack.dir, 
                        knapsack.rhs, 
                        all.bin = TRUE) 
  knapsackSolution$solution
>   knapsackSolution$solution
[1] 1 1 0 1 0 0 0