r - 加速 R 中的嵌套应用代码

Question

我在 R 中有一个包含 2 列的大型数据框(下面有 a 和 b 的样本)。

set.seed(12);n =5;n_a=5;n_b=5
id_lengths = sample(1:n,n_a,replace=T)
a = rep(1:n_a,id_lengths)
b = sample(1:n_b,length(a),replace =T)
data = data.frame(a = a,b = b)

我想在“a”列中为每个“a”获得一个唯一值的排序向量。该向量应根据基于列“b”的最大重叠进行排序。我正在使用以下代码来实现结果。

get_similar_ids = function(z){
    tmp = sapply(a_list,FUN = function(z1){length(intersect(z1,z))})
    sort(tmp,decreasing=T)
}
a_list = split(data$b,data$a)
lapply(a_list,FUN=get_similar_ids)

结果:

$`1`
1 2 3 4 5
1 1 0 0 0

$`2`
2 1 3 5 4
3 1 1 1 0

$`3`
3 2 4 1 5
3 1 1 0 0

$`4`
3 4 1 2 5
1 1 0 0 0

$`5`
2 5 1 3 4
1 1 0 0 0

问题是实际数据有很大的 n_a (~1700000)、n_b (~250000) 和 n(~15) 导致数据超过 1300 万行，对于如此大的值，此代码根本无法复制。
任何想法如何加快这些操作？

Answer 1

您可以在原始数据的制表上使用一些简单的线性代数获得所需的输出数据:

(x <- with(data,(table(a,b)>0) %*% (table(b,a)>0)))
   a
a   1 2 3 4 5
  1 1 1 0 0 0
  2 1 3 1 0 1
  3 0 1 3 1 0
  4 0 0 1 1 0
  5 0 1 0 0 1

然后只需按您想要的方式对其进行排序即可:

lapply(unique(data$a), function(y) sort(x[,y],decreasing=TRUE))
[[1]]
1 2 3 4 5 
1 1 0 0 0 

[[2]]
2 1 3 5 4 
3 1 1 1 0 

[[3]]
3 2 4 1 5 
3 1 1 0 0 

[[4]]
3 4 1 2 5 
1 1 0 0 0 

[[5]]
2 5 1 3 4 
1 1 0 0 0