Скользящее среднее для данных панели (с некоторыми подробностями) - PullRequest
Новая
       22

Скользящее среднее для данных панели (с некоторыми подробностями)

1 голос
/ 04 апреля 2019

Я придумала некоторый код для расчета скользящего среднего для данных панели (строка в данных содержит значения одного субъекта за один день). Поскольку у меня было несколько более конкретных требований, код стал довольно сложным. Слишком сложный для приложения, не слишком редкий, на мой взгляд.

Вот что мне нужно:

  1. скользящее среднее (среднее значений (a) за предыдущие 3 дня, исключая «текущий» день), (b) , рассчитанное только при наличии минимума 2 не пропущенных значения в этом окне)

  2. относительно структуры панели

Не слишком сложно, верно?

Для 1. Я решил использовать rollapplyr() и mean( , na.rm = T), чтобы исключить текущий день. (А) Я решил использовать самодельную функцию запаздывания и для (б) оператор if. И для 2. Я завернул все в tapply() (с unlist()), чтобы соблюдать структуру панели.

Вот пример кода: 

library(zoo)

# example data (with missings)
set.seed(1)
df = data.frame(subject = rep(c("a", "b"), each = 10), day = rep(1:10, 2), value = rnorm(20))
df$value[15:17] = NA

# lag function (sensitive to "single day" subjects)
lag <- function(x, l = 1) { 
  if (length(x) > 1) (c(rep(NA, l), x[1:(length(x)-l)])) else (NA) 
} 

# calculate rolling mean
df$roll_mean3 = unlist(tapply(df$value, df$subject, 
                              FUN = function(x) lag(rollapplyr(x, width = 3, fill = NA, partial = T,
                                                               FUN = function(x) ifelse(sum(!is.na(x)) > 1, mean(x, na.rm = T), NA)))))
df

Как я сказал, это решение кажется слишком сложным для ситуации, которая, я думаю, не так уж и далеко.

У вас есть предложения, как сделать это более простым (менее подверженным ошибкам) ​​способом? Я пропустил некоторые основные функции, которые позволяют легче обрабатывать данные панели?

Для иллюстрации вывод моего кода: 

   subject day      value   roll_mean3
1        a   1 -0.6264538           NA
2        a   2  0.1836433           NA
3        a   3 -0.8356286 -0.221405243
4        a   4  1.5952808 -0.426146366
5        a   5  0.3295078  0.314431838
6        a   6 -0.8204684  0.363053321
7        a   7  0.4874291  0.368106730
8        a   8  0.7383247 -0.001177187
9        a   9  0.5757814  0.135095124
10       a  10 -0.3053884  0.600511703
11       b   1  1.5117812           NA
12       b   2  0.3898432           NA
13       b   3 -0.6212406  0.950812202
14       b   4 -2.2146999  0.426794608
15       b   5         NA -0.815365744
16       b   6         NA -1.417970234
17       b   7         NA           NA
18       b   8  0.9438362           NA
19       b   9  0.8212212           NA
20       b  10  0.5939013  0.882528703

Ответы [ 3 ]

2 голосов
/ 04 апреля 2019

Используйте ave для запуска rollapply отдельно по каждому предмету.Затем при использовании rollapply обратите внимание, что width может быть списком, содержащим вектор (или векторы) смещений, поэтому list(-seq(3)) означает предыдущие 3 элемента.См. ?rollapply для получения дополнительной информации об аргументах. 

Mean <- function(x) if (sum(!is.na(x)) >= 2) mean(x, na.rm = TRUE) else NA
roll <- function(x)  rollapply(x, list(-seq(3)), Mean, fill = NA, partial = TRUE)
transform(df, roll = ave(value, subject, FUN = roll))
2 голосов
/ 04 апреля 2019

В дополнение к моему комментарию выше, я не совсем уверен, каким должен быть ожидаемый результат, но, возможно, следующая отправная точка является хорошей отправной точкой: 

df %>%
    group_by(subject) %>%
    mutate(roll_mean3 = rollapplyr(
        lag(value),
        width = 3,
        fill = NA,
        FUN = function(x) ifelse(sum(!is.na(x)) > 1, mean(x, na.rm = T), NA)))
## A tibble: 20 x 4
## Groups:   subject [2]
#   subject   day   value roll_mean3
#   <fct>   <int>   <dbl>      <dbl>
# 1 a           1  -0.626   NA
# 2 a           2   0.184   NA
# 3 a           3  -0.836   -0.221
# 4 a           4   1.60    -0.426
# 5 a           5   0.330    0.314
# 6 a           6  -0.820    0.363
# 7 a           7   0.487    0.368
# 8 a           8   0.738   -0.00118
# 9 a           9   0.576    0.135
#10 a          10  -0.305    0.601
#11 b           1   1.51    NA
#12 b           2   0.390   NA
#13 b           3  -0.621    0.951
#14 b           4  -2.21     0.427
#15 b           5  NA       -0.815
#16 b           6  NA       -1.42
#17 b           7  NA       NA
#18 b           8   0.944   NA
#19 b           9   0.821   NA
#20 b          10   0.594    0.883

Или используя data.table

custom_mean <- function(x) ifelse(sum(!is.na(x)) > 1, mean(x, na.rm = T), NA)
setDT(df)[, roll_mean3 := rollapplyr(shift(value), width = 3, fill = NA, FUN = custom_mean), by = subject]
df
#   subject day      value   roll_mean3
#1:       a   1 -0.6264538           NA
#2:       a   2  0.1836433           NA
#3:       a   3 -0.8356286 -0.221405243
#4:       a   4  1.5952808 -0.426146366
#5:       a   5  0.3295078  0.314431838
#6:       a   6 -0.8204684  0.363053321
#7:       a   7  0.4874291  0.368106730
#8:       a   8  0.7383247 -0.001177187
#9:       a   9  0.5757814  0.135095124
#10:       a  10 -0.3053884  0.600511703
#11:       b   1  1.5117812           NA
#12:       b   2  0.3898432           NA
#13:       b   3 -0.6212406  0.950812202
#14:       b   4 -2.2146999  0.426794608
#15:       b   5         NA -0.815365744
#16:       b   6         NA -1.417970234
#17:       b   7         NA           NA
#18:       b   8  0.9438362           NA
#19:       b   9  0.8212212           NA
#20:       b  10  0.5939013  0.882528703
1 голос
/ 04 апреля 2019

Возможно, это не самое элегантное или масштабируемое решение, но оно дает желаемый результат: 

df %>%
  group_by(subject) %>%
  mutate(n_values = 3 - is.na(lag(value, 1)) - is.na(lag(value, 2)) - is.na(lag(value, 3)),
         roll_mean = ifelse(
           n_values >= 2,
           (coalesce(lag(value), 0) + coalesce(lag(value, 2), 0) + coalesce(lag(value, 3), 0)) / n_values,
           NA)
  )

Объяснение: это конвейер dplyr, в котором сначала группируются субъекты, поэтому группы соблюдаются.Далее, в mutate есть два вычисленных значения:

  1. n_values подсчитывает количество не-значений NA в предыдущих 3 строках, оно равно 3 минус 1 для каждогоNA значение.Доступ к предыдущим строкам осуществляется с помощью lag.

  2. roll_mean условно, с использованием ifelse: если n_values по крайней мере равно 2, можно вычислить среднее значение.Он складывает предыдущие 3 значения, заменяя NA на 0, используя coalesce.Сумма делится на n_values, чтобы получить среднее значение.Если n_values < 2, возвращается NA.

...