Найти быстрое увеличение событий от порога до порога выше во временных рядах

Question

Привет. Я пытаюсь настроить функцию для поиска событий, в которых временная серия переходит от нижнего порога к более высокому за определенное количество временных шагов, но я чувствую, что должно быть более элегантное решение, и я Я не уверен на 100% Я захватил все дела

Пример данных

df <- data.frame(DateTime = seq.POSIXt(from = as.POSIXct("2019-01-01"),to = as.POSIXct("2019-01-02"), by ="hour"),
           Value = c(1,9,150,9,150,120,110,50,60,50,50,5,5,7,5,110,110,40,110,2,8,120,5,130,120))

Вот основная логика. Для minThresh и maxThresh (скажем, 10 и 100) и размера окна (здесь 4 дано в slide), я хочу сказать, что эта точка является пиком (output = 1), если все ниже:

• Это значение (последнее в окне) выше maxThresh
• Одно из значений в окне ниже minThresh
• Поскольку в последнем minThresh никакое другое значение не находится выше maxThresh (поэтому, если значения в окне (7,5,110,110), эта точка НЕ ​​будет пиковой, поскольку предыдущее значение будет присвоено как единое)

Вот что у меня есть

library(dplyr)
library(tsibble)

myfun <- function(dat, minThresh=10, maxThresh=100){
  thisVal <- dat[length(dat)]

  #Check this value > max threshold
  if(!thisVal > maxThresh) return(0)

  #Check there is a value less than min threshold
  belowThreshol <- which(dat<minThresh)
  if(length(belowThreshol)==0) return(0)

  #reset values after going above max and below min (so first peak doesn't stop 2nd peak counting)
  # eg for case (dat = c(1,500,2,500)) resets at 2
  aboveThreshol <- (dat>maxThresh)
  aboveThreshol[1:max(belowThreshol)] <- FALSE

  #check that thisValue is the first (after reset) > maxThresh
  if(min(which(aboveThreshol)) < length(dat)) return(0)

return(1)
}

df %>% mutate(test = slide_dbl(Value, myfun, .size = 4))

Я бы предпочел, если возможно, решение по тидиверсу

Answer 1

slide = 4
minThresh = 10
maxThresh = 100

Моя версия использует rollapply из zoo

myfun <- function(x) {
  min_ind <- which(x < minThresh)
  if ((x[length(x)] > maxThresh) & (length(min_ind) > 0)) #condition 1 & condition 2
    if(sum(x[max(min_ind):length(x)] > maxThresh) == 1) #condition 3
        return(1)
  return(0)
}

и теперь применяем эту функцию, используя скользящее окно размера slide

library(zoo)
library(dplyr)

df %>%
  mutate(test = lag(rollapply(Value,slide,myfun,fill = NA, align = "left"),slide-1))


#              DateTime Value test
#1  2019-01-01 00:00:00     1   NA
#2  2019-01-01 01:00:00     9   NA
#3  2019-01-01 02:00:00   150   NA
#4  2019-01-01 03:00:00     9    0
#5  2019-01-01 04:00:00   150    1
#6  2019-01-01 05:00:00   120    0
#7  2019-01-01 06:00:00   110    0
#8  2019-01-01 07:00:00    50    0
#9  2019-01-01 08:00:00    60    0
#10 2019-01-01 09:00:00    50    0
#11 2019-01-01 10:00:00    50    0
#12 2019-01-01 11:00:00     5    0
#13 2019-01-01 12:00:00     5    0
#14 2019-01-01 13:00:00     7    0
#15 2019-01-01 14:00:00     5    0
#16 2019-01-01 15:00:00   110    1
#17 2019-01-01 16:00:00   110    0
#18 2019-01-01 17:00:00    40    0
#19 2019-01-01 18:00:00   110    0
#20 2019-01-01 19:00:00     2    0
#21 2019-01-01 20:00:00     8    0
#22 2019-01-01 21:00:00   120    1
#23 2019-01-01 22:00:00     5    0
#24 2019-01-01 23:00:00   130    1
#25 2019-01-02 00:00:00   120    0

У нас естьздесь используется lag, потому что когда input равен c(5, 7, 5, 110), выход возвращается как 1, но он присваивается первым 5 в последовательности, тогда как нам нужно, чтобы вывод был 1 для 110, поэтому для этого нам нужно сдвинуть 1 относительноразмер окна.