Check for 5 consecutive TRUE values from the back of a vector

August 9, 2023

I have the following data:-

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]

What I want to create is a function which can subset first 5 consecutive T values but from the back. For ex., if I pass x object through that function, I should get the following output:-

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

Or if I pass y through it, I should just get an NA. Because there are no first 5 T values from the back.

z has first 5 consecutive T values in the middle and, hence, those should be returned.

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

In a, there are two sets of 5 consecutive values, in the beginning and in the end. Since, the first group from the back would be the one at the end and hence those values should be returned.

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

How can I make this function?

Thanks in advance.

>Solution :

With a basic for loop:

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

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

Benchmark

set.seed(42)
x <- sample(c(TRUE, FALSE), size = 1e6, replace = TRUE)
bench::mark(
  f(x),
  foo(x),
  last5(x)
)[1:4]
# # A tibble: 3 × 4
#   expression      min   median  `itr/sec`
#   <bch:expr> <bch:tm> <bch:tm>      <dbl>
# 1 f(x)          6.94s    6.94s      0.144
# 2 foo(x)        2.6µs      3µs 315299.   
# 3 last5(x)    61.51ms  89.64ms     11.3  

# With sparser TRUEs:
x <- sample(c(TRUE, FALSE), size = 1e6, replace = TRUE, prob = c(0.05, 0.95))
bench::mark(
  f(x),
  foo(x),
  last5(x)
)[1:4]
#   expression      min   median `itr/sec`
#   <bch:expr> <bch:tm> <bch:tm>     <dbl>
# 1 f(x)             7s       7s     0.143
# 2 foo(x)       89.6ms    104ms     9.40 
# 3 last5(x)     32.7ms   41.1ms    17.2