Find consecutive integers in a window of an array greater than threshold value group-wise in R

Viewed 137

How can I get the index of the sample whose previous samples were consecutive in a window or range and were greater than a fixed threshold in groups?

In the below example, I need to find the time when I have consecutively 3 samples in a window that starts from 3rd element to the end of the array, and also whose speed is greater than 35 speed >= 35 group-wise

speed_threshold = 35

Group   Time    Speed
1       5       25 # Ignore first 3 elements
1       10      23 # Ignore first 3 elements
1       15      21 # Ignore first 3 elements
1       20      33 # Speed < 35 
1       25      40 # Speed > 35
1       30      42 # Speed > 35
1       35      52 # Speed > 35
1       40      48 # <--- Return time = 40 as answer for Group 1 !
1       45      52
2       5       48 # Ignore first 3 elements
2       10      42 # Ignore first 3 elements
2       15      39 # Ignore first 3 elements
2       20      36 # Speed > 35
2       25      38 # Speed > 35
2       30      46 # Speed > 35
2       35      53 # <--- Return time = 35 as answer for Group 2 !
3       5       45 # Ignore first 3 elements
3       10      58 # <--- Return time = NA as answer for group 3 !

The solution I have tried is as follows using data.table -

df[, {above <- Speed[-(1:3)] > speed_thresh 
ends <- which(above & rowid(rleid(above)) == 3)
.(Return_Time = Time[ends[1]+ 1])}
, Group]

The above solution removes the first three elements from the entire array, and not remove the first three elements in each group, how can I ignore the first three elements in each group and then find the consecutive integers exceeding the threshold?

Thanks in advance!

Note

Lines <- "Group   Time    Speed
1       5       25 # Ignore first 3 elements
1       10      23 # Ignore first 3 elements
1       15      21 # Ignore first 3 elements
1       20      33 # Speed < 35 
1       25      40 # Speed > 35
1       30      42 # Speed > 35
1       35      52 # Speed > 35
1       40      48 # <--- Return time = 40 as answer for Group 1 !
1       45      52
2       5       48 # Ignore first 3 elements
2       10      42 # Ignore first 3 elements
2       15      39 # Ignore first 3 elements
2       20      36 # Speed > 35
2       25      38 # Speed > 35
2       30      46 # Speed > 35
2       35      53 # <--- Return time = 35 as answer for Group 2 !
3       5       45 # Ignore first 3 elements
3       10      58 # <--- Return time = NA as answer for group 3 !"

df <- read.table(text = Lines, header = TRUE)
3 Answers

Here is a tidyverse solution...

library(dplyr)
speed_threshold <- 35

df %>% group_by(Group) %>% 
  mutate(ind = cumsum(Speed >= speed_threshold),      #nunber exceeding threshhold
         ind = ind - lag(ind, 3, default = 0),        #compared to 3 previous
         ind = lag(ind, default = 0) == 3) %>%        #mark one after where this hits 3
  summarise(Return_Time = Time[max(7,which(ind)[1])]) #has to be at least the 7th value


# A tibble: 3 x 2
  Group Return_Time
  <int>       <int>
1     1          40
2     2          35
3     3          NA
library(data.table)
setDT(df)

speed_thresh <- 35

df[, {
      window <- 4:.N
      above <- Speed[window] >= speed_thresh
      ends <- which(above & rowid(rleid(above)) == 3)
      .(Return_Time = Time[window][ends[1] + 1])
      }
, Group]
#>    Group Return_Time
#> 1:     1          40
#> 2:     2          35
#> 3:     3          NA

Let the ith value of roll be TRUE if the last 3 of 6 values ending at index i all exceed 35. Then find the first TRUE in each group, add 1 and index that into Time.

library(data.table)
library(zoo)

roll <- function(x) rollapplyr(x, 6, function(x) all(tail(x, 3) > 35), fill = FALSE)
DT[, list(Time = Time[which(roll(Speed))[1] + 1]), by = Group]

giving

   Group Time
1:     1   40
2:     2   35
3:     3   NA

Note

DF <- structure(list(Group = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L), Time = c(5L, 10L, 15L, 20L, 
25L, 30L, 35L, 40L, 45L, 5L, 10L, 15L, 20L, 25L, 30L, 35L, 5L, 
10L), Speed = c(25L, 23L, 21L, 33L, 40L, 42L, 52L, 48L, 52L, 
48L, 42L, 39L, 36L, 38L, 46L, 53L, 45L, 58L)), row.names = c(NA, 
-18L), class = "data.frame")
library(data.table)
DT <- as.data.table(DF)

Note 2

The poster indicated that they have old outdated versions of all packages and R and are restricted in installing packages so use this base R version of roll instead.

roll <- function(x) {
  f <- function(i) if (i < 6) FALSE else all(x[seq(to = i, length = 3)] > 35)
  sapply(seq_along(x), f)
}
Related