Question

我在一个数据框中有一个很大的时间序列full，在一个不同的数据框test中有一个时间戳列表。我需要将full与test中时间戳周围的数据点进行分组。我的第一直觉（作为一个R菜鸟）是写下面的，这是错误的

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)))

我觉得可能有更好的方法来做循环，this article恳求我们尽可能避免R循环。另一个原因是我可能会遇到性能问题，因为这将是优化算法的核心。非常感谢大师的任何建议。

编辑：

以下是一些可重现的代码，它们显示了错误的方法以及有效但可能更好的方法。

#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有正确的解决方案

Answer 1

这是一种真正的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)

现在将所有这些组合成一个函数：

> 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

我不知道这是更快，更好，还是什么。有人做了一些基准测试！

Answer 2

我不知道它是否更有效率，但我认为你也可以做这样的事情来得到你想要的东西：

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

我必须将“3”调整为“2”，因为x将包括在内。

基准测试（只是为了好玩）

@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

Answer 3

您的代码没有任何内在错误。为了实现您的目标，您需要围绕矢量化子集操作进行某种循环。

但是这里有更多的R-ish方法，这可能会更快：

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

Answer 4

使用data.tables的另一种方法：

{
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

使用2个数据帧在R中进行高效子集化

4 个答案:

基准测试（只是为了好玩）