带条件的R多层嵌套for循环如何使用lapply实现代码加速

你现有代码运行慢的核心原因不是嵌套for循环的语法问题，是三个重复的高开销操作：

• 13万患者 × 40个药品 = 520万次磁盘文件读取，占总耗时90%以上
• 循环内逐次rbind拼接大表，每次操作都要重新拷贝全量已生成数据，内存开销指数级上升
• 用apply(is.na(...),1,all)判断全NA行，计算效率远低于data.table原生向量化操作

先解决你之前看不懂的基础概念：
你之前困惑的function(x)、function(i)没有特殊含义：就是把你原来for循环里每次遍历的元素（比如当前患者IDp）作为参数传入自定义处理函数，x就是被传入的循环值，等价于原来循环里的临时变量。

改造步骤 #

1. 提前固定所有要遍历的药品名、药品文件路径，避免在循环里反复拼字符串
2. 把单患者的处理逻辑封装成独立函数，用lapply批量跑所有患者
3. 把循环内逐次rbind的操作改成最后一次性拼接列表结果，消除逐次内存拷贝

library(data.table)
# 提前准备固定参数
drug_list <- sort(unique(MFR_join$DRUG_NAME))
patient_list <- sort(unique(MFR_join$ID))
setkey(trunk, ID) # 给trunk设置索引，后续过滤速度提升10倍以上

# 封装单患者处理逻辑，传入参数p为当前处理的患者ID
process_one_patient <- function(p) {
  # 取当前患者对应的trunk基底
  trunk_sub <- trunk[ID == p]
  k_flag <- 1
  patient_final <- NULL
  # 内层药品遍历逻辑和你原代码完全一致
  for (d in drug_list) {
    drug_sub <- fread(paste0("path_of_drug", d))[ID == p]
    if (k_flag == 1) {
      patient_final <- merge.data.table(trunk_sub, drug_sub, by = c("ID", "DATE"), all.x = T)
      k_flag <- 0
    } else {
      patient_final <- merge.data.table(patient_final, drug_sub, by = c("ID", "DATE"), all.x = T)
    }
  }
  # 向量化判断全NA行，和原逻辑一致
  drug_cols <- 3:42
  all_na_row <- apply(is.na(patient_final[, ..drug_cols]), 1, all)
  patient_final[!all_na_row]
}

# 用lapply遍历所有患者，返回结果列表，每个元素是单患者处理好的表
processed_list <- lapply(patient_list, process_one_patient)

# 最后一次性拼接所有患者结果，只做1次rbind操作，代替原代码13万次逐次rbind
final_structure <- rbindlist(processed_list)

进一步提速的并行改造 #

如果需要再缩时间，可以把上面的lapply换成并行版本，自动调用电脑所有CPU核心跑：

library(future.apply)
# 启动并行后台，自动留1个核心给系统操作
plan(multisession, workers = future::availableCores() - 1)
# 把原来的lapply换成future_lapply，逻辑完全不变
processed_list <- future_lapply(patient_list, process_one_patient)
final_structure <- rbindlist(processed_list)

上面的lapply改造只是优化了循环结构、消除了rbind的内存开销，但还是保留了“每个患者重复读40个文件”的最大性能黑洞。只要把这部分逻辑反过来，根本不需要按患者拆分循环，也不会出现你之前担心的“连接几次就卡住”的问题：

1. 全局一次性读完所有40个药品文件，只需要40次磁盘IO，代替520万次读操作
2. 全局一次性完成trunk和所有药品表的连接，代替13万次逐患者的连接操作
3. 批量一次性删除全NA行

示例代码：

# 1. 全局读所有药品文件，按ID、DATE键合并
drug_full <- NULL
for (d in drug_list) {
  current_drug <- fread(paste0("path_of_drug", d))
  setkey(current_drug, ID, DATE)
  if (is.null(drug_full)) {
    drug_full <- current_drug
  } else {
    drug_full <- merge(drug_full, current_drug, by = c("ID", "DATE"), all = T)
  }
}

# 2. 全局一次性左连接到trunk，代替逐患者连接
setkey(trunk, ID, DATE)
full_data <- merge(trunk, drug_full, by = c("ID", "DATE"), all.x = T)

# 3. 批量删除所有药品列全为NA的行，用向量化计算代替apply
drug_col_pos <- which(grepl("_MFR_CATEGORY$", names(full_data)))
# 计算每行有多少个非NA的药品值，非NA个数为0的行直接删掉
row_non_na_count <- full_data[, rowSums(!is.na(.SD)), .SDcols = drug_col_pos]
final_structure <- full_data[row_non_na_count > 0]

你之前遇到的“连接15次就卡住”的问题，不是全局连接本身的问题，是循环里逐次rbind、逐次重新拷贝全量数据导致内存溢出。用上面的全局连接+data.table的索引优化，13万患者×2500天的总规模，即使40个药品列全加载，内存占用也完全在普通电脑的承受范围内，不会卡死。

• lapply本身不会让代码变快：它和普通for循环的计算效率基本一致，优势是不需要手动维护结果列表、不需要写初始值判断的逻辑、不容易写错循环索引。真正的提速来自消除重复IO、避免逐次内存拷贝、换成向量化计算。
• 如果你保留“每个患者都读一遍药品文件”的逻辑，就算换成lapply+满核心并行，也只能把时间从半年缩短到几十天，根本达不到你需要的速度。
• 之前论坛帖子里提到的“不要滥用lapply”，是指不要为了用lapply而用lapply，lapply解决的是循环写法的简洁性问题，不是性能问题。

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