Максимальное значение в течение двухмесячного скользящего окна

У меня есть двухлетний дневной временной ряд, из которого я хотел бы извлечь максимальные значения между двухмесячными скользящими окнами (т. е. январь-февраль, февраль-март,..., ноябрь-декабрь). Я могу приблизиться к ответу, используя пакеты tidyverse и slider, однако ответ неточный, потому что не во всех месяцах одинаковое количество дней. Есть ли способ извлечь максимальное значение из двухмесячного скользящего окна, который не зависит от установки значения количества дней для просмотра до и после?

library(tidyverse)
library(slider)

# Example Daily Timeseries
set.seed(333)

df <- data.frame(
  date = seq(as.Date('2020-01-01'),
                 as.Date('2021-12-31'),
                 '1 day'),
  value = round(rnorm(731,100,33))
)

# Calculate maximum in 2-month (60-day) wide sliding window
# Must supply number of days before and after but months have different number of days
df %>%
  mutate(two_month_max = slider::slide_index_dbl(value, date, max, .before = 30, .after = 30)) %>%
  filter(day(date) == 1) %>%
  select(!value)
#>          date two_month_max
#> 1  2020-01-01           164
#> 2  2020-02-01           164
#> 3  2020-03-01           160
#> 4  2020-04-01           170
#> 5  2020-05-01           181
#> 6  2020-06-01           181
#> 7  2020-07-01           150
#> 8  2020-08-01           193
#> 9  2020-09-01           193
#> 10 2020-10-01           212
#> 11 2020-11-01           212
#> 12 2020-12-01           187
#> 13 2021-01-01           179
#> 14 2021-02-01           179
#> 15 2021-03-01           167
#> 16 2021-04-01           159
#> 17 2021-05-01           169
#> 18 2021-06-01           184
#> 19 2021-07-01           184
#> 20 2021-08-01           194
#> 21 2021-09-01           194
#> 22 2021-10-01           163
#> 23 2021-11-01           161
#> 24 2021-12-01           168

^{Created on 2024-05-08 with reprex v2.1.0}

ДОПОЛНИТЕЛЬНАЯ ИНФОРМАЦИЯ: я отформатировал приведенный выше вывод так, чтобы он напоминал вывод Эль-Ниньо/Южное колебание (ENSO) — многомерный индекс ENSO версии 2 (MEI), к которому эти максимальные значения будут добавлены в другой раз.

library(tidyverse)
library(rsoi)

# Import Multivariate ENSO Index Version 2 (MEI) ----
mei <- download_mei()

mei %>%
  arrange(-desc(Date))
#> # A tibble: 552 × 5
#>     Year Month Date         MEI Phase        
#>    <int> <fct> <date>     <dbl> <ord>        
#>  1  1979 DJ    1979-01-01  0.47 Neutral Phase
#>  2  1979 JF    1979-02-01  0.29 Neutral Phase
#>  3  1979 FM    1979-03-01 -0.05 Neutral Phase
#>  4  1979 MA    1979-04-01  0.21 Neutral Phase
#>  5  1979 AM    1979-05-01  0.27 Neutral Phase
#>  6  1979 MJ    1979-06-01 -0.11 Neutral Phase
#>  7  1979 JJ    1979-07-01 -0.11 Neutral Phase
#>  8  1979 JA    1979-08-01  0.47 Neutral Phase
#>  9  1979 AS    1979-09-01  0.38 Neutral Phase
#> 10  1979 SO    1979-10-01  0.23 Neutral Phase
#> # ℹ 542 more rows

^{Created on 2024-05-08 with reprex v2.1.0}

r dplyr

08.05.2024 21:18

Стоит ли изучать PHP в 2026-2027 годах?

Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...

Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией

В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.

Приемы CSS-макетирования - floats и Flexbox

Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...

Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest

В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...

Концепция локализации и ее применение в приложениях React ⚡️

Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...

Пользовательский скаляр GraphQL

Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...

Перейти к ответу Данный вопрос помечен как решенный

Ответы 4

В справке по slide_index есть аналогичный пример, предлагающий применение здесь:

df %>%
  mutate(two_month_max = slider::slide_index_dbl(value, date, 
                                                 ~max(.x, na.rm = TRUE), 
                                                 .before = ~.x %m-% months(1), 
                                                 .after  = ~.x %m+% months(1))) %>% 
  filter(day(date) == 1) %>%
  select(!value)

Из ?slide_index:

# Functions for `.before` and `.after`

# In some cases, it might not be appropriate to compute
# `.i - .before` or `.i + .after`, either because there isn't a `-` or `+`
# method defined, or because there is an alternative way to perform the
# arithmetic. For example, subtracting 1 month with `- months(1)` (using
# lubridate) can sometimes land you on an invalid date that doesn't exist.
i <- as.Date(c("2019-01-31", "2019-02-28", "2019-03-31"))

# 2019-03-31 - months(1) = 2019-02-31, which doesn't exist
i - months(1)

# These NAs create problems with `slide_index()`, which doesn't allow
# missing values in the computed endpoints
try(slide_index(i, i, identity, .before = months(1)))

# In these cases, it is more appropriate to use `%m-%`,
# which will snap to the end of the month, at least giving you something
# to work with.
i %m-% months(1)

# To use this as your `.before` or `.after`, supply an anonymous function of
# 1 argument that performs the computation
slide_index(i, i, identity, .before = ~.x %m-% months(1))

# Notice that in the `.after` case, `2019-02-28 %m+% months(1)` doesn't
# capture the end of March, so it isn't included in the 2nd result
slide_index(i, i, identity, .after = ~.x %m+% months(1))

08.05.2024 21:38

Оказывается, slide_period_dfr() может делать именно то, что мне нужно.

library(tidyverse)
library(slider)

# Example Daily Timeseries
set.seed(333)

df <- data.frame(
  date = seq(as.Date('2020-01-01'),
                 as.Date('2021-12-31'),
                 '1 day'),
  value = round(rnorm(731,100,33))
)

# Expected output for first year
df %>%
  filter(date >= as.Date('2020-01-01') &
           date <= as.Date('2020-02-29')) %>%
  summarise(max(value))
#>   max(value)
#> 1        164

df %>%
  filter(date >= as.Date('2020-02-01') &
           date <= as.Date('2020-03-31'))  %>%
  summarise(max(value))
#>   max(value)
#> 1        160

df %>%
  filter(date >= as.Date('2020-03-01') &
           date <= as.Date('2020-04-30'))  %>%
  summarise(max(value))
#>   max(value)
#> 1        170

df %>%
  filter(date >= as.Date('2020-04-01') &
           date <= as.Date('2020-05-31'))  %>%
  summarise(max(value))
#>   max(value)
#> 1        181

df %>%
  filter(date >= as.Date('2020-05-01') &
           date <= as.Date('2020-06-30'))  %>%
  summarise(max(value))
#>   max(value)
#> 1        181

df %>%
  filter(date >= as.Date('2020-06-01') &
           date <= as.Date('2020-07-31'))  %>%
  summarise(max(value))
#>   max(value)
#> 1        150

output <- slide_period_dfr(.x = df$value,
                 .i = df$date,
                 .period = "month",
                 .f = max,
                 .before = 1,
                 .complete = TRUE)

head(output)
#>   ...1
#> 1  164
#> 2  160
#> 3  170
#> 4  181
#> 5  181
#> 6  150

^{Created on 2024-05-08 with reprex v2.1.0}

08.05.2024 22:26

Используйте тот факт, что если u и v являются векторами, то max(c(u, v)) равно max(max(u), max(v)) поэтому мы можем вычислить максимумы за один месяц, а затем вычислить максимумы за два месяца из этих . max1 и max2 — максимумы за один и два месяца.

library(dplyr)
library(zoo)
df %>%
  mutate(date = as.Date(cut(date, "month"))) %>%
  summarize(max1 = max(value), .by = date) %>%
  mutate(max2 = rollapplyr(max1, 2, max, partial = TRUE))

предоставление

         date max1 max2
1  2020-01-01  164  164
2  2020-02-01  160  164
3  2020-03-01  154  160
4  2020-04-01  170  170
5  2020-05-01  181  181
6  2020-06-01  150  181
7  2020-07-01  149  150
8  2020-08-01  193  193
9  2020-09-01  189  193
10 2020-10-01  212  212
11 2020-11-01  187  212
12 2020-12-01  178  187
13 2021-01-01  179  179
14 2021-02-01  167  179
15 2021-03-01  159  167
16 2021-04-01  145  159
17 2021-05-01  169  169
18 2021-06-01  184  184
19 2021-07-01  150  184
20 2021-08-01  194  194
21 2021-09-01  163  194
22 2021-10-01  161  163
23 2021-11-01  147  161
24 2021-12-01  168  168

Примечание

Ввод из вопроса

set.seed(333)
df <- data.frame(
  date = seq(as.Date('2020-01-01'),
                 as.Date('2021-12-31'),
                 '1 day'),
  value = round(rnorm(731,100,33))
)

08.05.2024 23:40

Ответ принят как подходящий

Вот полный tidyverse вариант (без zoo или slider).

library(tidyverse) # dplyr || lubridate || purrr
 
# `reframe` returns an arbitrary number of rows per group [1] -------------
new_df <- df %>% 
  reframe(
    start_date = unique(floor_date(date, "months")),
    interval   = as.interval(months(2) - days(1), start_date),
    max_value  = map_dbl(interval, \(x) max(keep(value, date %within% x))))

Выход:

> new_df
   start_date                       interval max_value
1  2020-01-01 2020-01-01 UTC--2020-02-29 UTC       164
2  2020-02-01 2020-02-01 UTC--2020-03-31 UTC       160
3  2020-03-01 2020-03-01 UTC--2020-04-30 UTC       170
4  2020-04-01 2020-04-01 UTC--2020-05-31 UTC       181
5  2020-05-01 2020-05-01 UTC--2020-06-30 UTC       181
6  2020-06-01 2020-06-01 UTC--2020-07-31 UTC       150
7  2020-07-01 2020-07-01 UTC--2020-08-31 UTC       193
8  2020-08-01 2020-08-01 UTC--2020-09-30 UTC       193
9  2020-09-01 2020-09-01 UTC--2020-10-31 UTC       212
10 2020-10-01 2020-10-01 UTC--2020-11-30 UTC       212
11 2020-11-01 2020-11-01 UTC--2020-12-31 UTC       187
12 2020-12-01 2020-12-01 UTC--2021-01-31 UTC       179
13 2021-01-01 2021-01-01 UTC--2021-02-28 UTC       179
14 2021-02-01 2021-02-01 UTC--2021-03-31 UTC       167
15 2021-03-01 2021-03-01 UTC--2021-04-30 UTC       159
16 2021-04-01 2021-04-01 UTC--2021-05-31 UTC       169
17 2021-05-01 2021-05-01 UTC--2021-06-30 UTC       184
18 2021-06-01 2021-06-01 UTC--2021-07-31 UTC       184
19 2021-07-01 2021-07-01 UTC--2021-08-31 UTC       194
20 2021-08-01 2021-08-01 UTC--2021-09-30 UTC       194
21 2021-09-01 2021-09-01 UTC--2021-10-31 UTC       163
22 2021-10-01 2021-10-01 UTC--2021-11-30 UTC       161
23 2021-11-01 2021-11-01 UTC--2021-12-31 UTC       168
24 2021-12-01 2021-12-01 UTC--2022-01-31 UTC       168

[1] reframeссылка здесь.

Данные игрушки:

# Toy data ----------------------------------------------------------------
set.seed(333)

df <- data.frame(
  date = seq(as.Date('2020-01-01'), as.Date('2021-12-31'), '1 day'),
  value = round(rnorm(731,100,33)))

^{Created on 2024-05-10 with reprex v2.1.0}

11.05.2024 04:59