有没有一种有效的方法可以在 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 == 2
有 flag2 == 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
我有一个包含 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 == 2
有 flag2 == 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