求助：基于R实现符合约束的物品最优分配排序方案

Got it, let's tackle this optimal item allocation problem head-on. This is essentially an integer linear programming task with specific constraints, and R has solid tools to solve this efficiently. Here's a step-by-step, practical approach using the lpSolve package (a go-to for linear/integer programming in R):

Core Problem Recap #

First, let's lock in the key rules we need to enforce:

• Objective: Maximize the total sum of "合意度/质量评分" across all allocations (prioritize high-scoring items going to users who requested them)
• Constraints:
  • Each user gets at least 1 item, and up to 5 (adjustable for special cases)
  • Each item is assigned to exactly one user (only items that were requested get allocated)
  • A user can only receive items they actually submitted requests for

Step 1: Set Up Dependencies #

First, install and load the lpSolve package if you haven't already:

install.packages("lpSolve")
library(lpSolve)

Step 2: Create Sample Input Data #

Let's simulate a realistic dataset to test our solution. We'll include a mix of user request counts (including a special case with more than 5 requests):

# Define items and their quality scores (0-10)
items <- data.frame(
  item_id = paste0("Item_", 1:8),
  score = c(10, 8, 7, 5, 9, 6, 4, 3)
)

# Define users and their requested items
users <- list(
  User_A = c("Item_1", "Item_3", "Item_5"),
  User_B = c("Item_2", "Item_3", "Item_4", "Item_5", "Item_6"),
  User_C = c("Item_1", "Item_2", "Item_5", "Item_6", "Item_7", "Item_8") # Special case: 6 requests
)

Step 3: Build the Cost Matrix #

Since lpSolve minimizes cost by default, we'll invert our quality scores (use negative values) so minimizing total cost equals maximizing total quality. We'll set a very high cost (Inf) for items a user didn't request to block those allocations:

# Initialize matrix: rows = users, columns = items
num_users <- length(users)
num_items <- nrow(items)
cost_matrix <- matrix(Inf, nrow = num_users, ncol = num_items)
rownames(cost_matrix) <- names(users)
colnames(cost_matrix) <- items$item_id

# Populate with negative scores for requested items
for (user in names(users)) {
  requested_items <- users[[user]]
  cost_matrix[user, requested_items] <- -items$score[items$item_id %in% requested_items]
}

Step 4: Define Constraints #

We need two types of constraints to enforce our rules:

1. Item constraints: Each item can be assigned to at most one user
2. User constraints: Each user gets between 1 and their max allowed items (5, or more for special cases)

# Set max allocations (adjust User_C's limit for the special case)
max_alloc <- c(5, 5, 6)

# Item constraints: each item can be assigned 0 or 1 times
const_dir_items <- rep("<=", num_items)
const_rhs_items <- rep(1, num_items)
const_matrix_items <- diag(num_items) # Identity matrix for item columns

# User constraints: each user gets 1 to max_alloc items
const_dir_users <- c(rep(">=", num_users), rep("<=", num_users))
const_rhs_users <- c(rep(1, num_users), max_alloc)
const_matrix_users <- rbind(diag(num_users), diag(num_users)) # Two sets of row constraints

# Combine all constraints into one matrix (lpSolve expects rows = constraints)
const_matrix <- rbind(t(const_matrix_items), const_matrix_users)
const_dir <- c(const_dir_items, const_dir_users)
const_rhs <- c(const_rhs_items, const_rhs_users)

Step 5: Run the Integer Linear Program #

We specify all.int = TRUE because allocations are binary (1 = assign item to user, 0 = don't assign):

# Solve the optimization problem
lp_result <- lp(
  direction = "min",
  objective.in = as.vector(cost_matrix),
  const.mat = const_matrix,
  const.dir = const_dir,
  const.rhs = const_rhs,
  all.int = TRUE
)

# Check if a feasible solution exists
if (lp_result$status != 0) {
  stop("No feasible solution found! Verify there are enough items to meet the minimum 1 per user requirement.")
}

Step 6: Parse and Visualize Results #

Convert the raw solution into a human-readable allocation table:

# Reshape solution into a matrix
solution_matrix <- matrix(lp_result$solution, nrow = num_users, ncol = num_items, byrow = TRUE)
rownames(solution_matrix) <- names(users)
colnames(solution_matrix) <- items$item_id

# Extract allocations into a tidy data frame
allocations <- data.frame(
  User = character(),
  Item = character(),
  Score = numeric(),
  stringsAsFactors = FALSE
)

for (user in names(users)) {
  assigned_items <- colnames(solution_matrix)[solution_matrix[user, ] == 1]
  for (item in assigned_items) {
    score <- items$score[items$item_id == item]
    allocations <- rbind(allocations, data.frame(User = user, Item = item, Score = score))
  }
}

# Print results
cat("Optimal Allocations:\n")
print(allocations)

total_score <- sum(allocations$Score)
cat("\nTotal Quality Score Achieved:", total_score, "\n")

Key Adjustments for Edge Cases #

• Special Requests: To allow a user to receive more than 5 items, just update their value in the max_alloc vector.
• Large Datasets: For 100+ users/items, lpSolve might be slow—switch to the ompr package with a solver like glpk or cplex for better scalability.
• Unrequested Items: Our cost matrix already leaves these unassigned by setting Inf (the model will never select them).

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