从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：a “方向”，即<，<=，==，>=，>
• 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值。

在这里，我们的约束是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)
}

第三个约束的占位符

普雷斯托，我们已经提出了问题。现在让我们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))

这会满足您的需求吗？

任何问题？