在R中从100K行data.table选1K行优化加权和的算法建议

首先，我先梳理下你的核心需求：从100万行的数据集中选取1000行子集，最大化一个包含**全局统计量（max(x1)、max(x4)）和总和统计量（sum(x2)）**的代价函数，并且结果要优于简单排序或随机选择。

先简化你的代价函数（方便分析，x3项在原函数中被抵消了，可能是笔误？如果后续需要加入x3的影响，我们可以再调整）：

# 原代价函数等价简化
Simplified_Cost <- function(x1, x2, x4) {
  0.2 * max(x1) + 0.1 * sum(x2) - 0.1 * max(x4)
}

这个目标函数的特点是：不需要每行独立打分求和，而是依赖子集的全局属性，所以简单排序选前N行的思路存在局限性——排序只考虑了单行的权重，没有兼顾全局max项的特性（比如max(x1)只需要保留一个最大值，剩下的999行可以优先选x2大且x4小的）。

下面给出几种实用的算法和实现方案，效果都会优于你当前的方法：

一、利用目标函数特性的特殊优化（最快且效果好） #

因为你的目标函数结构明确，我们可以针对性简化问题：

1. 固定max(x1)的行：因为max(x1)对结果有正向贡献，直接保留x1最大的那一行即可，不需要在子集里保留多个高x1的行；
2. 筛选剩余行：剩下的999行，优先选x2大且x4小的行（因为sum(x2)正向贡献，max(x4)负向贡献）。

实现代码：

# 修正合成数据的x2生成bug（原代码只生成10万行，这里改成100万行）
set.seed(123)
total <- data.frame(
  id = 1:1000000, 
  x1 = runif(1000000,0,1), 
  x2 = 60*runif(1000000,0,1),  # 修正此处
  x3 = runif(1000000,0,1), 
  x4 = runif(1000000,0,1), 
  Last_interaction = sample(1:35, 1000000, replace= T)
)
total$x3 <- -total$x2 * total$x3 * runif(1000000,0.7,1) # 修正此处

# 特殊优化方案
# 1. 保留x1最大的行
max_x1_row <- total[which.max(total$x1),]
# 2. 过滤掉x4排名前10%的行（避免max(x4)拉低分数），然后选x2最大的999行
filtered_remaining <- total[-which.max(total$x1),]
filtered_remaining <- filtered_remaining[filtered_remaining$x4 < quantile(filtered_remaining$x4, 0.9),]
result_special <- rbind(max_x1_row, filtered_remaining[order(-filtered_remaining$x2),][1:999,])

# 计算代价
Simplified_Cost(result_special$x1, result_special$x2, result_special$x4)

这种方法利用了目标函数的结构，计算速度极快，结果大概率会超过排序选优的效果。

二、启发式算法（通用且效果稳定） #

如果你的目标函数后续可能调整，或者需要更通用的方案，推荐以下两种启发式方法：

1. 贪心算法+候选池优化 #

直接在100万行上做贪心会很慢，所以先构建一个候选池（包含所有对目标函数关键的行），再在候选池内做贪心：

# 构建候选池：取x1前100行、x2前10000行、x4前10000行（去重）
candidate_pool <- unique(rbind(
  total[order(-x1),][1:100,],
  total[order(-x2),][1:10000,],
  total[order(x4),][1:10000,]
))
n_candidate <- nrow(candidate_pool)

# 贪心添加法：从空集开始，每次加入能最大提升代价的行
current_subset <- c()
current_cost <- -Inf
for (i in 1:1000) {
  best_gain <- -Inf
  best_row <- NA
  # 遍历候选池中未选中的行
  for (j in setdiff(1:n_candidate, current_subset)) {
    temp_subset <- c(current_subset, j)
    temp_cost <- Simplified_Cost(
      candidate_pool$x1[temp_subset],
      candidate_pool$x2[temp_subset],
      candidate_pool$x4[temp_subset]
    )
    gain <- temp_cost - current_cost
    if (gain > best_gain) {
      best_gain <- gain
      best_row <- j
    }
  }
  current_subset <- c(current_subset, best_row)
  current_cost <- current_cost + best_gain
  if (i %% 100 == 0) cat("已选", i, "行，当前代价：", current_cost, "\n")
}
result_greedy <- candidate_pool[current_subset,]

2. 局部搜索优化（在贪心结果上进一步提升） #

在贪心结果的基础上，通过随机替换行来寻找更优解：

# 基于贪心结果做局部搜索
current_subset <- current_subset
current_cost <- Simplified_Cost(
  candidate_pool$x1[current_subset],
  candidate_pool$x2[current_subset],
  candidate_pool$x4[current_subset]
)
n_iter <- 10000 # 迭代次数
for (i in 1:n_iter) {
  # 随机替换子集内的一行和候选池内未选中的一行
  idx_remove <- sample(current_subset, 1)
  idx_add <- sample(setdiff(1:n_candidate, current_subset), 1)
  temp_subset <- replace(current_subset, which(current_subset == idx_remove), idx_add)
  temp_cost <- Simplified_Cost(
    candidate_pool$x1[temp_subset],
    candidate_pool$x2[temp_subset],
    candidate_pool$x4[temp_subset]
  )
  if (temp_cost > current_cost) {
    current_subset <- temp_subset
    current_cost <- temp_cost
    cat("迭代", i, "，代价提升至：", current_cost, "\n")
  }
}
result_local <- candidate_pool[current_subset,]

三、使用专门的优化库（全局搜索） #

如果需要更强大的全局优化能力，可以用R的遗传算法库：

GA包（遗传算法） #

遗传算法通过模拟自然选择来探索最优子集，适合离散的组合优化问题：

library(GA)

# 定义适应度函数（约束选中1000行）
fitness <- function(ind) {
  selected <- which(ind == 1)
  if (length(selected) != 1000) return(-Inf)
  Simplified_Cost(
    candidate_pool$x1[selected],
    candidate_pool$x2[selected],
    candidate_pool$x4[selected]
  )
}

# 运行遗传算法
ga_result <- ga(
  type = "binary",
  fitness = fitness,
  nBits = n_candidate,
  popSize = 50,
  maxiter = 100,
  run = 20, # 连续20代无提升则停止
  pmutation = 0.1,
  crossover = gabin_uCrossover
)

# 提取最优解
best_ind <- ga_result@solution[1,]
result_ga <- candidate_pool[which(best_ind == 1),]

四、结果对比 #

你可以把所有方法的结果和原方法对比：

# 原方法结果
cost_1 <- Simplified_Cost(result_1$x1, result_1$x2, result_1$x4)
cost_2 <- Simplified_Cost(result_2$x1, result_2$x2, result_2$x4)

# 新方法结果
cost_special <- Simplified_Cost(result_special$x1, result_special$x2, result_special$x4)
cost_greedy <- Simplified_Cost(result_greedy$x1, result_greedy$x2, result_greedy$x4)
cost_local <- Simplified_Cost(result_local$x1, result_local$x2, result_local$x4)
cost_ga <- Simplified_Cost(result_ga$x1, result_ga$x2, result_ga$x4)

# 打印对比
cat("排序选优：", round(cost_1, 2), "\n")
cat("随机选择：", round(cost_2, 2), "\n")
cat("特殊优化：", round(cost_special, 2), "\n")
cat("贪心算法：", round(cost_greedy, 2), "\n")
cat("局部搜索：", round(cost_local, 2), "\n")
cat("遗传算法：", round(cost_ga, 2), "\n")

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