временные ряды и dplyr, обнаружение событий (проблема обмена датами) - PullRequest
2 голосов
/ 06 апреля 2020

Я надеюсь, что кто-нибудь может помочь мне с следующей проблемой обнаружения событий. Входные данные представляют собой временные ряды (обычные). Он содержит «время», «уровень воды» и «сток». Цель состоит в том, чтобы обнаружить события выше порога и извлечь время, когда оно начинается, время, когда оно заканчивается, продолжительность в минутах и ​​максимальное / суммарное значение во время события. Как определение, каждое событие должно быть сокращено при изменении даты. Вместо этого NA должны приводить к отключению события, только если продолжительность пропущенных значений превышает час.

library(data.table)
library(dplyr)
library(xts)

## data
dWL <- structure(list(Time = structure(c(1463951500, 1463951800, 1463952100, 1463952400, 1463952700, 1463953000, 1463953300, 1463953600, 1463953900, 1463954200, 1463954500, 1463954800, 1463955100, 1463955400, 1463955700, 1463956000),class = c("POSIXct", "POSIXt"), tzone = ""), WL = c(0.2, 2.5, 2.4, 2.1, 0.9, 2.8, 2.9, 1.9, 2.4, NA, 2.3, 2.6, 2.8, 2.1, 2.0, 1.9), Q = c(0.0, 255.5, 232.4, 150.1, 0.0, 345.8, 382.9, 0.0, 214.4, NA, 201.3, 312.6, 362.8, 80.1, 20.0, 0.0)), row.names = c(NA, -16L), class = "data.frame")
## threshold value
vth <-2


na.omit(dWL) %>%  ## ??how to drop NAs only when the NA-duration is longer than an hour??
  mutate(tmp_WL = WL >= vth, id = rleid(tmp_WL)) %>%
  filter(tmp_WL) %>%
  group_by(id) %>% ## ??how to additional seperate events during change-of-date??
  summarise(start_time=first(Time),end_time=last(Time), event_duration = difftime(last(Time), first(Time)), max_Q=max(Q), sum_Q=sum(Q))

Мне известен пакет heatwaveR с его очень полезной функцией exceedance, хотя мне так и не удалось заставить его работать в под-ежедневных временных рядах.

1 Ответ

1 голос
/ 06 апреля 2020

Поскольку вы пометили это как data.table, давайте использовать это. Мы можем использовать кодирование длин серий с rleid() для отслеживания событий. Как только у нас есть идентификатор для каждого, мы можем сделать простую группу и выполнить наши вычисления. В конце мы просто удаляем столбец RLE, устанавливая его в NULL и используем [], чтобы увидеть результат.

library(data.table)
setDT(dWL)[!is.na(WL),event := WL > vth][
  ,RLE := rleidv(event)][
    event == TRUE,.(start = min(Time),
                    end=max(Time),
                    max.WL=max(WL),
                    duration=difftime(max(Time),min(Time)),
                    runoff=sum(Q)),
    by=RLE][,RLE:=NULL][]
#                 start                 end max.WL duration runoff
#1: 2016-05-22 17:16:40 2016-05-22 17:26:40    2.5  10 mins  638.0
#2: 2016-05-22 17:36:40 2016-05-22 17:41:40    2.9   5 mins  728.7
#3: 2016-05-22 17:51:40 2016-05-22 17:51:40    2.4   0 mins  214.4
#4: 2016-05-22 18:01:40 2016-05-22 18:16:40    2.8  15 mins  956.8

Данные

dWL <- structure(list(Time = structure(c(1463951500, 1463951800, 1463952100, 1463952400, 1463952700, 1463953000, 1463953300, 1463953600, 1463953900, 1463954200, 1463954500, 1463954800, 1463955100, 1463955400, 1463955700, 1463956000),class = c("POSIXct", "POSIXt"), tzone = ""), WL = c(0.2, 2.5, 2.4, 2.1, 0.9, 2.8, 2.9, 1.9, 2.4, NA, 2.3, 2.6, 2.8, 2.1, 2.0, 1.9), Q = c(0.0, 255.5, 232.4, 150.1, 0.0, 345.8, 382.9, 0.0, 214.4, NA, 201.3, 312.6, 362.8, 80.1, 20.0, 0.0)), row.names = c(NA, -16L), class = "data.frame")
vth <- 2
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...