【发布时间】：2022-01-06 18:49:31
【问题描述】：
我之前创建了一个 for 循环来识别水位下降的时间段。这适用于较小的连续时间序列数据。
library(tidyverse)
library(lubridate)
level_data <- c(10:4, 20:9, 16:5, rep(0, 3))
times_stamp <- seq(ymd_hms('2015-07-22 12:15:00'), ymd_hms('2015-07-22 20:30:00'), by = '15 mins')
precip_data <- c(rep(0, 10), 1:4, rep(0, 10), 1:5, rep(0, 5))
maxP.neg <- .1
# Create objects for holding the start and end dates. These lists should end up
# the same length, so that each start date has a corresponding end date.
startDates <- c()
endDates <- c()
recede <- 0 # This is a switch to keep track of whether a recession period is in progress
for (i in 2:length(level_data)) { # i.e. start at the second data point
diffQ <- level_data[i] - level_data[i - 1] # Calculate difference between current and previous timestamp
if (diffQ < 0 && # If difference is negative (i.e. receding) AND
recede == 0 && # a recession period has not already begun (recede == 0) AND
precip_data <= maxP.neg) { # min. dry period criteria is met ...
startDates <- append(startDates, times_stamp[i]) # Record the start time of the recession period
recede <- 1 # Change recede to 1 to indicate a recession period has begun
} else if (diffQ >= 0 && # If the difference becomes positive
recede == 1) { # and a recession period was in progress...
endDates <- append(endDates, times_stamp[i - 1]) # Record the previous timestamp as the end date of the recession
recede <- 0 # Set recede back to 0 to show the recession period has ended
} else { # Otherwise just continue to the next data point.
next
}
}
但是，我想对有时间间隔的较大数据集执行相同的分析。我想将数据拆分为数据框列表并使用lapply 和自定义函数。
这是我想出的，但我没有得到与 for 循环方法相同的输出？
diff_Q <- diff(level_data)
date_time1 <-
seq(ymd_hms('2015-07-22 12:15:00'),
ymd_hms('2015-07-22 20:15:00'),
by = '15 mins')
date_time2 <-
seq(ymd_hms('2015-07-25 08:00:00'),
ymd_hms('2015-07-25 16:00:00'),
by = '15 mins')
cum_precip <- c(rep(0, 10), 1:4, rep(0, 10), 1:5, rep(0, 4))
df1 <-
data.frame(date_time1, diff_Q, cum_precip) %>% rename(date_time = date_time1)
df2 <-
data.frame(date_time2, diff_Q, cum_precip) %>% rename(date_time = date_time2)
recede_ls <- list(df1, df2)
startDates2 <- c()
endDates2 <- c()
RA.function <- function(x) {
recede <- 0
if (diff_Q < 0 &&
recede == 0 &&
cum_precip <= maxP.neg) {
startDates2 <- x$date_time
recede <- 1
} else if (diffQ >= 0 &&
recede == 1) {
endDates2 <- x$date_time[-1]
recede <-
0
} else {
next
}
}
lapply(recede_ls, RA.function)
感谢您的帮助！
【问题讨论】：
标签： r for-loop if-statement time-series lapply