Подведение итогов после группировки с использованием «подвижных» групп

Question

Я хочу получить столбец со скользящим средним доходом для каждого возраста, но включая возраст на один год старше и моложе.Например, для возраста 42 года и типа 1 для этого типа необходимо будет использовать все данные о доходах, которые имеют возраст 41,42 и 43 года (если есть), и так далее.Я хотел бы систематический способ сделать это.

Минимальные данные будут выглядеть примерно так:

income <- c(1000, 2000, 3000, 4000, 6000, 7000, 8000, 9000, 10000, 11000)
age <- c(41, 42, 42, 44, 45, 46, 47, 47, 49, 50)
type <- c(1,1,2,2,1,2,1,2,1,1)

df <- as.data.frame(cbind(income, age, type))

Я думал об использовании роллаплинга в зоопарке, но это было бы для последовательности наблюдений переменных доходов, а не для значений одной из переменных группировкиВот те, которые я хочу «бросить».

Сортировка по dplyr (group_by(type,age)) %>% summarize (avg=mean(income)), но группировка по возрасту (возраст-1, возраст, возраст + 1).Цель состоит в том, чтобы сгладить средний доход по возрасту с перекрывающимися интервалами в три года.Конечно, доход в двух возрастах в каждом из хвостов возрастного распределения будет меньше или вообще не будет сглажен.

Спасибо !!

PS Ожидаемый результат будет следующим, я думаю(ручной расчет):

> dfexpected
   age type mean_income
1   41    1        1500
2   42    1        1500
3   43    1        2000
4   44    1        6000
5   45    1        6000
6   46    1        7500
7   47    1        9000
8   48    1        9500
9   49    1       10500
10  50    1       10500
11  41    2        3000
12  42    2        3000
13  43    2        3500
14  44    2        4000
15  45    2        5500
16  46    2        7500
17  47    2        7500
18  48    2        8000
19  49    2          NA
20  50    2          NA

Обратите внимание, что средний доход на (скользящий) возраст и тип равен только NA, если доход для этого типа за все три года в этом возрасте имеет все NA.Даже если фактическими данными для данного возраста являются NA, если есть наблюдения на год выше или ниже, среднее значение будет рассчитано (без учета NA).

Answer 1

Создайте сетку типов / возрастов g и объедините ее с df, давая m.Затем используйте ave для запуска rollapply на type:

library(zoo)

g <- expand.grid(type = unique(df$type), age = seq(min(df$age), max(df$age)))
m <- merge(g, df, all.x = TRUE)
roll <- function(x) rollapply(x, 3, mean, na.rm = TRUE, partial = TRUE)
transform(m, avg = ave(income, type, FUN = roll))

, давая:

   type age income   avg
1     1  41   1000  2000
2     1  42   3000  2000
3     1  43     NA  3000
4     1  44     NA  6000
5     1  45   6000  6000
6     1  46     NA  7000
7     1  47   8000  8000
8     1  48     NA  9000
9     1  49  10000 10500
10    1  50  11000 10500
11    2  41     NA  2000
12    2  42   2000  2000
13    2  43     NA  3000
14    2  44   4000  4000
15    2  45     NA  5500
16    2  46   7000  8000
17    2  47   9000  8000
18    2  48     NA  9000
19    2  49     NA   NaN
20    2  50     NA   NaN

Answer 2

Вот разновидность подхода грубой силы tidyverse.

library(tidyverse)
df <- data.frame(income =  c(1000, 2000, 3000, 4000, 6000, 7000, 8000, 9000, 10000, 11000), 
                 age = c(41, 42, 42, 44, 45, 46, 47, 47, 49, 50),
                 type =  c(1,1,2,2,1,2,1,2,1,1))

Укажите годы, включенные в каждое скользящее среднее, в данном случае это означает «включая предыдущий год, год и следующий год».

yr_range = c(-1:1)   # same as c(-1, 0, 1)

Сделайте копию каждой строки для каждой записи в yr_range, используя tidyr::uncount, затем создайте фиктивный age_adj, который корректирует возраст каждой строки, чтобы переместить ее в корзину для суммирования:

df2 <- df %>%
  uncount(length(yr_range)) %>%
  mutate(age_adj = rep(yr_range, length.out = n()),
         age_bucket  = age + age_adj) %>%
# At this point it looks like:
#   income age type age_adj age_bucket
#1    1000  41    1      -1         40
#2    1000  41    1       0         41  
#3    1000  41    1       1         42
#4    2000  42    2      -1         41   
#5    2000  42    2       0         42
#6    2000  42    2       1         43
  group_by(type, age_bucket) %>%
  summarize(income_mean = mean(income)) %>%
  # optional, to prune edge years beyond orig data
  filter(age_bucket >= min(df$age),
         age_bucket <= max(df$age))

> df2
# A tibble: 18 x 3
# Groups:   type [2]
    type age_bucket income_mean
   <dbl>      <dbl>       <dbl>
 1     1         41        1500
 2     1         42        1500
 3     1         43        2000
 4     1         44        6000
 5     1         45        6000
 6     1         46        7000
 7     1         47        8000
 8     1         48        9000
 9     1         49       10500
10     1         50       10500
11     2         41        3000
12     2         42        3000
13     2         43        3500
14     2         44        4000
15     2         45        5500
16     2         46        8000
17     2         47        8000
18     2         48        9000