Question

我正在努力实现lpSolve解决方案，以优化假设的日常幻想棒球问题。我在应用最后一个约束时遇到了麻烦：

位置-恰好3个外场手（OF）2个投手（P）和其他所有东西
成本-成本低于200
团队-任何一支团队的最多人数为6
团队-名册上的最小团队数量为3 **

例如，假设您有一个包含1000个球员的数据框，其中包含积分，成本，位置和球队，并且您正试图最大化平均积分：

library(tidyverse)
library(lpSolve)
set.seed(123)
df <- data_frame(avg_points = sample(5:45,1000, replace = T),
                 cost = sample(3:45,1000, replace = T),
                 position = sample(c("P","C","1B","2B","3B","SS","OF"),1000, replace = T),
                 team = sample(LETTERS,1000, replace = T)) %>% mutate(id = row_number())
head(df)

# A tibble: 6 x 5
#  avg_points  cost position team     id
#       <int> <int> <chr>    <chr> <int>
#1         17    13 2B       Y         1
#2         39    45 1B       P         2
#3         29    33 1B       C         3
#4         38    31 2B       V         4
#5         17    13 P        A         5
#6         10     6 SS       V         6

我已经用以下代码实现了前3个约束，但是我在弄清楚如何在名册上实现最少团队人数方面遇到了麻烦。我想我需要在模型中添加其他变量，但是我不确定该怎么做。

#set the objective function (what we want to maximize)
obj <- df$avg_points 
# set the constraint rows.
con <- rbind(t(model.matrix(~ position + 0,df)), cost = df$cost, t(model.matrix(~ team + 0, df)) )

#set the constraint values
rhs <- c(1,1,1,1,3,2,1,  # 1. #exactly 3 outfielders 2 pitchers and 1 of everything else
         200, # 2. at a cost less than 200
         rep(6,26) # 3. max number from any team is 6
         ) 

#set the direction of the constraints
dir <- c("=","=","=","=","=","=","=","<=",rep("<=",26))

result <- lp("max",obj,con,dir,rhs,all.bin = TRUE)

如果有帮助，我正在尝试复制This paper（稍作调整），它具有相应的茱莉亚代码here

Answer 1

这可能是解决您的问题的方法。

这是我使用过的数据（与您的数据相同）：

library(tidyverse)
library(lpSolve)
N <- 1000

set.seed(123)
df <- tibble(avg_points = sample(5:45,N, replace = T),
             cost = sample(3:45,N, replace = T),
             position = sample(c("P","C","1B","2B","3B","SS","OF"),N, replace = T),
             team = sample(LETTERS,N, replace = T)) %>% 
  mutate(id = row_number())

您想找到x1...xn，将以下目标函数最大化：

x1 * average_points1 + x2 * average_points1 + ... + xn * average_pointsn

通过lpSolve的工作方式，您需要将每个LHS表示为总和 x1...xn乘以您提供的向量。

由于您无法使用当前变量来表示团队数量，因此可以引入新的团队（我将它们称为y1..yn_teams和z1..zn_teams）：

# number of teams:
n_teams = length(unique(df$team))

您的新目标函数（ys和zs不会影响您的总体目标功能，因为常量设置为0）：

obj <- c(df$avg_points, rep(0, 2 * n_teams))

）

前三个约束相同，但为y和z添加了常量：

c1 <- t(model.matrix(~ position + 0,df))
c1 <- cbind(c1, 
            matrix(0, ncol = 2 * n_teams, nrow = nrow(c1)))
c2 = df$cost
c2 <- c(c2, rep(0, 2 * n_teams))
c3 = t(model.matrix(~ team + 0, df))
c3 <- cbind(c3, matrix(0, ncol = 2 * n_teams, nrow = nrow(c3)))

由于您希望至少拥有3个球队，因此您将首先使用y计算每个球队的球员人数：

此约束计算每个团队的球员人数。您对选择的球队的所有球员进行汇总，然后减去每个球队相应的y变量。该值应等于0。（diag()创建了身份矩阵，我们现在不担心z）

# should be x1...xn - y1...n = 0
c4_1 <- cbind(t(model.matrix(~team + 0, df)), # x
              -diag(n_teams), # y
              matrix(0, ncol = n_teams, nrow = n_teams) # z
              ) # == 0

由于每个y现在都是一个团队中的球员人数，因此您现在可以确保z为二进制，并具有以下约束条件：

c4_2 <- cbind(t(model.matrix(~ team + 0, df)), # x1+...+xn ==
              -diag(n_teams), # - (y1+...+yn )
              diag(n_teams) # z binary
              ) # <= 1

这是确保至少选择3个团队的约束条件：

c4_3 <- c(rep(0, nrow(df) + n_teams), # x and y
          rep(1, n_teams) # z >= 3
          )

您需要确保

您可以使用big-M方法创建约束，即：

或者，在更lpSolve更友好的版本中：

在这种情况下，您可以将6用作M的值，因为它是任何y可以取的最大值：

c4_4 <- cbind(matrix(0, nrow = n_teams, ncol = nrow(df)),
              diag(n_teams),
              -diag(n_teams) * 6)

添加此约束以确保所有x都是二进制的：

#all x binary
c5 <- cbind(diag(nrow(df)), # x
            matrix(0, ncol = 2 * n_teams, nrow = nrow(df)) # y + z
            )

创建新的约束矩阵

con <- rbind(c1,
             c2,
             c3,
             c4_1,
             c4_2,
             c4_3,
             c4_4,
             c5)

#set the constraint values
rhs <- c(1,1,1,1,3,2,1,  # 1. #exactly 3 outfielders 2 pitchers and 1 of everything else
         200, # 2. at a cost less than 200
         rep(6, n_teams), # 3. max number from any team is 6
         rep(0, n_teams), # c4_1
         rep(1, n_teams), # c4_2
         3, # c4_3,
         rep(0, n_teams), #c4_4
         rep(1, nrow(df))# c5 binary
)

#set the direction of the constraints
dir <- c(rep("==", 7), # c1
         "<=", # c2
         rep("<=", n_teams), # c3
         rep('==', n_teams), # c4_1
         rep('<=', n_teams), # c4_2
         '>=', # c4_3
         rep('<=', n_teams), # c4_4 
         rep('<=', nrow(df)) # c5
         )

问题几乎相同，但是我使用all.int而不是all.bin来确保计数对团队中的球员有效：

result <- lp("max",obj,con,dir,rhs,all.int = TRUE)
Success: the objective function is 450


roster <- df[result$solution[1:nrow(df)] == 1, ]
roster
# A tibble: 10 x 5
   avg_points  cost position team     id
        <int> <int> <chr>    <chr> <int>
 1         45    19 C        I        24
 2         45     5 P        X       126
 3         45    25 OF       N       139
 4         45    22 3B       J       193
 5         45    24 2B       B       327
 6         45    25 OF       P       340
 7         45    23 P        Q       356
 8         45    13 OF       N       400
 9         45    13 SS       L       401
10         45    45 1B       G       614

如果您将数据更改为

N <- 1000

set.seed(123)
df <- tibble(avg_points = sample(5:45,N, replace = T),
             cost = sample(3:45,N, replace = T),
             position = sample(c("P","C","1B","2B","3B","SS","OF"),N, replace = T),
             team = sample(c("A", "B"),N, replace = T)) %>% 
  mutate(id = row_number())

现在将是不可行的，因为数据中的团队数少于3。

您可以检查它是否现在可以工作：

sort(unique(df$team))[result$solution[1027:1052]==1]
[1] "B" "E" "I" "J" "N" "P" "Q" "X"
sort(unique(roster$team))
[1] "B" "E" "I" "J" "N" "P" "Q" "X"

使用lpSolve在整数编程中实现其他约束变量

1 个答案: