скользящая 30-дневная геометрия c среднее с переменной шириной - PullRequest
7 голосов
/ 08 февраля 2020

Решение этого вопроса от @ShirinYavari было почти тем, что мне было нужно, за исключением использования окна усреднения c усреднения stati *. У меня есть набор данных со случайными выборками из нескольких станций, которые я хочу просчитать 30-дневный геомей. Я хочу, чтобы все сэмплы в пределах 30-дневного окна данного сэмпла были усреднены, и ширина может измениться, если предыдущие сэмплы находятся дальше или ближе друг к другу во времени, например, нужно ли вам усреднять 2, 3 или более сэмплов, если 1 , 2 или более предыдущих образцов были в течение 30 дней после данного образца.

Вот некоторые примеры данных, плюс моя попытка кода:

RESULT = c(50,900,25,25,125,50,25,25,2000,25,25,
        25,25,25,25,25,25,325,25,300,475,25)
DATE = as.Date(c("2018-05-23","2018-06-05","2018-06-17",
                  "2018-08-20","2018-10-05","2016-05-22",
                  "2016-06-20","2016-07-25","2016-08-11",
                  "2017-07-21","2017-08-08","2017-09-18",
                  "2017-10-12","2011-04-19","2011-06-29",
                  "2011-08-24","2011-10-23","2012-06-28",
                  "2012-07-16","2012-08-14","2012-09-29",
                  "2012-10-24"))
FINAL_SITEID = c(rep("A", 5), rep("B", 8), rep("C", 9))
df=data.frame(FINAL_SITEID,DATE,RESULT)

data_roll <- df %>%
  group_by(FINAL_SITEID) %>%
  arrange(DATE) %>%
  mutate(day=DATE-dplyr::lag(DATE, n=1),
         day=replace_na(day, 1),
         rnk=cumsum(c(TRUE, day > 30))) %>%
  group_by(FINAL_SITEID, rnk) %>%
  mutate(count=rowid(rnk)) %>%
  mutate(GM30=rollapply(RESULT, width=count, geometric.mean, fill=RESULT, align="right"))

Я получаю это сообщение об ошибке, которое кажется как будто это должно быть легко исправить, но я не могу понять это:

Error: Column `rnk` must be length 5 (the group size) or one, not 6

Ответы [ 2 ]

3 голосов
/ 08 февраля 2020

Самый простой способ вычисления скользящей статистики в зависимости от даты и времени windows - это runner package. Вам не нужно взламывать, чтобы получить всего 30 дней windows. Функция бегунок позволяет применять любую функцию R. в скользящем окне. Ниже приведен пример 30-дневной геометрии c .mean в группе FINAL_SITEID:

library(psych)
library(runner)
df %>%
  group_by(FINAL_SITEID) %>%
  arrange(DATE) %>%
  mutate(GM30 = runner(RESULT, k = 30, idx = DATE, f = geometric.mean))

#     FINAL_SITEID DATE       RESULT  GM30
#    <fct>        <date>      <dbl> <dbl>
# 1 C            2011-04-19     25  25.0
# 2 C            2011-06-29     25  25.0
# 3 C            2011-08-24     25  25.0
# 4 C            2011-10-23     25  25.0
# 5 C            2012-06-28    325 325. 
# 6 C            2012-07-16     25  90.1
# 7 C            2012-08-14    300  86.6
# 8 C            2012-09-29    475 475. 
# 9 C            2012-10-24     25 109. 
# 10 B            2016-05-22     50  50.0
1 голос
/ 08 февраля 2020

Аргумент ширины rollapply может быть вектором ширины, который может быть установлен с помощью findInterval. Пример этого показан в разделе "Примеры" справочного файла *1003*, и мы используем его ниже.

library(dplyr)
library(psych)
library(zoo)

data_roll <- df %>%
  arrange(FINAL_SITEID, DATE) %>%
  group_by(FINAL_SITEID) %>%
  mutate(GM30 = rollapplyr(RESULT, 1:n() - findInterval(DATE - 30, DATE), 
   geometric.mean, fill = NA)) %>%
  ungroup

, давая:

# A tibble: 22 x 4
   FINAL_SITEID DATE       RESULT  GM30
   <fct>        <date>      <dbl> <dbl>
 1 A            2018-05-23     50  50.0
 2 A            2018-06-05    900 212. 
 3 A            2018-06-17     25 104. 
 4 A            2018-08-20     25  25.0
 5 A            2018-10-05    125 125. 
 6 B            2016-05-22     50  50.0
 7 B            2016-06-20     25  35.4
 8 B            2016-07-25     25  25.0
 9 B            2016-08-11   2000 224. 
10 B            2017-07-21     25  25.0
# ... with 12 more rows
...