11

以下のデータフレームを考えてみましょう。各行を下の行と比較し、3 つ以上の値が等しい行を取得したいと考えています。

以下にコードを書きましたが、データフレームが大きいと非常に遅くなります。

どうすればそれをより速く行うことができますか?

data <- as.data.frame(matrix(c(10,11,10,13,9,10,11,10,14,9,10,10,8,12,9,10,11,10,13,9,13,13,10,13,9), nrow=5, byrow=T))
rownames(data)<-c("sample_1","sample_2","sample_3","sample_4","sample_5")

>data
          V1 V2 V3 V4 V5
sample_1  10 11 10 13  9
sample_2  10 11 10 14  9
sample_3  10 10  8 12  9
sample_4  10 11 10 13  9
sample_5  13 13 10 13  9

output <- data.frame(sample = NA, duplicate = NA, matches = NA)
dfrow <- 1
for(i in 1:nrow(data)) {
    sample <- data[i, ]
    for(j in (i+1):nrow(data)) if(i+1 <= nrow(data)) {
    matches <- 0
        for(V in 1:ncol(data)) {
            if(data[j,V] == sample[,V]) {       
                matches <- matches + 1
            }
        }
        if(matches > 3) {
            duplicate <- data[j, ]
            pair <- cbind(rownames(sample), rownames(duplicate), matches)
            output[dfrow, ] <- pair
            dfrow <- dfrow + 1
        }
    }
}

>output
   sample    duplicate    matches
1 sample_1   sample_2     4
2 sample_1   sample_4     5
3 sample_2   sample_4     4
4

7 に答える 7

9

これがRcppソリューションです。ただし、結果のマトリックスが大きくなりすぎる (つまり、ヒット数が多すぎる) 場合は、エラーがスローされます。ループを 2 回実行します。最初に必要なサイズの結果行列を取得し、次にそれを埋めます。おそらくもっと良い可能性があります。また、明らかに、これは整数でのみ機能します。行列が数値の場合、浮動小数点の精度に対処する必要があります。

library(Rcpp)
library(inline)

#C++ code:
body <- '
const IntegerMatrix        M(as<IntegerMatrix>(MM));
const int                  m=M.ncol(), n=M.nrow();
long                        count1;
int                         count2;
count1 = 0;
for (int i=0; i<(n-1); i++)
{
   for (int j=(i+1); j<n; j++)
   {
     count2 = 0;
     for (int k=0; k<m; k++) {
        if (M(i,k)==M(j,k)) count2++;
     }
     if (count2>3) count1++;
   } 
}
IntegerMatrix              R(count1,3);
count1 = 0;
for (int i=0; i<(n-1); i++)
{
   for (int j=(i+1); j<n; j++)
   {
     count2 = 0;
     for (int k=0; k<m; k++) {
        if (M(i,k)==M(j,k)) count2++;
     }
     if (count2>3) {
        count1++;
        R(count1-1,0) = i+1;
        R(count1-1,1) = j+1;
        R(count1-1,2) = count2;
     }
   } 
}
return  wrap(R);
'

fun <- cxxfunction(signature(MM = "matrix"), 
                     body,plugin="Rcpp")

#with your data
fun(as.matrix(data))
#      [,1] [,2] [,3]
# [1,]    1    2    4
# [2,]    1    4    5
# [3,]    2    4    4

#Benchmarks
set.seed(42)
mat1 <- matrix(sample(1:10,250*26,TRUE),ncol=26)
mat2 <- matrix(sample(1:10,2500*26,TRUE),ncol=26)
mat3 <- matrix(sample(1:10,10000*26,TRUE),ncol=26)
mat4 <- matrix(sample(1:10,25000*26,TRUE),ncol=26)
library(microbenchmark)
microbenchmark(
  fun(mat1),
  fun(mat2),
  fun(mat3),
  fun(mat4),
  times=3
  )
# Unit: milliseconds
#      expr          min           lq       median           uq          max neval
# fun(mat1)     2.675568     2.689586     2.703603     2.732487     2.761371     3
# fun(mat2)   272.600480   274.680815   276.761151   276.796217   276.831282     3
# fun(mat3)  4623.875203  4643.634249  4663.393296  4708.067638  4752.741979     3
# fun(mat4) 29041.878164 29047.151348 29052.424532 29235.839275 29419.254017     3
于 2013-11-01T16:23:36.210 に答える
3

編集:昨夜、等しいかどうかを直接テストできたことを考慮して、行を減算したときに何を考えていたのかわかりません。以下のコードから不要なステップを削除しました。

これは、少し賢いか、よく考えられていない可能性があるアプローチの 1 つですが、できれば前者です。行ごとに一連の比較を行う代わりに、データ フレームの残りの部分から行を減算し、ゼロに等しい要素の数を調べることで、ベクトル化された操作を実行できるという考え方です。このアプローチの簡単な実装を次に示します。

> library(data.table)
> data <- as.data.frame(matrix(c(10,11,10,13,9,10,11,10,14,9,10,10,8,12,9,10,11,10,13,9,13,13,10,13,9), nrow=5, byrow=T))
> rownames(data)<-c("sample_1","sample_2","sample_3","sample_4","sample_5")
> 
> findMatch <- function(i,n){
+   tmp <- colSums(t(data[-(1:i),]) == unlist(data[i,]))
+   tmp <- tmp[tmp > n]
+   if(length(tmp) > 0) return(data.table(sample=rownames(data)[i],duplicate=names(tmp),match=tmp))
+   return(NULL)
+ }
> 
> system.time(tab <- rbindlist(lapply(1:(nrow(data)-1),findMatch,n=3)))
   user  system elapsed 
  0.003   0.000   0.003 
> tab
     sample duplicate match
1: sample_1  sample_2     4
2: sample_1  sample_4     5
3: sample_2  sample_4     4

編集:これは、行列を使用してデータを事前に転置するバージョン2であるため、一度だけ行う必要があります。自明ではない量のデータを使用して、例に合わせてスケーリングする必要があります。

library(data.table)
data <- matrix(round(runif(26*250000,0,25)),ncol=26)
tdata <- t(data)

findMatch <- function(i,n){
    tmp <- colSums(tdata[,-(1:i)] == data[i,])
    j <- which(tmp > n)
    if(length(tmp) > 0) return(data.table(sample=i,duplicate=j+1,match=tmp[j]))
    return(NULL)
}

tab <- rbindlist(lapply(1:(nrow(data)-1),findMatch,n=3))

私は自分のマシンで少し実行し、最初の 1500 回の反復で 250,000 x 26 の完全な行列を 15 分以内に取得し、600 Mb のメモリを必要としました。以前の反復は将来の反復に影響を与えないため、これを部分に分割して、必要に応じて個別に実行できます。

于 2013-11-01T05:53:07.937 に答える
2

これは完全な答えではありません。頭に浮かぶ簡単なワークアウトは、代わりにマトリックスを使用することですdata.frame（これらは非常に遅いです）。行列は R で非常に高速であり、その中で少なくともいくつかの操作を完了し、ベクトルに列名を追加すると、速度が大幅に向上します。

簡単なデモ:

data <- matrix(c(10,11,10,13,9,10,11,10,14,9,10,10,8,12,9,10,11,10,13,9,13,13,10,13,9), nrow=5, byrow=T)rownames(data)<-c("sample_1","sample_2","sample_3","sample_4","sample_5")
mu<-c("sample_1","sample_2","sample_3","sample_4","sample_5")

t=proc.time()
tab <- data.frame(sample = NA, duplicate = NA, matches = NA)
dfrow <- 1
for(i in 1:nrow(data)) {
    sample <- data[i, ]
    for(j in (i+1):nrow(data)) if(i+1 <= nrow(data)) {
    matches <- 0
        for(V in 1:ncol(data)) {
            if(data[j,V] == sample[V]) {       
                matches <- matches + 1
            }
        }
        if(matches > 3) {
            duplicate <- data[j, ]
            pair <- cbind(mu[i], mu[j], matches)
            tab[dfrow, ] <- pair
            dfrow <- dfrow + 1
        }
    }
}
proc.time()-t

平均して、私のマシンでは、歩留まり

   user  system elapsed 
   0.00    0.06    0.06

あなたの場合、私は得る

 user  system elapsed 
   0.02    0.06    0.08

行列よりも速いものがあるかどうかはわかりません。並列化をいじることもできますが、for ループのC++コードのインライン化はかなり頻繁に使用されます (パッケージRcpp)。

于 2013-11-01T04:39:37.570 に答える
0

次のコードは、元のコードよりも約 3 倍速く実行されます。

f <- function(ind, mydf){
    res <- NULL
    matches <- colSums(t(mydf[-(1:ind),])==mydf[ind,])
    Ndups <- sum(matches > 3)
    if(Ndups > 0){
        res <- data.frame(sample=rep(ind,Ndups),duplicate=which(matches > 3), 
                      matches= matches[matches > 3],stringsAsFactors = F)
        rownames(res) <- NULL
        return(as.matrix(res))
    }
    return(res)
}


f(1,mydf=as.matrix(data))
f(2,mydf=as.matrix(data))
system.time( 
for(i in 1:1000){
    tab <- NULL
    for(j in 1:(dim(data)[1]-1))
        tab <- rbind(tab,f(j,mydf=as.matrix(data)))
}
)/1000
tab
于 2013-11-01T06:08:29.857 に答える