1

一意の整数座標とスコアを持つ 2 列の行列があります。

> data1<-data.matrix(data.frame("coord"=sample(1:100,50),"scores"=rnorm(25)))
> data1
      coord      scores
 [1,]    22 -0.73799827
 [2,]    76 -0.78022310
 [3,]    62  0.45633095
 [4,]    77  0.56617413
 [5,]    60 -0.94876368
 [6,]    83 -1.20792643
 [7,]    85 -1.13890957
 [8,]    78  0.63959763
 [9,]    28  0.28039908
[10,]    68 -1.04277456
[11,]    27  0.48755194
[12,]    66  0.09612861
[13,]    69 -1.60932063
[14,]     6 -0.66797103
[15,]    10 -0.56594989
[16,]    50 -0.79548555
[17,]    39  1.13064066
[18,]    75  0.21617203
[19,]    34 -0.13480437
[20,]    54 -1.64825097
[21,]    48 -0.97955118
[22,]    58  0.55307028
[23,]    11 -0.99319227
[24,]    42 -0.58430293
[25,]    37  1.76576096
[26,]    67 -0.73799827
[27,]    65 -0.78022310
[28,]    47  0.45633095
[29,]    72  0.56617413
[30,]    97 -0.94876368
[31,]    57 -1.20792643
[32,]    38 -1.13890957
[33,]    16  0.63959763
[34,]    15  0.28039908
[35,]    86 -1.04277456
[36,]    33  0.48755194
[37,]    80  0.09612861
[38,]     2 -1.60932063
[39,]    93 -0.66797103
[40,]    73 -0.56594989
[41,]    40 -0.79548555
[42,]    26  1.13064066
[43,]    13  0.21617203
[44,]    96 -0.13480437
[45,]    41 -1.64825097
[46,]    59 -0.97955118
[47,]    46  0.55307028
[48,]    43 -0.99319227
[49,]    94 -0.58430293
[50,]    21  1.76576096

および一意の座標のベクトル:

> centers
 [1]  39  31  61  16  48  82  42  76  71  43  93  35   6 100  67  81  70  79  45  17  96  78  69  95  29

センターに対して data1 のスコアをマップするマトリックスを作成したいと思います。ここで、各センターはマトリックスの中央で、行ごとに 1 つのセンターです。つまり、マトリックスでは、各「中心」の近くに座標を持つスコアを確認したいと考えています。私は次のアプローチを取りました：

> score_matrix<-matrix(nrow=length(centers),ncol=10)
> for(i in 1:length(centers)){
+ data2 <- data1
+ data2[,1] <- data2[,1] - centers[i] + ncol(score_matrix)/2
+ region_scores <- subset(data2,data2[,1] > 0 & data2[,1] <= ncol(score_matrix))
+ score_matrix[i,region_scores[,1]]<-region_scores[,2]
+ }
> print(score_matrix)
            [,1]       [,2]       [,3]       [,4]       [,5]       [,6]       [,7]       [,8]       [,9]      [,10]
 [1,] -0.8688788  0.4524561  1.4594981 -1.0552725 -0.1594024         NA -0.4122056         NA         NA         NA
 [2,] -1.0552725  1.5064965         NA -1.8956159         NA         NA         NA  0.7000265         NA         NA
 [3,]         NA         NA         NA -0.7334736         NA         NA -1.8381591 -1.8381591 -0.7334736         NA
 [4,]         NA         NA -0.3910595  1.5064965         NA -0.1006090  0.1064373  0.4524561         NA         NA
 [5,]         NA         NA  0.8967748         NA         NA         NA         NA  0.8458699 -0.1006090         NA
 [6,]         NA         NA -1.8381591 -1.8381591 -0.7334736         NA         NA         NA         NA         NA
 [7,] -1.3803871 -1.5606603         NA  0.8967748 -0.7036330         NA         NA         NA         NA -1.6780760
 [8,]         NA         NA         NA         NA  0.8458699 -0.1006090         NA -1.5606603         NA         NA
 [9,]         NA         NA         NA -1.3673480  1.8448811  1.1304699         NA -0.8317189  0.1064373 -1.4426410
[10,]  0.8967748 -0.7036330         NA         NA         NA         NA -1.6780760 -0.3910595         NA         NA
[11,]  1.1304699         NA         NA -1.0552725  1.5064965         NA -1.8956159         NA         NA         NA
[12,]         NA         NA -1.6780760 -0.7036330         NA         NA  0.8967748         NA         NA         NA
[13,]         NA         NA         NA -1.6780760 -0.7036330         NA         NA  0.8967748         NA         NA
[14,]         NA  0.8458699 -0.1006090         NA -1.5606603         NA         NA  0.8458699 -0.1594024         NA
[15,] -0.1006090         NA -1.5606603         NA         NA  0.8458699 -0.1594024         NA         NA -0.3910595
[16,]  1.8448811  1.1304699         NA -0.8317189  0.1064373 -1.4426410         NA  1.8448811         NA -1.4426410
[17,]         NA         NA -1.0552725  1.5064965         NA -1.8956159         NA         NA         NA  0.7000265
[18,]         NA         NA         NA         NA         NA -1.3673480  1.8448811  1.1304699         NA -0.8317189
[19,]         NA         NA         NA         NA -0.7334736         NA         NA -1.8381591 -1.8381591 -0.7334736
[20,]         NA         NA  0.7000265         NA         NA         NA -0.8688788  0.4524561  1.4594981 -1.0552725
[21,]         NA -1.3803871 -1.5606603         NA  0.8967748 -0.7036330         NA         NA         NA         NA
[22,] -0.7334736         NA         NA         NA         NA         NA -1.3673480  1.8448811  1.1304699         NA
[23,]         NA         NA         NA         NA -1.3673480  1.8448811  1.1304699         NA -0.8317189  0.1064373
[24,]         NA  1.4594981  0.7000265         NA -1.3673480 -0.8688788  1.1304699         NA         NA -1.0552725
[25,] -0.8317189  0.1064373 -1.4426410         NA  1.8448811         NA -1.4426410 -1.8956159         NA  1.4594981

ただし、これを適用するデータセットは非常に大きく、スクリプトが完了するまでに最大 24 時間かかります。同じことをより効率的に達成する方法はありますか?

ありがとう、

ダン

4

2 に答える 2

2

Rcpp で関数を実装します。

data1 <-data.matrix(data.frame("coord"=sample(1:100,50),"scores"=rnorm(25)))
centers <- unique(data1[,1])
score_matrix<-matrix(nrow=length(centers),ncol=10)
for(i in 1:length(centers)){
 data2 <- data1
 data2[,1] <- data2[,1] - centers[i] + ncol(score_matrix)/2
 region_scores <- subset(data2,data2[,1] > 0 & data2[,1] <= ncol(score_matrix))
 score_matrix[i,region_scores[,1]]<-region_scores[,2]
 }

library(inline)
library(Rcpp)

src <- '
  NumericMatrix data1(Rdata1);
  NumericVector centers(Rcenters);
  NumericMatrix score_matrix(Rscore_matrix);
  NumericVector data2(data1.nrow());
  for(int i = 0;i < centers.size();i++) {
    data2 = data1.column(0);
    data2 = data2 - centers(i) + score_matrix.ncol() / 2;
    for(int j = 0, k = 0;j < data2.size();j++) { // subset part
      if (data2(j) <= 0)
        continue;
      if (data2(j) > score_matrix.ncol())
        continue;
      score_matrix(i, data2(j) - 1) = data1(j,1);
    }
  }
  return score_matrix;
'

f <- cxxfunction(sig=c(Rdata1 = "numeric", Rcenters = "numeric", Rscore_matrix = "numeric"), 
  plugin="Rcpp", body=src)

score_matrix2<-matrix(nrow=length(centers),ncol=10)
score_matrix2 <- f(data1, centers, score_matrix2)
all.equal(score_matrix, score_matrix2)

library(rbenchmark) 

benchmark({
  score_matrix<-matrix(nrow=length(centers),ncol=10)
  for(i in 1:length(centers)){
   data2 <- data1
   data2[,1] <- data2[,1] - centers[i] + ncol(score_matrix)/2
   region_scores <- subset(data2,data2[,1] > 0 & data2[,1] <= ncol(score_matrix))
   score_matrix[i,region_scores[,1]]<-region_scores[,2]
   }
}, {
  score_matrix2<-matrix(nrow=length(centers),ncol=10)
  score_matrix2 <- f(data1, centers, score_matrix2)
})

前回のテストでは、私のマシンの Rcpp one は R one よりも約 12 倍高速です。

十分に高速でない場合は、可能であればアルゴリズムを並列化することをお勧めします。

Rパッケージsnowを試して、分割データとマージ結果のアルゴリズムを再設計してください。

于 2013-01-24T07:34:36.333 に答える
1

Rを再実装すると、47倍のスピードアップが得られます。これはあなたの元のコードの私の実装です

f0 <- function(data1, centers) {
    score_matrix <- matrix(nrow=length(centers), ncol=10)
    for(i in seq_along(centers)) {
        data2 <- data1
        data2[,1] <- data2[,1] - centers[i] + ncol(score_matrix) / 2
        idx <- data2[,1] > 0 & data2[,1] <= ncol(score_matrix)
        region_scores <- data2[idx,]
        score_matrix[i,region_scores[,1]] <- region_scores[,2]
    }
    score_matrix
}

centers[i] - ncol(score_matrix) / 2（の、およびサブセット化のdata1）一般的な計算を引き出して取得しました

f1 <- function(data1, centers, ncol=10) {
    score_matrix <- matrix(NA_real_, length(centers), ncol)
    ccenters <- centers - ncol / 2
    d1 <- data1[,1]
    d2 <- data1[,2]
    for (i in seq_along(ccenters)) {
        score <- d1 - ccenters[i]
        idx <- score > 0 & score <= ncol
        score_matrix[i, score[idx]] <- d2[idx]
    }
    score_matrix
}

forループはうまくコンパイルされるはずです

library(compiler)
f1c <- cmpfun(f1)

と

library(rbenchmark)
data1 <- data.frame(coord=sample(100,50), scores=rnorm(25))
centers <- sort(scan(textConnection("39 31 61 16 48 82 42 76 71 43 93 35 6
                                     100 67 81 70 79 45 17 96 78 69 95 29")))

与える

> identical(f0(data1, centers), f1(data1, centers))
[1] TRUE
> identical(f0(data1, centers), f1c(data1, centers))
[1] TRUE
> benchmark(f0(data1, centers), f1(data1, centers), f1c(data1, centers),
+           replications=10, columns=c("test", "elapsed", "relative"))
                 test elapsed relative
1  f0(data1, centers)   0.139   46.333
3 f1c(data1, centers)   0.003    1.000
2  f1(data1, centers)   0.005    1.667

元の質問の目的はどういうわけか不完全なようです-10,000x10のマトリックスで何をするつもりですか？

于 2013-01-24T14:50:19.183 に答える