использование результатов с запаздыванием в одной и той же функции мутации dplyr

ProgramBox

использование результатов с запаздыванием в одной и той же функции мутации dplyr

Post author:admin
Запись опубликована:18 января, 2022
Post category:Вопросы по программированию

#r #dplyr #data-analysis #rolling-computation #accumulate

Вопрос:

Я хочу воспроизвести приведенную ниже формулу R, используя dplyr функцию lag. Код работает до 2-й строки каждой группы, а затем дает мне 0 секунд

прогноз = отставание(значение,1)*(1-отставание(истощение)/52)

Условия:

первое значение для прогноза должно быть пустым, так как оно у нас уже есть.
вторая строка вычисляется на основе предыдущих значений столбцов «Истирание» и «Значение».
третья строка и далее предыдущие значения должны быть выбраны из столбцов прогноза(не столбца значений) и истощения соответственно.

Я получаю 0 баллов с 3-го ряда и далее. Ниже приведен мой код для воспроизведения.

 data <- data %>% group_by(Patch) %>% mutate(id = row_number())
data <- data %>% group_by(Patch) %>% mutate(forecast = lag(Value,1)*(1-lag(Attrition,1)/52))

tbl_df(data)
# A tibble: 12 x 6
   Patch Week       Value Attrition    id forecast
   <chr> <date>     <dbl>     <dbl> <int>    <dbl>
 1 11P11 2021-06-14     2     0.075     1   NA    
 2 11P11 2021-06-21     0     0.075     2    2.00 
 3 11P11 2021-06-28     0     0.075     3    0    
 4 11P12 2021-06-14     3     0.075     1   NA    
 5 11P12 2021-06-21     0     0.075     2    3.00 
 6 11P12 2021-06-28     0     0.075     3    0    
 7 11P12 2021-07-05     0     0.075     4    0    
 8 11P13 2021-06-14     1     0.075     1   NA    
 9 11P13 2021-06-21     0     0.075     2    0.999
10 11P13 2021-06-28     0     0.075     3    0    
11 11P13 2021-07-05     0     0.075     4    0    
12 11P13 2021-07-12     0     0.075     5    0   


> dput(data)
structure(list(Patch = c("11P11", "11P11", "11P11", "11P12", 
"11P12", "11P12", "11P12", "11P13", "11P13", "11P13", "11P13", 
"11P13"), Week = structure(c(18792, 18799, 18806, 18792, 18799, 
18806, 18813, 18792, 18799, 18806, 18813, 18820), class = "Date"), 
    Value = c(2, 0, 0, 3, 0, 0, 0, 1, 0, 0, 0, 0), Attrition = c(0.075, 
    0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 
    0.075, 0.075), id = c(1L, 2L, 3L, 1L, 2L, 3L, 4L, 1L, 2L, 
    3L, 4L, 5L), forecast = c(NA, 1.99711538461538, 0, NA, 2.99567307692308, 
    0, 0, NA, 0.998557692307692, 0, 0, 0)), row.names = c(NA, 
-12L), groups = structure(list(Patch = c("11P11", "11P12", "11P13"
), .rows = structure(list(1:3, 4:7, 8:12), ptype = integer(0), class = c("vctrs_list_of", 
"vctrs_vctr", "list"))), row.names = c(NA, -3L), class = c("tbl_df", 
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"))

1. Пожалуйста, поделитесь своими наборами данных в формате с dput(YOUR_DATASET) возможностью копирования или вставки с образцами меньшего dput(head(YOUR_DATASET)) размера .

2. Добавлена часть ввода

3. Анкит! Разве ни один из ответов не послужил вашей цели?

Ответ №1:

Обновленное Решение

Вот простое решение с использованием base::Reduce :

 do.call(rbind, lapply(split(df, df$Patch), function(x) {
  x$forecast <- c(NA, Reduce(function(a, b) {
    a * (1 - (x$Attrition[b]/52))
  }, 2:(nrow(x)-1), init = x$Value[1], accumulate = TRUE))
  x
}))

   Patch       Week Value Attrition id  forecast
1  11P11 2021-06-14     2     0.075  1        NA
2  11P11 2021-06-21     0     0.075  2 2.0000000
3  11P11 2021-06-28     0     0.075  3 1.9971154
4  11P12 2021-06-14     3     0.075  1        NA
5  11P12 2021-06-21     0     0.075  2 3.0000000
6  11P12 2021-06-28     0     0.075  3 2.9956731
7  11P12 2021-07-05     0     0.075  4 2.9913524
8  11P13 2021-06-14     1     0.075  1        NA
9  11P13 2021-06-21     0     0.075  2 1.0000000
10 11P13 2021-06-28     0     0.075  3 0.9985577
11 11P13 2021-07-05     0     0.075  4 0.9971175
12 11P13 2021-07-12     0     0.075  5 0.9956793

Более Ранний Подход

Вы также можете использовать следующий подход. Для этого я сначала применил вашу формулу с mutate к вашему набору данных, чтобы получить первое значение моего forecast ряда. Затем я вырезал первые строки каждой группы, содержащей NA значения для forecast out. После этого я использовал accumulate функцию для вычисления желаемого ряда, используя первое forecast значение в качестве .init аргумента. Затем я связываю результирующий набор данных с тем, который содержит NA значения:

 library(dplyr)
library(purrr)

df %>%
  group_by(Patch) %>%
  mutate(forecast = lag(Value)*(1-(lag(Attrition)/52))) %>%
  filter(between(row_number(), 2, n())) %>%
  mutate(forecast = accumulate(Attrition[-1], .init = forecast[1], ~ ..1 * (1-(..2/52)))) %>%
  bind_rows(df %>% group_by(Patch) %>%
              mutate(forecast = lag(Value)*(1-(lag(Attrition)/52))) %>%
              slice_head()) %>%
  ungroup() %>%
  arrange(Patch, Week)

# A tibble: 12 x 6
   Patch Week       Value Attrition    id forecast
   <chr> <date>     <dbl>     <dbl> <int>    <dbl>
 1 11P11 2021-06-14     2     0.075     1   NA    
 2 11P11 2021-06-21     0     0.075     2    2.00 
 3 11P11 2021-06-28     0     0.075     3    1.99 
 4 11P12 2021-06-14     3     0.075     1   NA    
 5 11P12 2021-06-21     0     0.075     2    3.00 
 6 11P12 2021-06-28     0     0.075     3    2.99 
 7 11P12 2021-07-05     0     0.075     4    2.99 
 8 11P13 2021-06-14     1     0.075     1   NA    
 9 11P13 2021-06-21     0     0.075     2    0.999
10 11P13 2021-06-28     0     0.075     3    0.997
11 11P13 2021-07-05     0     0.075     4    0.996
12 11P13 2021-07-12     0     0.075     5    0.994

1. Очень круто! Я пытался accumulate() найти для этого работу.

2. Большое вам спасибо, дорогой @ktiu . Я взглянул на ваше решение и попытался придумать другой подход, и пришел к этому. Хотя это может показаться странным, это работает, так forecast как значение для первых строк всегда NA равно . Ваше решение довольно тонкое и техническое. Я также большой поклонник вашего стиля кодирования.

Ответ №2:

Что в этом сложного, так это то, что вам нужно последовательно создавать forecast переменную, поэтому она не будет работать при стандартном mutate() вызове.

Вот мой подход, который опирается на purrr map() и reduce() для консолидации данных:

 library(tidyverse)

data %>%
  mutate(forecast = NA) %>%
  split(~ Patch) %>%
  map(~ .x %>%
          pmap(~ tibble(...)) %>%
          reduce((.x, .y) {
            prev <- slice_tail(.x)
            base_value <- ifelse(prev$Value != 0, prev$Value, prev$forecast)
            bind_rows(.x,
                      mutate(.y,
                             forecast = base_value * 1 - prev$Attrition / 5))
          })) %>%
  reduce(bind_rows)

ВОЗВРАТ:

 # A tibble: 12 x 6
   Patch Week       Value Attrition    id forecast
   <chr> <date>     <dbl>     <dbl> <int>    <dbl>
 1 11P11 2021-06-14     2     0.075     1   NA
 2 11P11 2021-06-21     0     0.075     2    1.98
 3 11P11 2021-06-28     0     0.075     3    1.97
 4 11P12 2021-06-14     3     0.075     1   NA
 5 11P12 2021-06-21     0     0.075     2    2.98
 6 11P12 2021-06-28     0     0.075     3    2.97
 7 11P12 2021-07-05     0     0.075     4    2.95
 8 11P13 2021-06-14     1     0.075     1   NA
 9 11P13 2021-06-21     0     0.075     2    0.985
10 11P13 2021-06-28     0     0.075     3    0.97
11 11P13 2021-07-05     0     0.075     4    0.955
12 11P13 2021-07-12     0     0.075     5    0.94

Используемые данные:

 data <- structure(list(Patch = c("11P11", "11P11", "11P11", "11P12", "11P12", "11P12", "11P12", "11P13", "11P13", "11P13", "11P13", "11P13"), Week = structure(c(18792, 18799, 18806, 18792, 18799, 18806, 18813, 18792, 18799, 18806, 18813, 18820), class = "Date"), Value = c(2, 0, 0, 3, 0, 0, 0, 1, 0, 0, 0, 0), Attrition = c(0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 0.075, 0.075), id = c(1L, 2L, 3L, 1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L, 5L), forecast = c(NA, 1.99711538461538, 0, NA, 2.99567307692308, 0, 0, NA, 0.998557692307692, 0, 0, 0)), row.names = c(NA, -12L), groups = structure(list(Patch = c("11P11", "11P12", "11P13"), .rows = structure(list(1:3, 4:7, 8:12), ptype = integer(0), class = c("vctrs_list_of", "vctrs_vctr", "list"))), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"), .drop = TRUE), class = c("grouped_df", "tbl_df", "tbl", "data.frame"))

Ответ №3:

Если я правильно вас понимаю, возможно, вам нужно только accumulate от purrr (вам нужны не lag ценности, а accumulated ценности вместо этого)-

Я рассчитал FORECAST по приведенной формуле
Используется только attrition в аргументе, потому что нам нужно только первое значение Value , которое мы можем предоставить accumulate через .init
Теперь результирующий вектор будет на одну длину больше, чем требуется, поэтому его последнее -n() значение будет удалено.
Но ваше дальнейшее требование состоит в том, чтобы иметь первый результат как NA, поэтому удалите результат еще одного значения, т. е. первого значения, путем подмножества накопить как [-c(1, n()]
Теперь объединил результаты с NA в начале

 library(tidyverse)

df %>% group_by(Patch) %>%
  mutate(FORECAST = c(NA, accumulate(Attrition, .init = first(Value), ~ .x * (1 - .y/52))[-c(1, n())]))

#> # A tibble: 12 x 7
#> # Groups:   Patch [3]
#>    Patch Week       Value Attrition    id forecast FORECAST
#>    <chr> <date>     <dbl>     <dbl> <int>    <dbl>    <dbl>
#>  1 11P11 2021-06-14     2     0.075     1   NA       NA    
#>  2 11P11 2021-06-21     0     0.075     2    2.00     2.00 
#>  3 11P11 2021-06-28     0     0.075     3    0        1.99 
#>  4 11P12 2021-06-14     3     0.075     1   NA       NA    
#>  5 11P12 2021-06-21     0     0.075     2    3.00     3.00 
#>  6 11P12 2021-06-28     0     0.075     3    0        2.99 
#>  7 11P12 2021-07-05     0     0.075     4    0        2.98 
#>  8 11P13 2021-06-14     1     0.075     1   NA       NA    
#>  9 11P13 2021-06-21     0     0.075     2    0.999    0.999
#> 10 11P13 2021-06-28     0     0.075     3    0        0.997
#> 11 11P13 2021-07-05     0     0.075     4    0        0.996
#> 12 11P13 2021-07-12     0     0.075     5    0        0.993

^{Создано 2021-06-18 пакетом reprex (v2.0.0)}

Метки: использование результатов с запаздыванием в одной и той же функции мутации dplyr