在另一个数据帧中按范围过滤一个数据帧的有效方法

Question

假设我有一个数据框,其中包含一堆数据和一个日期/时间列,指示何时收集每个数据点.我有另一个列出时间跨度的数据框,其中"开始"列表示每个跨距开始的日期/时间,"结束"列表示每个跨度结束的日期/时间.

我在下面使用简化数据创建了一个虚拟示例:

main_data = data.frame(Day=c(1:30))

spans_to_filter = 
    data.frame(Span_number = c(1:6),
               Start = c(2,7,1,15,12,23),
               End = c(5,10,4,18,15,26))

我玩弄了几种解决这个问题的方法,最后得到了以下解决方案:

require(dplyr)    
filtered.main_data =
    main_data %>% 
    rowwise() %>% 
    mutate(present = any(Day >= spans_to_filter$Start & Day <= spans_to_filter$End)) %>% 
    filter(present) %>% 
    data.frame()

这工作得非常好,但是我注意到如果我有大量数据可能需要一段时间来处理(我假设因为我正在进行逐行比较).我还在学习R的来龙去脉,我想知道是否有更有效的方法来执行此操作,最好是使用dplyr/tidyr？

Answer 1

在从v1.9.8开始的data.table包中,已经实现了非equi连接.有了这个,我已经inrange()为这种操作创建了一个包装函数,其中任务涉及查找一个点是否位于所提供的任何间隔中,如果是TRUE,则返回,否则FALSE.

require(data.table) # v>=1.9.8
setDT(main_data)[Day %inrange% spans_to_filter[, 2:3]] # inclusive bounds
#     Day
#  1:   1
#  2:   2
#  3:   3
#  4:   4
#  5:   5
#  6:   7
#  7:   8
#  8:   9
#  9:  10
# 10:  12
# 11:  13
# 12:  14
# 13:  15
# 14:  16
# 15:  17
# 16:  18
# 17:  23
# 18:  24
# 19:  25
# 20:  26

了解?inrange更多.

Answer 2

这是一个函数,您可以dplyr使用between函数(from dplyr)运行以查找给定范围内的日期.对于每个值Day,mapply运行between在每一对的Start和End日期和函数使用rowSums返回TRUE如果Day是他们中的至少一个之间.我不确定它是否是最有效的方法,但它导致速度提高了近四倍.

test.overlap = function(vals) {
  rowSums(mapply(function(a,b) between(vals, a, b), 
                 spans_to_filter$Start, spans_to_filter$End)) > 0
}

main_data %>% 
  filter(test.overlap(Day))

如果您正在使用日期(而不是日期时间),那么创建特定日期的向量并测试成员资格可能更有效(即使使用日期时间,这可能是更好的方法):

filt.vals = as.vector(apply(spans_to_filter, 1, function(a) a["Start"]:a["End"]))

main_data %>% 
  filter(Day %in% filt.vals)

现在比较执行速度.我缩短了你的代码只需要过滤操作:

library(microbenchmark)

microbenchmark(
  OP=main_data %>% 
    rowwise() %>% 
    filter(any(Day >= spans_to_filter$Start & Day <= spans_to_filter$End)),
  eipi10 = main_data %>% 
    filter(test.overlap(Day)),
  eipi10_2 = main_data %>% 
    filter(Day %in% filt.vals)
  )

Unit: microseconds
     expr      min       lq      mean    median       uq      max neval cld
       OP 2496.019 2618.994 2875.0402 2701.8810 2954.774 4741.481   100   c
   eipi10  658.941  686.933  782.8840  714.4440  770.679 2474.941   100  b 
 eipi10_2  579.338  601.355  655.1451  619.2595  672.535 1032.145   100 a   

更新:下面是一个测试,它有一个更大的数据框和一些额外的日期范围来匹配(感谢@Frank在他现在删除的评论中提出这个建议).事实证明,在这种情况下速度增益要大得多(对于该mapply/between方法约为200倍,对于第二种方法仍然要大得多).

main_data = data.frame(Day=c(1:100000))

spans_to_filter = 
  data.frame(Span_number = c(1:9),
             Start = c(2,7,1,15,12,23,90,9000,50000),
             End = c(5,10,4,18,15,26,100,9100,50100))

microbenchmark(
  OP=main_data %>% 
    rowwise() %>% 
    filter(any(Day >= spans_to_filter$Start & Day <= spans_to_filter$End)),
  eipi10 = main_data %>% 
    filter(test.overlap(Day)),
  eipi10_2 = {
    filt.vals = unlist(apply(spans_to_filter, 1, function(a) a["Start"]:a["End"]))
    main_data %>% 
      filter(Day %in% filt.vals)}, 
  times=10
  )

Unit: milliseconds
     expr         min          lq        mean      median          uq         max neval cld
       OP 5130.903866 5137.847177 5201.989501 5216.840039 5246.961077 5276.856648    10   b
   eipi10   24.209111   25.434856   29.526571   26.455813   32.051920   48.277326    10  a 
 eipi10_2    2.505509    2.618668    4.037414    2.892234    6.222845    8.266612    10  a