有效地计算R中大向量中成对差异的直方图?

时间:2012-03-02 01:14:54

标签: performance r iteration nested-loops

我正在使用R中的一个大整数向量(大约1000万个整数),我需要找到这个向量中每个不同的整数对,它们相差500或更少,并得出它们差异的直方图(即每一对,第二对减去第一对。)

这是完全未实现的代码,用于非常缓慢地执行我想要的操作:

# Generate some random example data
V <- round(rnorm(100) * 1000)

# Prepare the histogram
my.hist <- rep(0, 500)
names(my.hist) <- as.character(seq(1,500))
for (x1 in V) {
    for (x2 in V) {
        difference = x2 - x1
        if (difference > 0 && difference <= 500) {
            my.hist[difference] = my.hist[difference] + 1
        }
    }
}

(假设每个整数都是唯一的,因此difference > 0位是可以的。这是允许的,因为我实际上并不关心差异为零的任何情况。)

这是一些矢量化内循环的代码:

my.hist2 <- rep(0, 500)
names(my.hist2) <- as.character(seq(1,500))
for (x1 in V) {
    differences <- V[V > x1 & V <= x1+500] - x1
    difftable <- table(differences)
    my.hist2[names(difftable)] = my.hist2[names(difftable)] + difftable
}

这肯定比第一版快。然而,当V仅包含500000个元素(50万个)时,即使这个变体已经太慢了。

我可以在没有任何显式循环的情况下执行此操作,如下所示:

X <- combn(V, 2)
# X is a matrix with two rows where each column represents a pair
diffs <- abs(X[2,] - X[1,])
my.hist3 <- table(diffs[diffs <= 500])

但矩阵X将包含10e6 * (10e6 - 1) / 2或大约50,000,000,000,000列,这可能是个问题。

那么有没有办法在没有显式循环(太慢)或扩展所有对的矩阵(太大)的情况下做到这一点?

如果您想知道为什么我需要这样做,我正在实施这个:http://biowhat.ucsd.edu/homer/chipseq/qc.html#Sequencing_Fragment_Length_Estimation

1 个答案:

答案 0 :(得分:16)

一种可能的改进是对数据进行排序: 距离小于500的对(i,j) 然后将接近对角线, 而且你不必探索所有的价值观。

代码看起来像这样(它仍然很慢)。

n <- 1e5
k <- 500
V <- round(rnorm(n) * n * 10)
V <- as.integer(V)
V <- sort(V)
h <- rep(0,k)

for(i in 1:(n-1)) {
  for(j in (i+1):n) {
    d <- V[j] - V[i]
    if( d > k ) break
    if( d > 0 ) h[d] <- h[d]+1
  }
}

编辑:如果你想要更快的东西,你可以在C中编写循环。 你的1000万元素需要1秒。

n <- 10e6
k <- 500
V <- round(rnorm(n) * n * 10)
V <- as.integer(V)
V <- sort(V)
h <- rep(0,k)

library(inline)
sig <- signature(n="integer", v="integer", k="integer", h="integer")
code <- "
  for( int i = 0; i < (*n) - 1; i++ ) {
    for( int j = i + 1; j < *n; j++ ) {
      int d = v[j] - v[i];
      if( d > *k ) break;
      if( d > 0 ) h[d-1]++;
    }
  }
"
f <- cfunction( sig, code, convention=".C" )
h <- f(n,V,k,h)$h