4

あるデータフレームに大きな時系列fullがあり、別のデータフレームにタイムスタンプのリストがありtestます。fullのタイムスタンプを囲むデータポイントでサブセット化する必要がありtestます。私の最初の本能（R noobとして）は以下を書くことでしたが、それは間違っていました

subs <- subset(full,(full$dt>test$dt-i) & (full$dt<test$dt+i))

結果を見ると、Rが両方のベクトルを同時にループして間違った結果を出していることがわかりました。私のオプションは、次のようなループを作成することです。

subs<-data.frame()
for (j in test$dt) 
  subs <- rbind(subs,subset(full,full$dt>(j-i) & full$dt<(j+i)))

ループを実行するためのより良い方法があるかもしれないと私は感じます、そしてこの記事は私たちにRループをできるだけ避けるように懇願します。もう1つの理由は、これが最適化アルゴリズムの中心となるため、パフォーマンスの問題に直面する可能性があることです。教祖からの提案は大歓迎です。

編集：

これは、間違ったアプローチと、機能するがより良い可能性のあるアプローチを示す再現可能なコードです。

#create a times series
full <- data.frame(seq(1:200),rnorm(200,0,1))
colnames(full)<-c("dt","val")

#my smaller array of points of interest
test <- data.frame(seq(5,200,by=23))
colnames(test)<-c("dt")

# my range around the points of interset
i<-3 

#the wrong approach
subs <- subset(full,(full$dt>test$dt-i) & (full$dt<test$dt+i))

#this works, but not sure this is the best way to go about it
subs<-data.frame()
for (j in test$dt) 
  subs <- rbind(subs,subset(full,full$dt>(j-i) & full$dt<(j+i)))

編集：ユースケースをより適切に反映するように値を更新しましたが、@mrdwabのソリューションが予想外に大幅に進んでいることがわかりました。

@mrdwabのベンチマークコードを使用しています。初期化は次のとおりです。

set.seed(1)

full <- data.frame(
  dt  = 1:15000000,
  val = floor(rnorm(15000000,0,1))
)


test <- data.frame(dt = floor(runif(24,1,15000000)))

i <- 500

ベンチマークは次のとおりです。

       test replications elapsed relative
2    mrdwab            2    1.31  1.00000
3 spacedman            2   69.06 52.71756
1    andrie            2   93.68 71.51145
4  original            2  114.24 87.20611

まったく予想外。心=吹き飛ばされた。誰かがこの暗い隅に光を当てて、何が起こっているのかを教えてくれませんか。

重要：@mrdwabが以下に示すように、彼のソリューションは、ベクトルが整数の場合にのみ機能します。そうでない場合、@spacedmanは正しい解決策を持っています

4

4 に答える 4

6

これが実際のRの方法です。機能的に。ループなし...

Andrie のサンプル データから始めます。

まず、区間比較関数:

> cf = function(l,u){force(l);force(u);function(x){x>l & x<u}}

OR合成関数:

> OR = function(f1,f2){force(f1);force(f2);function(x){f1(x)|f2(x)}}

これらの比較関数のリストを作成するために、ここに一種のループがあります。

> funs = mapply(cf,test$dt-i,test$dt+i)

これらすべてを 1 つの関数に結合します。

> anyF = Reduce(OR,funs)

次に、OR 構成をインターバル テスト関数に適用します。

> head(full[anyF(full$dt),])
   dt         val
3   3 -0.83562861
4   4  1.59528080
5   5  0.32950777
6   6 -0.82046838
7   7  0.48742905
26 26 -0.05612874

これで得られたのは、値が定義した範囲内にあるかどうかをテストする単一変数の関数です。

> anyF(1:10)
 [1] FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE

これがより速いのか、それともより良いのか、それとも何なのかはわかりません。誰かベンチマークしてください！

于 2012-08-27T08:15:34.983 に答える
4

それがより効率的かどうかはわかりませんが、必要なものを得るために次のようなこともできると思います:

subs <- apply(test, 1, function(x) c((x-2):(x+2)))
full[which(full$dt %in% subs), ]

x両方の方法で含まれるため、「3」を「2」に調整する必要がありました。

ベンチマーク（楽しみのため）

@Spacedmanが先導します！

まず、必要なデータと機能。

## Data
set.seed(1)

full <- data.frame(
  dt  = 1:200,
  val = rnorm(200,0,1)
)

test <- data.frame(dt = seq(5,200,by=23))

i <- 3 

## Spacedman's functions
cf = function(l,u){force(l);force(u);function(x){x>l & x<u}}
OR = function(f1,f2){force(f1);force(f2);function(x){f1(x)|f2(x)}}
funs = mapply(cf,test$dt-i,test$dt+i)
anyF = Reduce(OR,funs)

第二に、ベンチマーク。

## Benchmarking
require(rbenchmark)
benchmark(andrie = do.call(rbind, 
                           lapply(test$dt, 
                                  function(j) full[full$dt > (j-i) & 
                                    full$dt < (j+i), ])),
          mrdwab = {subs <- apply(test, 1, 
                                  function(x) c((x-(i-1)):(x+(i-1))))
                    full[which(full$dt %in% subs), ]},
          spacedman = full[anyF(full$dt),],
          original = {subs <- data.frame()
                      for (j in test$dt) 
                        subs <- rbind(subs, 
                                      subset(full, full$dt > (j-i) & 
                                        full$dt < (j+i)))},
          columns = c("test", "replications", "elapsed", "relative"),
          order = "relative")
#        test replications elapsed  relative
# 3 spacedman          100   0.064  1.000000
# 2    mrdwab          100   0.105  1.640625
# 1    andrie          100   0.520  8.125000
# 4  original          100   1.080 16.875000
于 2012-08-27T07:24:27.387 に答える
4

コードに本質的な問題はありません。目的を達成するには、ベクトル化されたサブセット操作の周りに何らかのループが必要です。

しかし、これを行うためのより R っぽい方法を次に示します。

do.call(rbind, 
  lapply(test$dt, function(j)full[full$dt > (j-i) & full$dt < (j+i), ])
)

PS: 再現可能な例を大幅に簡素化できます。

set.seed(1)

full <- data.frame(
  dt  = 1:200,
  val = rnorm(200,0,1)
)

test <- data.frame(dt = seq(5,200,by=23))

i <- 3 

xx <- do.call(rbind, 
  lapply(test$dt, function(j)full[full$dt > (j-i) & full$dt < (j+i), ])
)

head(xx)
   dt         val
3   3 -0.83562861
4   4  1.59528080
5   5  0.32950777
6   6 -0.82046838
7   7  0.48742905
26 26 -0.05612874
于 2012-08-27T07:24:44.760 に答える
0

data.tables を使用したもう 1 つの方法:

{
temp <- data.table(x=unique(c(full$dt,(test$dt-i),(test$dt+i))),key="x")
temp[,index:=1:nrow(temp)]
startpoints <- temp[J(test$dt-i),index]$index
endpoints <- temp[J(test$dt+i),index]$index
allpoints <- as.vector(mapply(FUN=function(x,y) x:y,x=startpoints,y=endpoints))
setkey(x=temp,index)
ans <- temp[J(allpoints)]$x
}

ベンチマーク: テストの行数:9 完全な行数:10000

       test replications elapsed relative
1 spacedman          100   0.406    1.000
2       new          100   1.179    2.904

完全な行数:100000

       test replications elapsed relative
2       new          100   2.374    1.000
1 spacedman          100   3.753    1.581
于 2013-08-22T09:55:59.817 に答える