有没有一种有效的方法可以在 R 中向后搜索大向量?

Is there an efficient way to backward search a large vector in R?

我有一个包含 10+ 百万个元素的向量。 我需要找到满足给定条件 A 的所有元素(例如 X < 2 at rows i %in% c(6,10))。 从这些元素中的每一个,我需要向后浏览向量并在它们满足条件 B 时标记所有前面的元素(例如 X < 4 for i %in% c(8:10) and c(5:6))。

例如,给定以下 X 列,我希望最终结果为 flag2 列。我对 B 为真的元素不感兴趣,如果它们不紧挨着满足 A 的元素之前,因此行 i == 2flag2 == 0

  i  |  X  | flag1 | flag2
---------------------------
  1  |  4  |   0   |   0
  2  |  3  |   0   |   0
  3  |  6  |   0   |   0
  4  |  9  |   0   |   0
  5  |  3  |   0   |   1
  6  |  1  |   1   |   1
  7  |  9  |   0   |   0
  8  |  3  |   0   |   1
  9  |  2  |   0   |   1
 10  |  1  |   1   |   1

第一个产生flag1的操作很简单也很快:

# locate all occurrences of X < 2
my_data$flag1 = dplyr::case_when(my_data$X < 2 ~ 1, T ~ 0)

我已经使用以下 for 循环实现了第二个操作,它给出了所需的结果,但考虑到数据量,它非常耗时。

# flag all elements preceding the ones already flagged while they satisfy `X < 4`
my_data$flag2 = my_data$flag1
for(i in nrow(my_data):2){
  if((my_data[i,]$flag2 == 1) & (my_data[i-1,]$X < 4)){ 
    my_data[i-1,]$flag2 = 1
  }
}

有什么方法可以更有效地做到这一点?

希望下面的可以播种。 它是 subsetting 并将 flag 的索引移动一个位置并重复它直到它不再标记:

my_data  <- data.frame(X=c(4,3,6,9,3,1,9,3,2,1))

my_data$flag1 <- my_data$X < 2
my_data$flag2 <-  my_data$flag1
repeat {
  tt <- my_data$X < 4 & c(my_data$flag2[-1], FALSE)
  if(all(!(tt & !my_data$flag2))) break
  my_data$flag2[tt]  <- TRUE
}
my_data
   X flag1 flag2
1  4 FALSE FALSE
2  3 FALSE FALSE
3  6 FALSE FALSE
4  9 FALSE FALSE
5  3 FALSE  TRUE
6  1  TRUE  TRUE
7  9 FALSE FALSE
8  3 FALSE  TRUE
9  2 FALSE  TRUE
10 1  TRUE  TRUE

或使用Reduce:

my_data  <- data.frame(X=c(4,3,6,9,3,1,9,3,2,1))

my_data$flag1 <- my_data$X < 2
my_data  <- my_data[nrow(my_data):1,]
fun <- function(x, y) {c(y[[1]] || (x[[1]] && y[[2]]), FALSE)}
my_data$flag2  <- do.call(rbind, Reduce(fun
  , as.data.frame(rbind(my_data$flag1, my_data$X < 4))[,-1]
  , c(my_data$flag1[1], FALSE), accumulate = TRUE))[,1]
my_data  <- my_data[nrow(my_data):1,]
my_data
#   X flag1 flag2
#1  4 FALSE FALSE
#2  3 FALSE FALSE
#3  6 FALSE FALSE
#4  9 FALSE FALSE
#5  3 FALSE  TRUE
#6  1  TRUE  TRUE
#7  9 FALSE FALSE
#8  3 FALSE  TRUE
#9  2 FALSE  TRUE
#10 1  TRUE  TRUE

还有另一种可能,使用 purrr 包中的 accumulate 函数:

library(tidyverse)

my_data  <- data.frame(X=c(4,3,6,9,3,1,9,3,2,1))

my_fun <- function(flag1, xlag) if ((flag1 == 1 & xlag < 4) | xlag < 2) 1 else 0

my_data %>%
  mutate(flag1 = if_else(X < 2, 1, 0),
         flag2 = rev(accumulate(rev(X), my_fun, .init = last(flag1))[-1]))

   X flag1 flag2
1  4     0     0
2  3     0     0
3  6     0     0
4  9     0     0
5  3     0     1
6  1     1     1
7  9     0     0
8  3     0     1
9  2     0     1
10 1     1     1

如果您可以使用 data.table 包,那么 1000 万行只需不到 1 秒,使用:

library(data.table)
nr <- 10e6
set.seed(0L)
my_data <- data.frame(X=sample(1:9, nr, TRUE))

system.time({
    setDT(my_data)[, flag2 := { 
        flag1 <- X < 2
        b <- rleid(X < 4)
        +(b %in% b[flag1])
    }]
})

#   user  system elapsed 
#   0.30    0.12    0.42 

输出:

          X flag2
       1: 9     0
       2: 4     0
       3: 7     0
       4: 1     1
       5: 2     1
      ---        
 9999996: 6     0
 9999997: 1     1
 9999998: 9     0
 9999999: 6     0
10000000: 1     1

head(my_data, 10):

    X flag2
 1: 9     0
 2: 4     0
 3: 7     0
 4: 1     1
 5: 2     1
 6: 7     0
 7: 2     1
 8: 3     1
 9: 1     1
10: 5     0