r - 从 Excel 到 R 的优化

Question

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

约束是 -

A2 应该在 A1 完成后发生，A3 应该在 A2 完成后发生等等

A3、A5、A6 - 这些事件中只有两个可以在特定日期发生

每个事件都应该发生在一个字段中(在 excel 求解器中，这个约束是通过将行总和等于一个

来定义的。

如果有人可以帮助解决这个问题，那将是一个很大的帮助。为了更好地理解这个问题，我附上了图片。
另外，请让我知道是否有任何站点或书籍，其中包含有关“如何解决 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))

可以看到我们设置了所有 X的系数的(决定)包含 action有问题 1 .在我们的最终解决方案中，每个 X将取值 0或 1 .如果 X为零，系数将无关紧要。如果 X是 1 ，系数将被添加到 lhs 的总和中并使用 dir 进行比较到 rhs值(value)。

在这里，我们的约束是 coefficient * X == 1 的总和对于我们刚刚介绍的每个约束。对于包含给定 Action 的所有可能决策，系数为 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))

这能满足您的需要吗？

任何问题？