R语言实现论文复审准随机均等分配：规避自评+均衡任务量

要同时满足「复审员不得自评」和「分配量尽可能均等」的要求，本质是带排他约束的均衡随机分配问题。以下提供两种可落地的R实现方案：

方法一：迭代调整法（简单直观，适合小样本） #

先给每篇论文随机分配排除自身的复审员，再通过迭代调整修正分配量的不均衡，全程确保不出现自评。

步骤与代码 #

# 1. 构造示例数据（替换为你的实际数据）
set.seed(123) # 固定随机种子保证结果可复现
papers <- data.frame(
  paperID = 1:17,
  first_marker = sample(c("AA", "AB", "AC", "AD"), 17, replace = TRUE)
)

# 2. 初始随机分配：给每篇论文分配非自身的复审员
papers$second_marker <- sapply(papers$first_marker, function(x) {
  sample(setdiff(c("AA", "AB", "AC", "AD"), x), 1)
})

# 3. 设定目标分配量：17篇论文按4/4/4/5分配（最接近均等的拆分）
target_counts <- c(AA=5, AB=4, AC=4, AD=4)
current_counts <- table(papers$second_marker)

# 4. 迭代调整分配量，同时规避自评
for (marker in names(current_counts)) {
  # 当当前复审员分配量超过目标时，转出论文
  while (current_counts[marker] > target_counts[marker]) {
    # 筛选该复审员负责的论文，且初评员不是待转入的复审员
    excess_papers <- subset(papers, second_marker == marker)
    # 找到分配量不足的复审员
    deficit_markers <- names(current_counts)[current_counts < target_counts]
    
    # 逐个调整超额论文
    for (i in 1:nrow(excess_papers)) {
      eligible_deficit <- setdiff(deficit_markers, excess_papers$first_marker[i])
      if (length(eligible_deficit) > 0) {
        new_marker <- sample(eligible_deficit, 1)
        # 更新分配结果
        papers$second_marker[papers$paperID == excess_papers$paperID[i]] <- new_marker
        # 更新计数
        current_counts[marker] <- current_counts[marker] - 1
        current_counts[new_marker] <- current_counts[new_marker] + 1
        break
      }
    }
  }
}

# 验证结果
cat("复审员分配数量：\n")
print(table(papers$second_marker))
cat("\n是否存在自评情况：", any(papers$first_marker == papers$second_marker), "\n")

方法二：线性规划法（严谨可靠，适合复杂场景） #

通过lpSolve包构建线性规划模型，直接约束「不得自评」和「分配量在4-5之间」，求解符合所有条件的最优分配方案。

步骤与代码 #

library(lpSolve)

# 1. 构造示例数据（替换为你的实际数据）
set.seed(123)
papers <- data.frame(
  paperID = 1:17,
  first_marker = sample(c("AA", "AB", "AC", "AD"), 17, replace = TRUE)
)

num_papers <- nrow(papers)
markers <- c("AA", "AB", "AC", "AD")
num_markers <- length(markers)

# 2. 构建约束矩阵与参数
# 变量定义：每篇论文×每个复审员的0-1变量（共17×4=68个）
constraint_matrix <- matrix(0, nrow = num_papers + num_papers + 2*num_markers, ncol = num_papers*num_markers)
constraint_dir <- c()
constraint_rhs <- c()

# 约束1：每篇论文只能分配1个复审员
for (p in 1:num_papers) {
  row_idx <- p
  col_idx <- (p-1)*num_markers + 1:num_markers
  constraint_matrix[row_idx, col_idx] <- 1
  constraint_dir <- c(constraint_dir, "=")
  constraint_rhs <- c(constraint_rhs, 1)
}

# 约束2：排除自评（初评员不能做自己论文的复审员）
row_idx <- num_papers + 1
for (p in 1:num_papers) {
  fm_idx <- which(markers == papers$first_marker[p])
  col_idx <- (p-1)*num_markers + fm_idx
  constraint_matrix[row_idx, col_idx] <- 1
  constraint_dir <- c(constraint_dir, "=")
  constraint_rhs <- c(constraint_rhs, 0)
  row_idx <- row_idx + 1
}

# 约束3：每个复审员分配量≤5
for (m in 1:num_markers) {
  col_idx <- seq(m, num_papers*num_markers, by = num_markers)
  constraint_matrix[row_idx, col_idx] <- 1
  constraint_dir <- c(constraint_dir, "<=")
  constraint_rhs <- c(constraint_rhs, 5)
  row_idx <- row_idx + 1
}

# 约束4：每个复审员分配量≥4
for (m in 1:num_markers) {
  col_idx <- seq(m, num_papers*num_markers, by = num_markers)
  constraint_matrix[row_idx, col_idx] <- 1
  constraint_dir <- c(constraint_dir, ">=")
  constraint_rhs <- c(constraint_rhs, 4)
  row_idx <- row_idx + 1
}

# 3. 求解线性规划（目标函数设为全1，只要找到可行解即可）
obj_func <- rep(1, num_papers*num_markers)
lp_result <- lp("min", obj_func, constraint_matrix, constraint_dir, constraint_rhs, all.bin = TRUE)

# 4. 提取分配结果
assignments <- matrix(lp_result$solution, nrow = num_papers, ncol = num_markers, byrow = TRUE)
papers$second_marker <- markers[apply(assignments, 1, which.max)]

# 验证结果
cat("复审员分配数量：\n")
print(table(papers$second_marker))
cat("\n是否存在自评情况：", any(papers$first_marker == papers$second_marker), "\n")

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