Генерация столбца со средним значением строк до и после индекса строки времени

Question

Учитывая некоторые данные, подобные следующим:

set.seed(1234)
df <- tibble(class = rep(c("a","b"), each=6), value = c(rnorm(n=6, mean=0, sd=1), rnorm(n=6, mean=1, sd=0.1)))

# A tibble: 12 x 2
#   class  value
#   <chr>  <dbl>
# 1 a     -1.21 
# 2 a      0.277
# 3 a      1.08 
# 4 a     -2.35 
# 5 a      0.429
# 6 a      0.506
# 7 b      0.943
# 8 b      0.945
# 9 b      0.944
#10 b      0.911
#11 b      0.952
#12 b      0.900

Я пытаюсь сгенерировать новый столбец (контекст), который содержит среднее значение "значения" X предшествующих и задних строк, когда это возможно. Было бы желательно иметь это по уровню фактора в другом столбце. Например, для X = 2 я ожидал бы что-то вроде следующего:

# A tibble: 12 x 2
#   class  value  context
#   <chr>  <dbl>  <dbl>
# 1 a     -1.21     NA
# 2 a      0.277    NA
# 3 a      1.08     -0.7135
# 4 a     -2.35     0.573
# 5 a      0.429    NA
# 6 a      0.506    NA
# 7 b      0.943    NA
# 8 b      0.945    NA
# 9 b      0.944    0.9377
#10 b      0.911    0.9278
#11 b      0.952    NA
#12 b      0.900    NA

Обратите внимание, что для первых двух строк невозможно создать значение контекста в этом случае, потому что они не имеют X = 2 предварительных ряда. Значение -0,7135 в строке 3 является средним значением для строк 1, 2, 4 и 5.

Аналогично, строки 5 и 6 не имеют значения контекста, поскольку впоследствии у них нет двух значений, принадлежащих тот же уровень фактора "класс" (потому что строка 7 - это класс = "b", а 5 и 6 - это класс = "а").

Я не знаю, возможно ли это даже в R, I Я не нашел подобных вопросов, и я могу только найти решения, подобные следующему, которое, я думаю, не является репрезентативным для этого языка.

Мое решение:

X <- 2
df_list <- df %>% dplyr::group_split(class)
result <- tibble()
for (i in 1:length(df_list)) {
  tmp <- df_list[[i]]
  context <- vector()
  for (j in 1:nrow(tmp)) {
    if (j<=X | j>nrow(tmp)-X) context <- c(context, NA)
    else {
      values <- vector()
      for (k in 1:X) {
        values <- c(values, tmp$value[j-k], tmp$value[j+k])
      }
      context <- c(context, mean(values))
    }
  }
  tmp <- tmp %>% dplyr::mutate(context=context)
  result <- result %>% dplyr::bind_rows(tmp)
}

Это будет дать и приблизительное решение выше (различия, связанные с округлением). Но опять же, этому подходу не хватает гибкости, например, если мы хотим создать разные столбцы одновременно для разных значений X. Существуют ли функции R, разработанные для решения таких задач, как эта? (например, векторизованные функции?)

Answer 1

# this is your dataframe
set.seed(1234)
df <- tibble(class = rep(c("a","b"), each=6), value = c(rnorm(n=6, mean=0, sd=1), rnorm(n=6, mean=1, sd=0.1)))

# pipes ('%>%') and grouping from the dplyr package
library(tidyverse)
# rolling mean function from the zoo package
library(zoo)

df %>% # take df
    group_by(class) %>% # group it by class
    mutate(context = (rollsum(value, 5, fill = NA) - value) / 4) # and calculate the rolling mean

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

Answer 2

Вот базовое решение R с использованием ave(), т. Е.

df <- within(df,
       contest <- ave(value,
                      class,
                      FUN = function(v,X=2) sapply(seq(v), function(k) ifelse(k-X < 1  | k+X >length(v),NA,mean(v[c(k-(X:1),k + (1:X))])))))

, такое что

> df 
# A tibble: 12 x 3
   class  value contest
   <chr>  <dbl>   <dbl>
 1 a     -1.21   NA    
 2 a      0.277  NA    
 3 a      1.08   -0.712
 4 a     -2.35    0.574
 5 a      0.429  NA    
 6 a      0.506  NA    
 7 b      0.943  NA    
 8 b      0.945  NA    
 9 b      0.944   0.938
10 b      0.911   0.935
11 b      0.952  NA    
12 b      0.900  NA    

Answer 3

В одну сторону, используя dplyr:

n <- 2
library(dplyr)

df %>%
  group_by(class) %>%
  mutate(context = map_dbl(row_number(), ~ if(.x <= n | .x > (n() - n)) 
         NA else mean(value[c((.x - n):(.x - 1), (.x + 1) : (.x + n))])))

#  class  value context
#  <chr>  <dbl>   <dbl>
# 1 a     -1.21   NA    
# 2 a      0.277  NA    
# 3 a      1.08   -0.712
# 4 a     -2.35    0.574
# 5 a      0.429  NA    
# 6 a      0.506  NA    
# 7 b      0.943  NA    
# 8 b      0.945  NA    
# 9 b      0.944   0.938
#10 b      0.911   0.935
#11 b      0.952  NA    
#12 b      0.900  NA