在没有循环的时间序列中找出最大的下降/上升（最好使用tidy/dplyr）？

我有很多时间序列，想找到一种方法来确定每个时间序列的前十大涨跌

这并不像听起来那么容易，因为时间序列上最显著的特征有时会被相反方向的运动打断，即使只是很短的时间（例如一个周期）。这意味着任何简单地扫描同一方向上最连续的运动周期的算法通常无法找到最显著的特征（例如，人类可以识别的特征）

是否有“开箱即用”的标准方法

例如，在下表中，如果要求确定最显著的瀑布，人类可能会指向圆圈区域。我们如何获得代码来识别这些坠落（就像人类一样）

注：我想卷积神经网络可能可以做到这一点，但如果可能的话，我想要更简单的解决方案（它不一定是完美的）

库（tidyverse）
图书馆（价格）
澳元%
尾部（365*8）%>%
重命名（澳元兑美元=一澳元兑美元）%>%
变异（日期=as.date（日期））%>%
ggplot（aes（x=日期，y=澳元兑美元，组=1））+
geom_线（）+
geom_光滑（方法=‘黄土’，se=真实）+
主题（axis.title.x=element_blank（），
axis.ticks.x=元素_blank（））+
比例x日期（日期标签=“%Y”，日期间隔=“1年”）+
ggtitle（“过去8年澳元兑美元”）

---

这是一个您可以使用的函数。它利用时间序列的运行长度编码，将其分成上升或下降的段。它允许您设置一个

gap\u width

参数，指示允许多长时间的拉伸中断。它在BaseR中，并不完美，但对于您上面介绍的案例，它似乎工作得很好

rise_and_falls <- function(value, time, gap_width = 5, top = 10, type = "fall") {
  type <- match.arg(type, c("fall", "rise"))
  if (type == "fall") {
    rle <- rle(sign(diff(value)) == -1)
  } else {
    rle <- rle(sign(diff(value)) == 1)
  }
  rle$values <- !rle$values & rle$lengths <= gap_width | rle$values
  rle <- rle(inverse.rle(rle)) # Clean up changed runs
  df <- data.frame(
    start = cumsum(rle$lengths) - rle$lengths + 1,
    end = cumsum(rle$lengths),
    len = rle$lengths,
    drop = rle$values
  )
  df <- transform(
    df,
    start_value = value[start],
    end_value = value[end],
    start_time = time[start],
    end_time = time[end]
  )
  df$diff <- df$start_value - df$end_value
  df <- df[order(df$diff),]
  if (type == "fall") {
    tail(df, top)
  } else {
    head(df, top)
  }
}

上升和下降
rise_and_falls <- function(value, time, gap_width = 5, top = 10, type = "fall") {
  type <- match.arg(type, c("fall", "rise"))
  if (type == "fall") {
    rle <- rle(sign(diff(value)) == -1)
  } else {
    rle <- rle(sign(diff(value)) == 1)
  }
  rle$values <- !rle$values & rle$lengths <= gap_width | rle$values
  rle <- rle(inverse.rle(rle)) # Clean up changed runs
  df <- data.frame(
    start = cumsum(rle$lengths) - rle$lengths + 1,
    end = cumsum(rle$lengths),
    len = rle$lengths,
    drop = rle$values
  )
  df <- transform(
    df,
    start_value = value[start],
    end_value = value[end],
    start_time = time[start],
    end_time = time[end]
  )
  df$diff <- df$start_value - df$end_value
  df <- df[order(df$diff),]
  if (type == "fall") {
    tail(df, top)
  } else {
    head(df, top)
  }
}

au %>% 
  tail(365 * 8) %>% 
  rename(aud_to_usd = one_AUD_equivalent_to_x_USD) %>% 
  mutate(date = as.Date(date)) -> au

df <- rise_and_falls(au$aud_to_usd, au$date, type = "fall")

ggplot(au, aes(x = date, y = aud_to_usd, group = 1)) +
  geom_line() +
  geom_smooth(method = 'loess', se = TRUE) + 
  theme(axis.title.x=element_blank(),
        axis.ticks.x=element_blank()) + 
  scale_x_date(date_labels = "%Y", date_breaks = "1 year")  +
  ggtitle("AUD to USD over last 8 years") +
  geom_segment(data = df, aes(x = start_time, y = start_value,
                              xend = end_time, yend = end_value),
               size = 2, colour = "red")