условное скользящее среднее

Question

library(data.table)

set.seed(123)
d <- data.frame(ID = rep(1:5, each = 17), yearRef = rep(1998:2014, times = 5), y = sample(1:100, 17 * 5)) 

Для каждого удостоверения личности я хочу получить скользящее среднее значение за 7 лет, равное y, начиная с 1998 года. Однако условие состоит в том, что в каждом скользящем окне я выбираю только верхние 5 самых высоких значений y, чтобы сделать среднее. Например,

для первого скользящего окна будет

1998-2004 - только среднее из 5 самых высоких значений 'y'

1999-2005 - только среднее5 лучших значений 'y'. .

2007-2013 - только среднее из 5 самых высоких значений 'y'

2008-2014 - только среднее 5 самых высоких значений 'y'

Я заинтересован в использовании data.table для достижения этой цели. Однако также открыты для других предложений. Вот что я попробовал

 d = setDT(d)
 d[, avg.Y := frollmean(y, 7), by = ID]

Как мне ввести другой аргумент, где для каждого скользящего 7-летнего окна я выбираю только верхнее 5 наибольшее значение y для вычисления среднего значения?

EDIT

У меня также может быть случай, когда некоторые идентификаторы могут иметь минимум 7 лет данных для создания скользящего среднего, и в этом случае вышеуказанная функция даст мне NA. Для этих идентификаторов можно просто взять среднее арифметическое? Например, если идентификатор имеет данные за 1998-2002 гг., В таких случаях я могу просто взять среднее значение y с 1998-2002

Answer 1

Мы можем использовать rollapplyr из zoo и применять пользовательскую функцию для вычисления mean из 5 лучших значений в каждом скользящем окне.

library(data.table)
library(zoo)

setDT(d)
d[, avg.Y:= rollapplyr(y, 7,function(x) mean(tail(sort(x), 5)), fill = NA), by = ID]

Для случаев, когда число может быть меньшенаблюдения, чем размер окна мы можем сделать

d[, avg.Y:= if (.N > 6) 
            rollapplyr(y, 7,function(x) mean(tail(sort(x), 5)), fill = NA)  
            else mean(y), by = ID]

Answer 2

Первый раз с использованием frollapply(), но, похоже, это работает:

get_mean_top5 <- function(x) mean(-sort(-x, partial = 1:5)[1:5])
d[, test := frollapply(y, 7, FUN = get_mean_top5), by = ID]

Функция get_mean_top5() отфильтровывает 5 самых верхних значений и затем принимает среднее значение. Другие более читаемые формы:

get_mean_top5 <- function(x) mean(mean(x[order(x, decreasing=TRUE)[1:5]]))

Answer 3

Еще несколько шагов и немного повторяющееся базовое решение R:

df$seven_year_group <-  paste0(ave(as.integer(as.factor(df$yearRef)) %% 7,

                               as.integer(as.factor(df$yearRef)) %% 7,

                               FUN = seq.int), 

                           "_",

                           df$ID)

seven_year_averages <- data.frame(avg_y = do.call("rbind", lapply(split(df, df$seven_year_group),

                                             function(x){mean(tail(x[order(x$y), "y"], 5))})))



seven_year_averages$seven_year_group <- row.names(seven_year_averages)

df <- merge(df, seven_year_averages, by = "seven_year_group", all.x = TRUE)

Данные:

set.seed(2019)

df <- data.frame(ID = rep(1:5, each = 17), yearRef = rep(1998:2014, times = 5), y = sample(1:100, 17 * 5))