如何高效统计R数据框列表间符合条件的交集累加次数

场景说明 #

现有两个R数据框：

df <- data.frame(
  D = c('A', 'B', 'C'),
  Q = c('asd', 'reg', 'rt'),
  id = I(list(c(124, 532, 78), c(1, 3, 532), c(2, 3, 78, 124, 1)))
)

clusters <- data.frame(
 g = I(list(c(124, 78, 1),c(2, 3, 89),c(532, 533)))
)

需求描述 #

需要统计df每行的id列表与clusters每行的g列表的交集元素数量，仅当交集元素数大于1时，才将该交集数量累加到对应行的count值中，最终得到如下格式的结果：

out <- data.frame(
  D = c('A', 'B', 'C'),
  Q = c('asd', 'reg', 'rt'),
  id = I(list(c(124, 532, 78), c(1, 3, 532), c(2,3,78, 124, 1))),
  count = c(2, 0, 5)
)

由于df数据量达7万行，嵌套循环实现效率极低，因此需要高效的非循环方法。

不可用的循环逻辑 #

for row in df:
  count = 0
  for group in clusters:
     intersection_size = length(intersect(group, row$id))
     if intersection_size > 1:
        count = count + intersection_size

高效实现方案（基于data.table，性能最优） #

针对大样本量，data.table的底层优化能提供最快的处理速度：

library(data.table)

# 转换为data.table并添加行索引
setDT(df)[, row_idx := .I]
setDT(clusters)[, cluster_idx := .I]

# 将列表列展开为长格式，保留分组索引
df_long <- df[, .(id = unlist(id)), by = .(row_idx, D, Q)]
clusters_long <- clusters[, .(g = unlist(g)), by = cluster_idx]

# 匹配id与g，统计每个(df行, cluster行)组合的交集大小
match_stats <- df_long[clusters_long, on = .(id = g), allow.cartesian = TRUE][
  , .(intersect_size = .N), by = .(row_idx, cluster_idx)][
    intersect_size > 1][, .(count = sum(intersect_size)), by = row_idx]

# 合并统计结果回原数据框，补全缺失的count为0
result <- df[match_stats, on = "row_idx"][
  , count := fifelse(is.na(count), 0, count)][
    , row_idx := NULL]

# 输出结果
result

备选方案（基于tidyverse，代码更易读） #

如果习惯使用tidyverse生态，也可以用以下实现：

library(tidyverse)

# 展开df的id列，保留行索引
df_long <- df %>%
  mutate(row_idx = row_number()) %>%
  unnest_longer(id)

# 展开clusters的g列，保留cluster索引
clusters_long <- clusters %>%
  mutate(cluster_idx = row_number()) %>%
  unnest_longer(g)

# 匹配并统计交集大小，筛选后累加
match_stats <- df_long %>%
  inner_join(clusters_long, by = c("id" = "g")) %>%
  count(row_idx, cluster_idx, name = "intersect_size") %>%
  filter(intersect_size > 1) %>%
  group_by(row_idx) %>%
  summarise(count = sum(intersect_size))

# 合并回原数据框，补全0值
result <- df %>%
  mutate(row_idx = row_number()) %>%
  left_join(match_stats, by = "row_idx") %>%
  mutate(count = replace_na(count, 0)) %>%
  select(-row_idx)

# 输出结果
result

方案说明 #

这两种方法的核心逻辑一致：

1. 将嵌套的列表列展开为长格式，把每个元素单独成行；
2. 通过连接操作匹配两个数据框中的元素；
3. 分组统计每个df行与cluster行的交集大小；
4. 筛选出交集大小>1的记录，累加得到每行的count；
5. 合并回原数据框并补全无符合条件匹配的行的count为0。

这种方式避开了R原生循环的低效，利用向量化操作和底层优化的分组统计，处理7万行数据的速度会比循环快几个数量级。

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