基于R语言实现最小化样品合并以满足最低质量要求的算法

问题描述 #

样品分析有最低质量要求，同一实验处理组内的多个低质量样品需合并以达标，目标是尽可能减少合并次数，最大化合格样品（合并后）的数量。

示例 #

处理组A样品质量：8g、7g、5g、10g；处理组B：20g、21g、24g、29g，最低分析质量为15g。

• 处理组B所有样品均达标，无需合并；
• 处理组A最优方案：5g+10g、8g+7g，共2组合格样品，最大化了重复数。

数据结构与环境 #

使用tidyverse工具包，模拟数据代码：

library(tidyverse)

sample_id = c(1:24)
treatments = c(rep("A",8),rep("B",8),rep("C",8))
mass = round(c(runif(8,4,10),runif(8,5,13),runif(8,15,18)),1)
df = data.frame(sample_id, treatments, mass)

已有预处理步骤 #

已筛选出无需合并的样品和需要合并的样品：

# 筛选无需合并的样品
bigenough = df %>%
  filter(mass >= 15)

# 筛选需要合并的样品
poolneeded = df %>%
  filter(!(sample_id %in% bigenough$sample_id))

最优合并算法实现 #

采用贪心策略：对每个处理组的样品按质量升序排序，用双指针从两端向中间配对，尽可能让最小的样品和最大的样品组合，最大化合并后的合格组数。

完整代码：

library(tidyverse)

# 设置最低质量阈值
min_mass <- 15

# 定义处理单个组的合并函数
process_group <- function(group_df) {
  # 按质量升序排序
  sorted_df <- group_df %>% arrange(mass)
  n <- nrow(sorted_df)
  left <- 1
  right <- n
  pool_groups <- list()
  current_pool <- 1
  
  while (left <= right) {
    # 只剩单个样品时无法合并，直接跳过
    if (left == right) {
      break
    }
    # 尝试最小+最大的组合
    if (sorted_df$mass[left] + sorted_df$mass[right] >= min_mass) {
      pool_groups[[current_pool]] <- sorted_df %>% slice(left, right) %>% mutate(pool_id = current_pool)
      left <- left + 1
      right <- right - 1
      current_pool <- current_pool + 1
    } else {
      # 最小+最大不够的话，尝试两个最小的组合
      if (left + 1 <= right && sorted_df$mass[left] + sorted_df$mass[left+1] >= min_mass) {
        pool_groups[[current_pool]] <- sorted_df %>% slice(left, left+1) %>% mutate(pool_id = current_pool)
        left <- left + 2
        current_pool <- current_pool + 1
      } else {
        # 无法和任何样品组合达标，跳过该样品
        left <- left + 1
      }
    }
  }
  
  # 合并所有组的结果并计算每组总质量
  if (length(pool_groups) > 0) {
    bind_rows(pool_groups) %>%
      mutate(total_mass = sum(mass), .by = pool_id) %>%
      select(treatments, sample_id, mass, pool_id, total_mass)
  } else {
    tibble() # 返回空表
  }
}

# 按处理组分组执行合并
pooled_result <- poolneeded %>%
  group_by(treatments) %>%
  group_modify(~ process_group(.x)) %>%
  ungroup()

# 整合无需合并的样品与合并后的样品
final_result <- bind_rows(
  bigenough %>% mutate(pool_id = NA, total_mass = mass),
  pooled_result
) %>% arrange(treatments, pool_id, sample_id)

# 查看最终结果
print(final_result)

代码说明 #

1. 贪心策略逻辑：
   • 先将每个处理组的样品按质量从小到大排序；
   • 优先尝试最小与最大样品配对，达标则组成一组，最大化剩余样品的配对可能性；
   • 若最小+最大不达标，尝试两个最小样品组合；
   • 无法形成合格组合的样品直接跳过。
2. 结果整合：将无需合并的样品与合并后的样品统一整理，输出每个样品的归属组、总质量等信息，方便后续分析。

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