如何加速大量ID对的citing_id交集计算（R语言场景）

数据背景 #

我有一个包含8547287条观测的R语言data.frame，结构如下：

> str(database)
'data.frame':   8547287 obs. of  4 variables:
 $ cited_id       : num  4.06e+08 5.41e+07 5.31e+07 5.04e+07 3.79e+08 ...
 $ cited_pub_year : num  2014 1989 2002 2002 2015 ...
 $ citing_id      : num  3.34e+08 3.37e+08 4.06e+08 4.19e+08 4.25e+08 ...
 $ citing_pub_year: num  2011 2011 2013 2014 2014 ...

示例数据：

cited_id cited_pub_year citing_id citing_pub_year
1  405821349           2014 419185055            2011
2  405821349           1989 336621202            2011
3   53148996           2002 406314162            2013
4   53148996           2002 419185055            2014
5  379369076           2015 424901495            2014
6   53148996           2011 441055669            2015
7  405821349           2014 447519383            2015
8  405821349           2015 469644221            2016
9  329268142           2014 470861263            2016
10  45433355           2008  55422577            2008

需求是计算每一对cited_id的citing_id交集长度（记为Pj.k），比如ID 405821349和53148996的交集是419185055，所以Pj.k=1。

原代码的问题 #

之前尝试的双重循环代码运行耗时极长，核心问题包括：

• 双重循环遍历所有ID对，时间复杂度为O(n²)，当唯一ID数量较大时，计算量呈指数级增长
• 每次循环重复筛选数据，没有预分组处理，浪费计算资源
• 使用rbind动态扩容数据框，每次扩容都要重新分配内存，效率极低
• 未对重复的cited_id-citing_id记录去重，导致交集计算做无用功

原代码：

total_id<-c(database$cited_id,database$citing_id)
total_id<-unique(total_id)

df<-data.frame(data_k=character(),data_j=character(),Pj.k=numeric(),
               stringsAsFactors = F)

for (k in 1:(length(total_id)-1)) {
  data_k<-total_id[k]
  citing_data_k<-database[database$cited_id==data_k,]
  
  for (j in (k+1):length(total_id)) {
    data_j<-total_id[j]
    citing_data_j<-database[database$cited_id==data_j,]
    Pj.k<-length(intersect(citing_data_j$citing_id,citing_data_k$citing_id))
    dfxx=data.frame(data_k=data_k,data_j=data_j,Pj.k=Pj.k,
                    stringsAsFactors = F)
    df<-rbind(df,dfxx)
  }
}

优化方案 #

方案1：基于预分组的高效计算（适合唯一ID数量较少的场景） #

使用data.table预分组处理数据，避免循环，同时提前去重减少计算量：

library(data.table)
setDT(database)

# 第一步：去重，保留唯一的cited_id-citing_id组合
db_unique <- unique(database, by = c("cited_id", "citing_id"))

# 第二步：按cited_id分组，将对应的citing_id整理为集合列表
citing_sets <- db_unique[, .(citing_set = list(unique(citing_id))), by = cited_id]

# 第三步：生成所有不重复的cited_id对（data_k < data_j，避免重复计算）
cited_ids <- unique(db_unique$cited_id)
id_pairs <- CJ(data_k = cited_ids, data_j = cited_ids)[data_k < data_j]

# 第四步：关联两组的citing集合，计算交集长度
id_pairs <- id_pairs[citing_sets, on = .(data_k = cited_id), citing_set_k := i.citing_set]
id_pairs <- id_pairs[citing_sets, on = .(data_j = cited_id), citing_set_j := i.citing_set]
id_pairs[, Pj.k := mapply(function(x, y) length(intersect(x, y)), citing_set_k, citing_set_j)]

# 清理临时列
id_pairs[, c("citing_set_k", "citing_set_j") := NULL]

方案2：反向统计（适合唯一ID数量大、大部分ID对无共同引用的场景） #

通过citing_id反向推导共引对，只处理存在共同引用的ID对，大幅减少计算量：

library(data.table)
setDT(database)

# 第一步：去重，保留唯一的citing_id-cited_id组合
db_unique <- unique(database, by = c("citing_id", "cited_id"))

# 第二步：按citing_id分组，生成该引用下所有cited_id的两两组合
# 注意：combn仅当每组cited_id数量≥2时生成组合
cited_pairs <- db_unique[, .(pair = combn(cited_id, 2, simplify = FALSE)), by = citing_id]

# 第三步：展开组合，统一按data_k < data_j排序避免重复
cited_pairs <- cited_pairs[, .(
  data_k = pmin(pair[[1]], pair[[2]]),
  data_j = pmax(pair[[1]], pair[[2]])
), by = citing_id]

# 第四步：按ID对分组，计数即为交集长度（每个计数对应一个共同的citing_id）
result <- cited_pairs[, .(Pj.k = .N), by = .(data_k, data_j)]

额外优化建议 #

• 优先使用方案2，因为它只处理有共同引用的ID对，内存和计算效率远高于方案1
• 如果必须使用基础R，可将database转换为data.table或tbl_df，避免使用基础R的循环和rbind
• 确保ID列使用整数类型（如as.integer()），比数值类型更节省内存且运算更快

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