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

Question

    dat <- structure(list(yearRef = c(1970, 1971, 1972, 1973, 1974, 1975, 
    1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983, 1984, 1985, 1986, 
    1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 
    1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 
    2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018), 
    value = c(0.761253538863966, 0.778365700864592, 0.748473422160476, 
    0.790408287413012, 0.726707786670043, 0.80587461240495, 0.81582881742434, 
    0.914998995290579, 0.903241004636529, 0.883446087736501, 
    0.878399385374308, 0.790239960507709, 0.853841173129717, 
    0.972923769177295, 0.899133969911117, 0.865840008976815, 
    0.85942147306247, 0.9471790327507, 0.905362802563981, 0.91644169495142, 
    0.985789564141214, 0.978212191208007, 0.885157529562834, 
    1.01638026873823, 1.02702020472382, 0.944421276774342, 0.979439113456467, 
    0.951183598644539, 1.12054063623421, 1.00767230122493, 1.02132151007705, 
    0.95649988168142, 0.928385199359045, 1.05071183719421, 1.11654102944792, 
    0.910601547182633, 0.936460862711605, 1.2398210426787, 0.979036947391532, 
    1.09931214756341, 1.12206830109171, 0.997384903912461, 1.07413151131128, 
    0.967026290186151, 1.04921352764649, 1.08746580600605, 1.02444885186573, 
    1.14604631626466, 1.06449109417896)), class = c("tbl_df", 
    "tbl", "data.frame"), row.names = c(NA, -49L))

Для каждого года я хочу рассчитать среднее из 5 лучших значений из предыдущих 7 значений. Например, первое среднее значение будет для 1977 года и будет состоять из среднего значения лучших 5 лет с 1970 по 1976 год. Аналогичным образом, для 1978 года среднее значение будет верхними 5 значениями с 1971-1977 годов. Аналогичным образом, для 2018 года среднее значение будет верхним 5 значениями за 2011 - 2017 годы

. У меня есть следующий код из SO, который выполняет эту работу.

  library(data.table)
  library(zoo)

  setDT(dat)

  dat[, mean.val:= if (.N > 6) 
        rollapplyr(value, 7,function(x) mean(tail(sort(x), 5)), fill = NA)  
        else mean(value)] 

, хотя первое значение в новом столбце mean.val является правильным, оно должно быть присвоено строке, имеющей 1977, но присвоенной 1976.

Answer 1

Вы хотите обработать PRIOR 7 точек, а не 7 точек, заканчивающихся в текущей точке. Для этого используйте ширину list(-(1:7)). Это говорит об использовании смещений от -1 до -7 при обработке данных. См. ?rollapply для получения дополнительной информации об указании аргумента width.

Это (1) более точно определяет намерение, облегчающее понимание, чем подходы, которые требуют игнорирования требуемых смещений, а затем исправляют их позже и (2) использует только те пакеты, которые вы уже используете (3) выражает решение компактно и (4) сохраняет ваше решение, изменяя только один аргумент.

  dat[, mean.val:= if (.N > 6) 
        rollapply(value, list(-(1:7)), function(x) mean(tail(sort(x), 5)), fill = NA)  
        else mean(value)] 

Answer 2

Если единственная проблема заключается в том, что значения должны быть сдвинуты на 1 строку вниз, вы можете использовать shift, чтобы исправить это.

dat[, mean.val := shift(mean.val)]

К вашему сведению, если вы используете версию> = 1.12.4 data.table, вам не нужен зоопарк, и вы можете использовать data.table::frollapply.

dat[, mean.val2 := 
      shift(frollapply(value, 7, function(x) mean(tail(sort(x), 5))))]

dat[, all.equal(mean.val, mean.val2)] #TRUE

Answer 3

Это просто для l oop решить проблему:

dat$mean.val = NA

for(i in 8:nrow(dat))
{
  dat$mean.val[i] = mean(sort(dat$value[(i-7):(i-1)],decreasing = TRUE)[1:5])
}

Answer 4

Я думаю, вы можете использовать превосходный пакет tsibble для потрясающей функции прокатки, а затем вы можете использовать функцию опережения для смещения результатов

library(tidyverse)

dat <- structure(list(yearRef = c(1970, 1971, 1972, 1973, 1974, 1975, 
                                  1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983, 1984, 1985, 1986, 
                                  1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 
                                  1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 
                                  2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018), 
                      value = c(0.761253538863966, 0.778365700864592, 0.748473422160476, 
                                0.790408287413012, 0.726707786670043, 0.80587461240495, 0.81582881742434, 
                                0.914998995290579, 0.903241004636529, 0.883446087736501, 
                                0.878399385374308, 0.790239960507709, 0.853841173129717, 
                                0.972923769177295, 0.899133969911117, 0.865840008976815, 
                                0.85942147306247, 0.9471790327507, 0.905362802563981, 0.91644169495142, 
                                0.985789564141214, 0.978212191208007, 0.885157529562834, 
                                1.01638026873823, 1.02702020472382, 0.944421276774342, 0.979439113456467, 
                                0.951183598644539, 1.12054063623421, 1.00767230122493, 1.02132151007705, 
                                0.95649988168142, 0.928385199359045, 1.05071183719421, 1.11654102944792, 
                                0.910601547182633, 0.936460862711605, 1.2398210426787, 0.979036947391532, 
                                1.09931214756341, 1.12206830109171, 0.997384903912461, 1.07413151131128, 
                                0.967026290186151, 1.04921352764649, 1.08746580600605, 1.02444885186573, 
                                1.14604631626466, 1.06449109417896)), class = c("tbl_df", 
                                                                                "tbl", "data.frame"), row.names = c(NA, -49L))

complex_function <- . %>% 
  sort %>% 
  tail(.,5) %>% 
  mean

dat %>%
  mutate(roll_avg  = tsibble::slide_dbl(.x = value,.f = complex_function,.size = 7),
         roll_avg2 = lag(roll_avg))
#> # A tibble: 49 x 4
#>    yearRef value roll_avg roll_avg2
#>      <dbl> <dbl>    <dbl>     <dbl>
#>  1    1970 0.761   NA        NA    
#>  2    1971 0.778   NA        NA    
#>  3    1972 0.748   NA        NA    
#>  4    1973 0.790   NA        NA    
#>  5    1974 0.727   NA        NA    
#>  6    1975 0.806   NA        NA    
#>  7    1976 0.816    0.790    NA    
#>  8    1977 0.915    0.821     0.790
#>  9    1978 0.903    0.846     0.821
#> 10    1979 0.883    0.865     0.846
#> # … with 39 more rows

^{Создано в 2020-01-14 Представить пакет (v0.3.0)}