Как заменить цикл «for» и операторы if / else if?Извлечение данных из фрейма данных

Question

Я работаю в R на фрейме данных, состоящем из данных времени и осадков (более 3 000 000 значений, измеряемых каждую минуту)

Я хотел бы извлечь все "эпизоды осадков", которые фактически являются всеми моментамикогда шел дождь (dp! = 0, но также включая возможный перерыв в дожде, но не больше, чем «a» следующих измерений)

Я бы хотел, чтобы все эпизоды были сохранены в новом фрейме данных с дополнительнымистолбец с номером каждого из них.Первый дождь - 1, Второй - 2 ....

Пример "эпизода осадков":

time <- c("2013-01-01 11:39:00",
        "2013-01-01 11:40:00", "2013-01-01 11:41:00",
        "2013-01-01 11:42:00","2013-01-01 11:43:00",
        "2013-01-01 11:44:00","2013-01-01 11:45:00",
        "2013-01-01 11:46:00","2013-01-01 11:47:00",
        "2013-01-01 11:48:00","2013-01-01 11:49:00",
        "2013-01-01 11:50:00","2013-01-01 11:51:00",
        "2013-01-01 11:52:00","2013-01-01 11:53:00")

time <- as.POSIXct(time , origin="1899-12-30",tz="GMT")

p<- c(1.565, 1.565, 1.658, 1.795, 1.795, 1.795, 1.896, 1.896, 2.985, 2.985, 
      2.985, 2.985, 3.5, 3.7, 3.85)

df <- data.frame(time, p)   
dp <- diff(df$p)

df$dp<- c(dp,0)

Я создал функцию, используя цикл for и (много) условия ifчто, я надеюсь, хорошо отражает мои намерения.В настоящее время он не работает должным образом - все еще ищет причину.

rain.episodes<- function(x) {
  a<- 300
  episode.number <- 1
  rain <- reja.clean[1,] #just for column names

  for (i in 1:nrow(x)) {

    if (x[i,"dp"] >0) {
        rain[i,]<- x[i,]
        rain[i, "episode.number"]<- episode.number
        a<-0

    } else if (x[i,"dp"] ==0 & a<300) {
        rain[i,]<- x[i,]
        rain[i, "episode.number"]<- episode.number
        a<-a+1

    } else if (a==301) {
        episode.number<-episode.number+1

    } else{
          a<-a+1
    }
  }
  return(rain)
}

Есть ли способ создать функцию, помогающую мне в этой проблеме, с тем же выводом, что и я вставил, но с использованием другого (лучше) метод?

Я также хотел бы знать, почему моя функция не работает.

Answer 1

Это может работать:

#load libraries
library(dplyr)
library(lubridate)
library(zoo) # for `na.locf`
library(data.table) # for Step 2

Шаг 1: Определить эпизоды дождей / не дождей: ИСТИНА / ЛОЖЬ

df_new <- df[-1,] %>% #remove the first non-rainy observation to suit `na.locf`**
  arrange(time) %>%
  # create ind_hour to keep the time when it rained
  mutate(ind_hour = ifelse (dp != 0, format(as.POSIXct(time) ,format = "%Y-%m-%d %H:%M:%S"), NA)) %>%
  # when it did not rain (i.e. ind_hour is NA), add an extra hour to the last known time when it rained (use na.locf to get the last time when it rained)
  mutate(ind_hour_complete = ifelse(is.na(ind_hour), (na.locf(as.POSIXct(ind_hour, format = "%Y-%m-%d %H:%M:%S", tz="GMT")) + hours(1)), time)) %>%
  # if `time` is lower or equal to the `ind_hour_complete`, then we are looking at the same episode
  mutate(same_episode = time <= ind_hour_complete) %>%
  select(-ind_hour, -ind_hour_complete) 

** Примечание: внутри вектора, который начинается сNA, na.locf удалит его, а результирующий вектор будет иметь длину (n-1).Здесь результаты будут сдвигаться вверх на один ряд.Вы можете попробовать код, не удаляя первую строку из df, чтобы понять, что я имею в виду.При необходимости вы можете добавить эту первую строку в самом конце с ep_number, равным max(df_new$ep_number) + 1 (чтобы гарантировать, что ep_number уникален).Я полностью удалил его, потому что он, кажется, вам не нужен (в соответствии с ожидаемым результатом).

Шаг 2: Добавьте индексы для идентифицированных эпизодов: ep_number

df_new <- setDT(df_new)[, ep_number:= rleid(same_episode)]