在lapply/apply中用ifelse处理大数据集的报错排查与优化

需要对大数据集执行以下操作：

• 仅针对df$wr为TRUE的1%行
• 按name（共25个分类）分组
• 计算该行df$date之前最小的1000个df$time的均值，新变量命名为mean1000

小数据集测试有效，但当前代码执行后生成的df1是仅含mean1000变量的空表，且重复出现25次“Unknown or uninitialised column y”错误。

现有错误代码 #

df1 <- data.frame(
 mean1000 = lapply(
    split(df, df$name), function(y) 
      df$y$mean1000 = apply(y, 1, function(x) {ifelse(x["wr" == TRUE], 
        mean(sort(df$time[df$date < x["date"]])[2:1000]), NA)})) %>% 
  unlist()
)

数据样例 #

期望结果 #

新增mean1000列，仅wr为TRUE的行填入计算的均值，其余为NA。

尝试过的调整代码 #

# SORT DATA BY NAME AND DATE
df <- with(df, df[order(name, date),]) |> `row.names<-`(NULL)
df <- as.vector(df)

# CONDITIONALLY CALCULATE MEAN BY GROUP
df$mean1000 <- by(df, df$name, function(sub) {
  # ITERATE THROUGH EVERY DATE ROW WHILE CONDITIONALLY ADJUSTING BY wr FLAG
  mean1000 <- ifelse(sub$wr == TRUE, sapply(
    sub$date,
    # SUBSET AND CALCULATE MEAN
    FUN=\(dt) mean(sub$time[sub$date< dt][2:1000], na.rm=TRUE)
  ), NA_real_)
})
# CONVERT VECTOR BACK TO DATA FRAME AND RENAME COLUMN
df <- data.frame(df$id1, df$id2, df$id3, df$time, df$date, df$rank, df$name, df$wr, as.numeric(unlist(df$mean1000)))
colnames(df) <- c('id1', 'id2', 'id3', 'time', 'date', 'rank', 'name', 'wr', 'mean1000')

核心问题分析 #

1. 原错误代码问题：
   • 逻辑判断错误：x["wr" == TRUE]应为x["wr"] == TRUE
   • 跨组计算错误：引用全局df而非分组后的子数据集y，导致计算结果不符合分组要求
   • 赋值语句错误：df$y$mean1000写法完全错误，y是分组后的子数据框，不属于df的列
2. 调整后代码问题：
   • df <- as.vector(df)将数据框转为向量，彻底破坏数据结构，后续无法正常按列访问
   • by函数返回列表，直接赋值给df$mean1000会导致列类型异常

修正后的高效代码（dplyr+purrr，适合大数据集） #

library(dplyr)
library(purrr)

# 确保date列是Date类型
df$date <- as.Date(df$date)

# 处理流程：标记待计算行→分组排序→计算均值
df_processed <- df %>%
  # 随机抽取wr=TRUE中的1%行作为待计算对象
  mutate(is_selected = ifelse(wr, sample(c(TRUE, FALSE), n(), replace = TRUE, prob = c(0.01, 0.99)), FALSE)) %>%
  group_by(name) %>%
  arrange(date, .by_group = TRUE) %>%
  mutate(
    mean1000 = case_when(
      is_selected ~ map_dbl(date, ~{
        # 提取当前组中早于当前行date的time值
        prev_times <- time[date < .x]
        # 排序后取最小的1000个（若不足1000则取全部）
        top_smallest <- sort(prev_times)[1:1000]
        mean(top_smallest, na.rm = TRUE)
      }),
      TRUE ~ NA_real_
    )
  ) %>%
  ungroup() %>%
  select(-is_selected) # 移除临时标记列

纯基础R版本（无需第三方包） #

# 确保date列是Date类型
df$date <- as.Date(df$date)

# 1. 标记wr=TRUE中的1%行
df$is_selected <- FALSE
wr_true_rows <- which(df$wr)
selected_rows <- sample(wr_true_rows, size = round(length(wr_true_rows)*0.01))
df$is_selected[selected_rows] <- TRUE

# 2. 按name和date排序，方便后续取历史数据
df <- df[order(df$name, df$date), ]
df$mean1000 <- NA_real_

# 3. 分组计算均值
for (group_name in unique(df$name)) {
  sub_df <- df[df$name == group_name, ]
  for (row_idx in seq_len(nrow(sub_df))) {
    if (sub_df$is_selected[row_idx]) {
      # 获取当前行之前的time值
      prev_times <- sub_df$time[sub_df$date < sub_df$date[row_idx]]
      # 取最小1000个值计算均值
      top_smallest <- sort(prev_times)[1:1000]
      df$mean1000[df$name == group_name & df$date == sub_df$date[row_idx]] <- mean(top_smallest, na.rm = TRUE)
    }
  }
}

# 移除临时列
df$is_selected <- NULL

关键注意事项 #

• 如果原代码中[2:1000]是刻意跳过第一个值，请保留，但需处理数据不足的情况：if(length(prev_times)>=1000) sort(prev_times)[2:1000] else prev_times
• 大数据集优先选择dplyr版本，避免循环带来的性能瓶颈
• 若不需要随机抽取1%，可替换为按比例取前/后行的逻辑

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