从 Excel 到 R 的优化

Question

我正在努力解决 R 中的以下优化问题。使用 excel 求解器对我来说很容易，但我无法在 R 中解决同样的问题。我在 R 中的优化方面没有太多经验 问题是分配特定活动应该在一段时间内完成的时间。 A1、A2、…、A12 是在一个领域完成的 12 项活动。 0代表未分配，1代表已分配。

约束是 -

• A2 应该在 A1 完成后发生，A3 应该在 A2 完成后发生，依此类推
• A3、A5、A6 - 在某一天只能发生其中两项活动
• 每个活动都应该发生在一个字段中（在 excel 求解器中，此约束是通过将行总和等于 1 来定义的

如果有人可以帮助解决这个问题，那将是一个很大的帮助。为了更好地理解这个问题，我附上了图片。 另外，请让我知道是否有任何站点或书籍，其中包含有关“如何解决 R 中的优化问题”的丰富示例。谢谢你的期待。

Answer 1

您可以使用lpSolve 包解决您的问题。

您将需要成本向量和约束信息。约束信息以下列结构形式输入到函数中：

• lhs：“左侧”系数矩阵，每个决策变量一个
• dir：一个“方向”，即<、<=、==、>=、>
• rhs: 一个“右手边”作为数值

为了构建您的约束列表，我发现将您可能采取的每个决定视为一个 X（成为lhs 表中的一列）以及您希望将每个约束定义为一个单独的方程（成为lhs表中的一行，分别在dir和rhs中有对应的值）

让我们从所有可能的决定开始：

library(tidyverse)
library(stringr)

# What are the decision variables? ----

# Which action to take
actions <- str_c('A',seq(1:12) %>% formatC(width = 2, flag = '0'))
actions
#[1] "A01" "A02" "A03" "A04" "A05" "A06" "A07" "A08" "A09" "A10" "A11" "A12"

# When to take it
timings <- str_c('T',seq(1:12) %>% formatC(width = 2, flag = '0'))
timings
#[1] "T01" "T02" "T03" "T04" "T05" "T06" "T07" "T08" "T09" "T10" "T11" "T12"

# List of all possible decisions is this:
decisions <- expand.grid(actions, timings)

# Convert it to a vector
decision_variables <- str_c(decisions[,1], '_', decisions[,2])

# You also need a cost vector. 
# We'll use a value increasing as a function of timings, 
# as this will penalize "late" actions?
cost <- rep(seq(1:length(timings)), length(actions)) %>% sort

decision_variables 的每个元素都是一个可能的动作（即在给定时间采取动作。现在我们可以开始通过引入约束来缩小求解器可用的选项。

---

第一类约束：每个选项只能选择一次！ （这实际上是你的第三个，但我从这个开始，因为它是最简单的） 我们可以这样表述：

# Create a matrix with one column per possible decision
# and one row per action (for now)
lhs <- matrix(0, 
  nrow = length(actions), 
  ncol = length(decision_variables), 
  dimnames = list(
    actions, 
    decision_variables))

# Each action should only be taken once!
for (i in 1:length(actions)) {
  # Which fields does an action occur in?
  this_action <- str_detect(colnames(lhs), actions[i])
  # Set their coefficients to 1
  lhs[i,this_action] <- 1
}
# create corresponding dir and rhs values
dir <- rep('==', length(actions))
rhs <- rep(1, length(actions))

您可以看到我们将所有包含action 的X（决策）的系数设置为1。在我们的最终解决方案中，每个X 将采用0 或1 的值。如果X 为零，则系数将无关紧要。如果X 是1，则该系数将被添加到lhs 的总和中，并使用dir 与rhs 值进行比较。

这里，我们的约束是我们刚刚引入的每个约束的coefficient * X == 1 的总和。对于包含给定动作的所有可能决策，系数为 1。因此，只有当任何给定的操作只执行一次时，解决方案才有效。

---

第二个限制条件：c('A03', 'A05', 'A06') 中只有两个应在给定日期同时出现。

同样，我们为每个约束生成一行。在这种情况下，我认为我们每天需要一个约束。我们将生成的值附加到已经存在的lhs、dir 和rhs 变量中：

# only one of A3, A5, A6 at any given time.
# One constraint for each timestep
for (j in timings) {
  lhs <- rbind(lhs, ifelse(str_detect(decision_variables, paste0('A0[356]{1}_',j)), 1, 0))
  dir <- c(dir, '<=')
  rhs <- c(rhs, 2)
}

---

第三个​​约束的占位符

---

Presto，我们已经制定了我们的问题。现在让lpSolve 处理数字！ 您可以像这样将我们的问题输入算法：

library(lpSolve)

# Run lpSolve to find best solution
solution <- lp(
  # maximise or minimise the objective function?
  direction = 'min',
  # coefficients of each variable
  objective.in = cost,
  const.mat = lhs, 
  const.dir = dir, 
  const.rhs = rhs)

# Extract the values of X for the best solution:
print(solution$solution)

# Convert it into ta matrix of the format you are familiar with
matrix(solution$solution, 
       nrow = length(timings), 
       ncol = length(actions),
       dimnames = list(actions, timings))

这能满足你的需要吗？

有什么问题吗？