У меня есть данные, которые выглядят так:

   date         col1   col2   col3
   <chr>       <dbl>  <dbl>  <dbl>
 1 2020_09_01 53542. 22133. 25295.
 2 2020_09_02 54157. 22505. 25327.
 3 2020_09_03 54137. 23115. 24993.
 4 2020_09_04 50795. 23127. 24166.
 5 2020_09_05 32829. 19600. 21860.

Я пытаюсь использовать функцию rollapply для вычисления процентного изменения за 7 дней - или процентного изменения недели за неделей. Кажется, я не могу заставить рулон работать так, как я ожидал. rollapply будет ежедневно вычислять процентное изменение по сравнению с предыдущей неделей.

lagPeriod = 7
matrixCalcFunction <- function(x){
  (myData[[x]] - myData[[x - lagPeriod]]) / myData[[x - lagPeriod]]
}

myData %>%
  pivot_longer(cols = contains("col")) %>% 
  tidyquant::tq_mutate(
    select = value,
    mutate_fun = rollapply,
    width = lagPeriod ,
    align = "right",
    FUN = matrixCalcFunction
  )

Ожидаемый результат:

   date         col1   col2   col3
   <chr>       <dbl>  <dbl>  <dbl>
 1 2020_09_01   NA     NA     NA    
 2 2020_09_02   NA     NA     NA   
 3 2020_09_03   NA     NA     NA   
 4 2020_09_04   NA     NA     NA   
 5 2020_09_05   NA     NA     NA   
 6 2020_09_06   NA     NA     NA   
 7 2020_09_07 -0.065  -0.055  -0.39
 8 2020_09_08 -0.058  -0.029  -0.041
 9 2020_09_09  0.068   0.071  0.039
10 2020_09_10  0.023  -0.0002 0.045

Данных:

myData <- structure(list(date = c("2020_09_01", "2020_09_02", "2020_09_03", 
"2020_09_04", "2020_09_05", "2020_09_06", "2020_09_07", "2020_09_08", 
"2020_09_09", "2020_09_10", "2020_09_11", "2020_09_12", "2020_09_13", 
"2020_09_14", "2020_09_15", "2020_09_16", "2020_09_17", "2020_09_18", 
"2020_09_19", "2020_09_20", "2020_09_21", "2020_09_22", "2020_09_23", 
"2020_09_24", "2020_09_25", "2020_09_26", "2020_09_27", "2020_09_28", 
"2020_09_29", "2020_09_30"), col1 = c(53542.497, 54156.934, 54136.844, 
50794.971, 32828.797, 28475.082, 50083.573, 51017.288, 57819.908, 
51945.242, 27823.172, 34349.466, 28527.527, 54845.664, 56531.057, 
56556.415, 55396.121, 54303.732, 37513.441, 30041.867, 52397.815, 
55449.939, 56203.125, 53654.182, 53289.437, 38511.761, 28046.879, 
52132.573, 56055.611, 55520.683), col2 = c(22133.29, 22504.958, 
23115.242, 23126.773, 19599.718, 16752.282, 20920.38, 21844.255, 
24763.05, 23121.879, 17430.447, 20110.582, 18795.882, 24027.224, 
24890.61, 24408.889, 24363.402, 24582.204, 20146.731, 18376.923, 
23063.298, 24221.946, 25228.194, 24658.424, 23333.315, 20066.397, 
17504.372, 23561.362, 23456.284, 24101.302), col3 = c(25294.573, 
25326.797, 24992.764, 24166.084, 21859.885, 17549.005, 24306.496, 
24269.409, 25968.326, 25253.976, 17974.404, 22636.375, 20105.166, 
27000.274, 26291.22, 27277.371, 26851.75, 26133.317, 24055.107, 
19515.875, 25573.014, 31957.279, 28961.316, 26896.495, 26440.726, 
22941.927, 19990.825, 26595.878, 27725.468, 25965.802)), row.names = c(NA, 
-30L), class = c("tbl_df", "tbl", "data.frame"))

РЕДАКТИРОВАТЬ:

Этот код работает, но я немного запутался в diff(.x))/lag(.x, 7) и не уверен, что он работает так, как я хочу, поскольку я получаю результаты, отличные от ожидаемых.

myData %>% 
  column_to_rownames("date") %>% 
  mutate(across(everything(),  ~ round(c(NA, diff(.x))/lag(.x, 7), 5), 
                names = "{col}_delta"))

Для одного наблюдения (col1 строка 1 и строка 7) я могу использовать что-то вроде diff(c(pull(myData[7, 2]), pull(myData[1, 2]))) = 3458.924, тогда я могу разделить это как 3458.924 / pull(myData[1, 2]) = 0.0646. Так что добавление чего-то вроде diff(c(.x, lag(.x, 7))) к функции diff даст результат.

0
user8959427 30 Ноя 2020 в 14:20

1 ответ

Лучший ответ

Преобразуйте его в зоопарк, а затем используйте diff, чтобы получить зоопарк. Его можно преобразовать обратно во фрейм данных, используя fortify.zoo(x), где x - результат diff. Или просто оставьте его как объект зоопарка, чтобы вы могли использовать другие возможности зоопарка.

library(zoo)

z <- read.zoo(myData, format = "%Y_%m_%d")
diff(z, 6, arith = FALSE, na.pad = TRUE) - 1

Чтобы использовать rollapply вместо последней строки, используйте:

rollapplyr(z, 7, function(x) x[7] / x[1] - 1, fill = NA)

Или используйте lag.zoo:

z / lag(z, -6, na.pad = TRUE) - 1

Обратите внимание, что dplyr сжимает lag, поэтому либо убедитесь, что он не загружен, либо, если он вам нужен, загрузите его с помощью library(dplyr, exclude = c("filter", "lag")).

Что касается РЕДАКТИРОВАНИЯ, попробуйте следующее:

library(dplyr, exclude = c("lag", "filter"))
myData %>% mutate(across(-1, ~ . / dplyr::lag(., 6) - 1))
2
G. Grothendieck 30 Ноя 2020 в 12:42