检查向量后面的 5 个连续 TRUE 值

Question

我有以下数据：

x <- c(F, T, T, T, F, T, T, T, T, T)
names(x) <- letters[1:10]
y <- c(T, F, T, T, T, F, T, T, T, T)
names(y) <- letters[1:10]
z <- c(T, T, F, T, T, T, T, T, F, F)
names(z) <- letters[1:10]
a <- c(T, T, T, T, T, F, T, F, T, T, T, T, T)
names(a) <- letters[1:13]

我想创建一个函数，它可以对前 5 个连续T值进行子集化，但从后面开始。例如，如果我x通过该函数传递对象，我应该得到以下输出：

#    f    g    h    i    j 
# TRUE TRUE TRUE TRUE TRUE

或者如果我通过y它，我应该得到一个NA. T因为后面没有前5个值。

zT中间有前 5 个连续值，因此应该返回这些值。

#    d    e    f    g    h 
# TRUE TRUE TRUE TRUE TRUE

在 中a，有两组 5 个连续值，分别位于开头和结尾。因为，从后面开始的第一组将是最后的组，因此应该返回这些值。

#    i    j    k    l    m 
# TRUE TRUE TRUE TRUE TRUE

我怎样才能实现这个功能？

Answer 1

这是一个用于rle计算值运行的解决方案

last5 <- function(x) {
  with(rle(x), {
    group <- tail(which(lengths>=5 & values), 1)
    if (length(group)<1) return(NA)
    start <- ifelse(group>1, sum(lengths[1:(group-1)]),0) + (lengths[group]-5)+1
    x[start:(start+4)]
  })  
}

给出以下输出

last5(x)
#    f    g    h    i    j 
# TRUE TRUE TRUE TRUE TRUE 
last5(y)
# [1] NA
last5(z)
#    d    e    f    g    h 
# TRUE TRUE TRUE TRUE TRUE 
last5(a)
#    i    j    k    l    m 
# TRUE TRUE TRUE TRUE TRUE 

这个想法是，它找到所有具有超过 5 个 TRUE 值的运行，然后获取最后一组（如果有）并获取该组中的最后 5 个值）

Answer 2

使用基本的 for 循环：

\n

foo <- function(x) {\n  true_in_a_row <- 0L\n  found         <- FALSE\n  for (i in length(x):1L) {\n    if (x[i]) true_in_a_row <- true_in_a_row + 1L else true_in_a_row <- 0L\n    if (true_in_a_row == 5L) {\n      found <- TRUE\n      break\n    }\n  }\n  if (found) x[i:(i+4L)] else NA\n}\n

\n\n

foo(x)\n#    f    g    h    i    j \n# TRUE TRUE TRUE TRUE TRUE \nfoo(y)\n# [1] NA\nfoo(z)\n#    d    e    f    g    h \n# TRUE TRUE TRUE TRUE TRUE \nfoo(a)\n#    i    j    k    l    m \n# TRUE TRUE TRUE TRUE TRUE \n

\n\n

基准

\n

set.seed(42)\nx <- sample(c(TRUE, FALSE), size = 1e6, replace = TRUE)\nbench::mark(foo(x), last5(x), f_zoo(x), f_gregexpr(x), f_rle(x), f_embed(x))[1:4]\n# # A tibble: 6 \xc3\x97 4\n#   expression         min   median   `itr/sec`\n#   <bch:expr>    <bch:tm> <bch:tm>       <dbl>\n# 1 foo(x)           1.9\xc2\xb5s    6.2\xc2\xb5s 152792.    \n# 2 last5(x)         107ms 149.53ms      5.35  \n# 3 f_zoo(x)        14.39s   14.39s      0.0695\n# 4 f_gregexpr(x) 259.58ms 283.42ms      3.53  \n# 5 f_rle(x)         1.94s    1.94s      0.514 \n# 6 f_embed(x)    187.22ms 201.41ms      5.04  \n\n# With sparser TRUEs:\nx <- sample(c(TRUE, FALSE), size = 1e6, replace = TRUE, prob = c(0.05, 0.95))\nbench::mark(foo(x), last5(x), f_zoo(x), f_gregexpr(x), f_rle(x), f_embed(x))[1:4]\n# 1 foo(x)         33.12ms  33.36ms    29.0  \n# 2 last5(x)       13.11ms   25.5ms    37.9  \n# 3 f_zoo(x)         5.14s    5.14s     0.194\n# 4 f_gregexpr(x)  75.98ms  76.72ms    12.6  \n# 5 f_rle(x)      208.37ms 221.82ms     4.58 \n# 6 f_embed(x)     69.01ms  80.64ms    11.9 \n

\n