我正在编写一个脚本，以识别河流流量数据集的递减片段：
我想自动过滤掉具有特定条件的递减细分。段的定义如下：
考虑到这些条件，这是我要保留的唯一部分（红色部分）。
我对做什么感到困惑，我缺乏R知识，并且害怕错过一个明显的解决方案。我已经用以下代码获得了“峰值”索引（对于流> 12）：
## get a column with "1" for decreasing values and "0" for increasing values
df <- df %>% mutate(sign = NA)
sapply(1:nrow(df)-1, function(i){
df$sign[i] <<- df$flow[i] - df$flow[i+1]
})
df <- df %>% mutate(sign=case_when(sign>=0 ~ 1, sign<0 ~ 0))
## get the indexes of the beginning of each decreasing segment
rle <- rle(df$sign)
rle$lengths <- cumsum(rle$lengths)
rle <- rle$lengths[which(rle$values==0)]
rle <- rle + 1
## only keep the indexes with flow > 12
rle <- rle[rle %in% which(df$flow>12)]
现在，我不知道如何正确地编写可以应用其他两个条件的脚本，这主要是因为对少量增加的部分（5％条件）的容忍度。
这是一个可重现的示例：
df <- structure(list(date = structure(c(16594, 16595, 16596, 16597,
16598, 16599, 16600, 16601, 16602, 16603, 16604, 16605, 16606,
16607, 16608, 16609, 16610, 16611, 16612, 16613, 16614, 16615,
16616, 16617, 16618, 16619, 16620, 16621, 16622, 16623, 16624,
16625, 16626, 16627, 16628, 16629, 16630, 16631, 16632, 16633,
16634, 16635, 16636, 16637, 16638, 16639, 16640, 16641, 16642,
16643, 16644, 16645, 16646, 16647, 16648, 16649, 16650, 16651,
16652, 16653, 16654, 16655, 16656, 16657, 16658, 16659, 16660,
16661, 16662, 16663, 16664, 16665, 16666, 16667, 16668, 16669,
16670, 16671, 16672, 16673, 16674, 16675, 16676, 16677, 16678,
16679, 16680, 16681, 16682, 16683, 16684, 16685, 16686, 16687,
16688, 16689, 16690, 16691, 16692, 16693, 16694, 16695, 16696,
16697, 16698, 16699, 16700, 16701, 16702, 16703, 16704, 16705,
16706, 16707, 16708, 16709, 16710, 16711, 16712, 16713, 16714,
16715, 16716, 16717, 16718, 16719, 16720, 16721, 16722, 16723,
16724, 16725, 16726, 16727, 16728, 16729, 16730, 16731, 16732,
16733, 16734, 16735, 16736, 16737, 16738, 16739, 16740, 16741,
16742, 16743, 16744, 16745, 16746, 16747, 16748, 16749, 16750,
16751, 16752, 16753, 16754, 16755, 16756, 16757, 16758, 16759,
16760, 16761, 16762, 16763, 16764, 16765, 16766, 16767, 16768,
16769, 16770, 16771, 16772, 16773, 16774, 16775, 16776, 16777,
16778, 16779, 16780, 16781, 16782, 16783, 16784, 16785, 16786,
16787, 16788, 16789, 16790, 16791, 16792, 16793, 16794, 16795,
16796, 16797, 16798, 16799, 16800, 16801, 16802, 16803, 16804,
16805, 16806, 16807, 16808, 16809, 16810, 16811, 16812, 16813,
16814, 16815, 16816, 16817, 16818, 16819, 16820), class = "Date"),
flow = c(10.3, 10.3833333333333, 10.5666666666667, 10.6625,
10.7416666666667, 12.0166666666667, 12.9375, 14.2166666666667,
15.0666666666667, 15.7833333333333, 16.125, 15.95, 15.6041666666667,
15.1375, 14.55, 14.1, 13.7708333333333, 13.4125, 13.05, 12.7875,
12.525, 12.2625, 12.0791666666667, 11.8666666666667, 11.6291666666667,
11.4166666666667, 11.1916666666667, 11.0708333333333, 10.8875,
10.7458333333333, 10.6416666666667, 10.5666666666667, 10.4333333333333,
10.3125, 10.2, 10.1416666666667, 10.025, 9.95125, 9.8775,
9.77666666666667, 9.73833333333333, 9.68, 9.60958333333333,
9.51791666666667, 9.455, 9.43083333333333, 9.39166666666667,
9.2775, 9.2275, 9.18458333333333, 9.1225, 9.08291666666667,
9.05083333333333, 9.01083333333333, 8.96625, 8.88208333333333,
8.80875, 8.75416666666667, 8.69583333333333, 8.66416666666667,
8.595, 8.51333333333333, 8.50625, 8.50958333333333, 8.55375,
8.3575, 8.19916666666667, 8.16125, 8.10666666666667, 8.07208333333333,
8.005, 7.955, 7.895, 7.79833333333333, 7.76166666666667,
7.715, 7.73625, 8.1675, 9.86291666666667, 9.8675, 9.45166666666667,
9.0075, 8.63583333333333, 8.33791666666667, 8.11083333333333,
8.02791666666667, 8.03041666666667, 7.98625, 7.9275, 7.84083333333333,
7.71208333333333, 7.64875, 7.63958333333333, 7.58416666666667,
7.52083333333333, 7.50125, 7.44875, 7.44916666666667, 7.5775,
7.95, 7.86, 7.7575, 8.32208333333333, 8.24833333333333, 8.01958333333333,
7.85791666666667, 7.70166666666667, 7.50291666666667, 7.35,
7.23958333333333, 7.08416666666667, 6.9825, 6.92375, 7.03,
7.30291666666667, 7.205, 6.97375, 8.83583333333333, 18.1041666666667,
20.5208333333333, 19.7041666666667, 18.3166666666667, 17.1,
15.9875, 15.2458333333333, 14.4625, 13.8, 15.2166666666667,
17.9916666666667, 18.1708333333333, 17.5166666666667, 16.6083333333333,
15.9416666666667, 15.45, 15.0958333333333, 14.7666666666667,
14.4958333333333, 14.1, 13.7375, 13.35, 13.025, 12.8916666666667,
12.6083333333333, 13.6708333333333, 14.5833333333333, 14.4666666666667,
14.025, 13.6458333333333, 13.3166666666667, 13.1625, 13.5083333333333,
13.9, 13.975, 13.6958333333333, 13.4458333333333, 13.1458333333333,
12.7416666666667, 12.4, 12.1416666666667, 11.9416666666667,
11.6833333333333, 11.4083333333333, 11.1833333333333, 11.025,
10.6583333333333, 10.5166666666667, 10.4416666666667, 10.3833333333333,
10.25, 10.0875, 9.9325, 9.89, 9.87083333333333, 9.65416666666667,
9.40166666666667, 9.25791666666667, 9.11791666666667, 8.955,
8.83458333333333, 8.75, 8.66541666666667, 8.59125, 8.74083333333333,
9.00041666666667, 8.92625, 8.69541666666667, 8.615, 8.91416666666667,
8.51583333333333, 8.50041666666667, 8.39541666666667, 8.2425,
8.11208333333333, 8.04708333333333, 7.96916666666667, 7.91583333333333,
7.8475, 7.83875, 7.77708333333333, 7.71083333333333, 7.60875,
7.48375, 7.35625, 7.25583333333333, 7.23583333333333, 7.12166666666667,
7.11375, 7.07, 7.23375, 8.99166666666667, 10.2475, 10.4333333333333,
10.2625, 10.1, 9.98083333333333, 10.15, 10.825, 11.7416666666667,
11.9333333333333, 11.9083333333333, 11.8666666666667, 11.6833333333333,
11.5875, 11.3583333333333, 11.075, 10.8208333333333, 10.6708333333333
)), row.names = c(NA, -227L), spec = structure(list(cols = list(
date = structure(list(format = "%d.%m.%Y %H:%M"), class = c("collector_datetime",
"collector")), flow = structure(list(), class = c("collector_double",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector")), skip = 1), class = "col_spec"), class = c("tbl_df",
"tbl", "data.frame"))
任何帮助将不胜感激。首先在这里发布，所以我会采取任何建议来改善我的问题。
谢谢！
这是使用dplyr和的解决方案datatable
library(data.table)
library(dplyr)
df = df %>%
arrange(date) %>%
# flow*0.05 will add the 5% tolerance
mutate(sign = case_when((flow-lead(flow))+(flow*0.05) >= 0 ~ 1, TRUE ~ 0)) %>%
# group by run-length type id
group_by(rleid(sign), sign) %>%
filter(first(sign) == 1 & first(flow) >= 12 & min(flow) <= 7.5)
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句