加速R中的嵌套应用代码

时间:2014-04-08 09:16:55

标签: r performance loops lapply

我在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万,这个代码根本不可复制值。 任何想法如何加快这些操作?

2 个答案:

答案 0 :(得分:4)

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

(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 

答案 1 :(得分:0)

您可以通过移除数据的重复行来进行一些加速,因为intersect对集合进行操作,因此不会计算相同 b的多个实例 a 中的。取决于大的n意味着什么(更多的行,更明显的a,更明显的b&#39,...?),另一种方法是通过以下方式生成所有重叠:

d2 <- data[!duplicated(data),]
mer <- merge(d2, d2, by="b")
table(paste0(d2$a.x, d2$a.y))

将为您提供所有非零重叠的a坐标。或table(d2$a.x, d2$a.y)然后您可以按行排序。