使用rle和for循环超过阈值的最长连续周期

Question

我有一个月的四年的流量数据，我正试图找出如何在四年中的每一年提取出某个阈值或以上的最长连续时间段。在下面的示例中，阈值是4。我想尝试使用for循环或可能的apply函数之一来实现这一点，但我不确定如何实现。

这是我的示例数据框架:

year <- c(rep(2009,31), rep(2010, 31), rep(2011, 31), rep(2012, 31))
day<-c(rep(seq(1:31),4))
discharge <- c(4,4,4,5,6,5,4,8,4,5,3,8,8,8,8,8,8,8,1,2,2,8,8,8,8,8,8,8,8,8,4,4,4,5,6,3,1,1,3,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,9,10,3,3,3,3,3,3,1,1,3,8,8,8,8,8,8,8,8,8,1,2,2,8,8,3,8,8,8,8,8,8,4,4,4,5,6,3,1,1,3,3,3,3,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,9,3)

df<-data.frame(cbind(year, day, discharge))
df$threshold<-ifelse(discharge>=4,1,0)

在此示例中，如果放电等于或高于阈值，则阈值列编码为 1，如果不是，则编码为 0。我能够使用以下代码部分获得一年（以下示例中的 2009 年）的所需输出：

rl2009<-with(subset(df,year==2009),rle(threshold))
cs2009 <- cumsum(rl2009$lengths)
index2009<-cbind(cs2009[rl2009$values == 1] - rl2009$length[rl2009$values == 1] + 1,
cs2009[rl2009$values == 1])
df2009<-data.frame(index2009)
df2009 #ouput all periods when flow is above threshold
df2009$X3<-df2009$X2-df2009$X1+1

max2009<-df2009[which.max(df2009$X3),]
max2009 #output the first and longest period when flow is above threshold

对于2009年，有三个时间段的流量等于或超过4，但是选择从第1天到第10天的时间段，因为这是高于阈值的最长时间段的第一个。X1代表时间段的开始，X2代表时间段的结束，X3代表时间段中的天数。如果有多个相同天数的周期，我希望选择第一个周期。

我四年的预期产出如下：

year   X1  X2  X3
2009    1  10  10
2010    9  31  23
2011   10  18   9
2012   12  30  19

实际的数据包括更多的年份和许多流，因此不可能逐年进行。如果有人对如何实现这一目标有任何想法，我们将不胜感激。谢谢

Answer 1

简单地说，使用定义的函数（例如threshold_find）概括您的流程，并将每年子集的数据帧传递到其中，这些数据帧可以通过以下方式处理。

作为< code>tapply的面向对象包装器，< code>by按一个或多个因子(即年份)对数据帧进行切片，并返回定义的函数输出的任何对象的列表，这里是最大数据帧。最后，< code>do.call() row将< code>by列表中的所有数据帧绑定到一个数据帧中。

threshold_find <- function(df) {
  rl <- with(df, rle(threshold))      
  cs <- cumsum(rl$lengths)

  index <- cbind(cs[rl$values == 1] - rl$length[rl$values == 1] + 1,
                 cs[rl$values == 1])
  df <- data.frame(index)
  df$X3 <- df$X2 - df$X1+1

  max <- df[which.max(df$X3),]
  max      
}

finaldf <- do.call(rbind, by(df, df$year, FUN=threshold_find))

finaldf
#      X1 X2 X3
# 2009  1 10 10
# 2010  9 31 23
# 2011 10 18  9
# 2012 12 30 19