使用lpSolveAPI求解NBA球员选择线性规划问题遇无解错误

问题背景 #

球员数据 #

structure(list(Name = c("Jokic", "Butler", "Murray", "Adebayo", 
"Porter", "Gordon", "Martin", "Pope", "Vincent", "Lowry", "Brown", 
"Strus", "Robinson", "Green", "Highsmith"), Points = c(62.8, 
48.8, 45.8, 41.8, 35.3, 30.3, 29.3, 23.8, 23.3, 22.3, 21.8, 19, 
16.3, 8.5, 6.8), Cost = c(14000, 13400, 10800, 9200, 7600, 6600, 
7400, 5600, 5800, 5200, 6200, 4800, 4200, 2200, 1400)), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -15L))

约束条件 #

• 选择恰好6名球员（1名队长+5名普通球员）
• 队长的Points和Cost为原值的1.5倍
• 同一球员不能同时作为普通球员和队长
• 总成本不超过50000

原代码问题 #

运行以下代码后始终返回No feasible solution found，但实际存在可行解：

library(readxl)
library(tidyverse)
library(lpSolveAPI)

# Read the data from Excel
data <- read_excel("C:/Users/M0185JN/Downloads/NBA_1.xlsx")
data$cpt_points <- 1.5*data$Points
data$cpt_cost <- 1.5*data$Cost

#Players
num_players <- rep(1,nrow(data))
num_captain <- rep(1,nrow(data))

# Define the objective function coefficients
obj <- data$Points*num_players + data$cpt_points*num_captain

# Create a new LP model
lprec <- make.lp(nrow(data), nrow(data))

# Set the optimization direction to maximize
lp.control(lprec, sense = "maximize")

# Set the objective function coefficients
set.objfn(lprec, obj)

# Set type of decision variables
set.type(lprec, 1:nrow(data), type = "binary")

# Constraint: Pick exactly 5 players
add.constraint(lprec, num_players, "=", 5)
add.constraint(lprec, num_captain, "=", 1)

# Constraint: Total cost must be less than or equal to 50,000
add.constraint(lprec, data$Cost*num_players + data$cpt_cost*num_captain, "<=", 50000)

# Constraint: No Duplicate Players
add.constraint(lprec, num_players + num_captain, "<=", 1)

# Solve the linear programming problem
solve(lprec)

# Get the solution status
status <- get.solutioncount(lprec)

# Check if a solution was found
if (status > 0) {
  # Retrieve the values of the decision variables
  player_picked <- get.variables(lprec)
  
  # Create a data frame with the players and their corresponding picked status
  result <- data.frame(Name = data$Name, Picked = player_picked)
  
  # Filter the data frame to show only the players that were picked (Picked = 1)
  picked_players <- result[result$Picked == 1, ]
  
  # Print the picked players
  print(picked_players)
} else {
  print("No feasible solution found.")
}

错误排查 #

1. 决策变量定义错误：原代码仅创建了与球员数量相等的变量，但每个球员需要两个独立的二进制变量（x_i表示是否作为普通球员，y_i表示是否作为队长），总变量数应为2*nrow(data)。原代码将两种角色的变量合并，导致约束逻辑冲突。
2. 约束条件的系数矩阵错误：原代码添加约束时使用的系数长度与变量数不匹配，无法正确表达“1名队长+5名普通球员”“不能兼任”等约束。
3. 目标函数构建错误：原代码的目标函数系数未对应正确的变量分组，无法准确计算总得分。

修正后的代码 #

library(lpSolveAPI)
library(tidyverse)

# 加载数据（这里直接用提供的结构，也可替换为read_excel）
data <- structure(list(Name = c("Jokic", "Butler", "Murray", "Adebayo", 
                                "Porter", "Gordon", "Martin", "Pope", "Vincent", "Lowry", "Brown", 
                                "Strus", "Robinson", "Green", "Highsmith"), 
                       Points = c(62.8, 48.8, 45.8, 41.8, 35.3, 30.3, 29.3, 23.8, 23.3, 22.3, 21.8, 19, 16.3, 8.5, 6.8), 
                       Cost = c(14000, 13400, 10800, 9200, 7600, 6600, 7400, 5600, 5800, 5200, 6200, 4800, 4200, 2200, 1400)), 
                  class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -15L))

# 计算队长的得分和成本
data <- data %>% mutate(cpt_points = 1.5*Points, cpt_cost = 1.5*Cost)

n <- nrow(data)
total_vars <- 2*n  # 每个球员2个变量：前n个是普通球员，后n个是队长

# 创建LP模型：约束数先设为0，后续添加
lprec <- make.lp(0, total_vars)
lp.control(lprec, sense = "maximize")

# 设置目标函数：前n个变量对应普通球员得分，后n个对应队长得分
obj_coeff <- c(data$Points, data$cpt_points)
set.objfn(lprec, obj_coeff)

# 设置所有变量为二进制
set.type(lprec, 1:total_vars, "binary")

# 约束1：恰好选择5名普通球员
add.constraint(lprec, rep(1, n), "=", 5, indices = 1:n)

# 约束2：恰好选择1名队长
add.constraint(lprec, rep(1, n), "=", 1, indices = (n+1):total_vars)

# 约束3：同一球员不能同时是普通球员和队长
for(i in 1:n) {
  add.constraint(lprec, c(1, 1), "<=", 1, indices = c(i, n+i))
}

# 约束4：总成本不超过50000
cost_coeff <- c(data$Cost, data$cpt_cost)
add.constraint(lprec, cost_coeff, "<=", 50000)

# 求解模型
solve(lprec)

# 获取结果
if(get.solutioncount(lprec) > 0) {
  vars <- get.variables(lprec)
  regular_players <- data$Name[vars[1:n] == 1]
  captain <- data$Name[vars[(n+1):total_vars] == 1]
  
  cat("选中的普通球员：", paste(regular_players, collapse = ", "), "\n")
  cat("队长：", captain, "\n")
  cat("总得分：", get.objective(lprec), "\n")
  cat("总成本：", sum(data$Cost[vars[1:n]==1]) + sum(data$cpt_cost[vars[(n+1):total_vars]==1]), "\n")
} else {
  print("No feasible solution found.")
}

代码说明 #

• 变量拆分：将每个球员的普通/队长角色拆分为两个独立二进制变量，避免角色冲突。
• 约束明确：分别定义普通球员数量、队长数量、角色互斥、总成本约束，逻辑清晰。
• 结果输出：直接展示选中的普通球员、队长、总得分和总成本，便于验证。

内容的提问来源于stack exchange，提问作者Lcsballer1