Внутригрупповые операции в R (не скользящая сумма)

Question

У меня есть набор данных, состоящий из студентов (id) и их оценки каждый год:

library(data.table)
set.seed(1)
students <- data.table("id" = rep(1:10, each = 10),
                "year" = rep(2000:2009, 10),
                "grade" = sample(c(9:11, rep(NA, 5)), 100, replace = T))

Вот образец для ученика 1:

     id year grade
  1:  1 2000     9
  2:  1 2001    NA
  3:  1 2002    NA
  4:  1 2003     9
  5:  1 2004    10
  6:  1 2005    NA
  7:  1 2006    NA
  8:  1 2007    11
  9:  1 2008    NA

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

    id year grade sum_lag_3
 1:  1 2000     9         9 # 1st window, size 1: 9
 2:  1 2001    NA         9 
 3:  1 2002    NA         9
 4:  1 2003     9        18 # 2nd, size 2: 9 + 9 = 18 
 5:  1 2004    10        28 # 3rd, size 3: 9 + 9 + 10 = 28
 6:  1 2005    NA        28
 7:  1 2006    NA        28
 8:  1 2007    11        30 # 4th, size 3: 9 + 10 + 11 = 30 
 9:  1 2008    NA        30
10:  1 2009    10        31 # 5th, size 3: 10 + 11 + 10 = 31

11:  2 2001    11        11 # 1st window, size 1: 11 

(все результаты будут выглядеть как это ).

• Это, однако, НЕ сообщение о предварительном формировании скользящей суммы.
• Я хочу иметь возможность в более общем плане выполнять предварительные операции в каждой группе, для этого мне нужно было бы найти способ сослаться на всех прошлых и будущих студентов оценки.

Таким образом, в случае первой строки, поскольку нет предыдущих наблюдений, это будет означать, что вектор «прошлое» пуст, а вектор «будущего» будет NA NA 9 10 NA NA 11 NA 10.

Точно так же для второй строки вектор «прошлого» будет 9, а вектор «будущего» будет:

NA 9 10 NA NA 11 NA 10

И для третьей строки ' вектор прошлого будет 9 NA, а вектор будущего будет:

9 10 NA NA 11 NA 10

Это информация, которую я хочу использовать для различных вычислений. Расчеты, которые выполняются только внутри каждой группы и различаются в зависимости от контекста. Предпочтительно я хотел бы сделать это, используя data.table и не преобразовывая мои данные в широкий формат.

Я пробовал сделать следующее:

students[, .SD[, sum_last_3:= ...], by = id]

, но получаю сообщение об ошибке сообщение о том, что эта функция еще не доступна на data.table (где ... - это заполнитель для любой операции.).

Всем спасибо.

---

Answer 1

Аналогично @ chinsoon12, но с использованием zoo::rollapply для простого применения sum к частичному окну.

d[!is.na(grade), rs := rollapply(grade, 3, sum, align = "right", partial = TRUE), by = id]
d[ , rs := nafill(rs, type = "locf"), by = id]

#     id year grade sum_lag_3 rs
#  1:  1 2000     9         9  9
#  2:  1 2001    NA         9  9
#  3:  1 2002    NA         9  9
#  4:  1 2003     9        18 18
#  5:  1 2004    10        28 28
#  6:  1 2005    NA        28 28
#  7:  1 2006    NA        28 28
#  8:  1 2007    11        30 30
#  9:  1 2008    NA        30 30
# 10:  1 2009    10        31 31
# 11:  2 2001    11        11 11

---

In data.table::frollsum, "partial оконная функция не поддерживается, хотя это можно сделать, используя adaptive=TRUE "и функцию адаптивной прокрутки (см. ?frollsum):

arf = function(n, len) if(len < n) seq.int(len) else c(seq.int(n), rep(n, len - n))
# if no 'grade' is shorter than n (the full window width), you only need: 
# c(seq.int(n), rep(n, len - n))

d[!is.na(grade) , rs2 := frollsum(grade, n = arf(3, .N), align = "right", adaptive = TRUE),
 by = id]
d[ , rs2 := nafill(rs, type = "locf"), by = id]

#     id year grade sum_lag_3 rs rs2
#  1:  1 2000     9         9  9   9
#  2:  1 2001    NA         9  9   9
#  3:  1 2002    NA         9  9   9
#  4:  1 2003     9        18 18  18
#  5:  1 2004    10        28 28  28
#  6:  1 2005    NA        28 28  28
#  7:  1 2006    NA        28 28  28
#  8:  1 2007    11        30 30  30
#  9:  1 2008    NA        30 30  30
# 10:  1 2009    10        31 31  31
# 11:  2 2001    11        11 11  11

---

Примечание к вашему комментарий :

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

В zoo::rollapply вы можете поместить другие функции в аргумент FUN. В настоящее время эквивалент data.table, frollapply, не имеет аргумента adaptive. Таким образом, метод, который я использовал для frollsum выше, еще не может быть применен в frollapply.

Answer 2

Вот вариант, использующий frollsum в data.table, применяя его к значениям, отличным от NA, перед переносом последнего наблюдения вперед:

students[!is.na(grade), sum_lag_3 := 
    fcoalesce(frollsum(grade, 3L), as.double(cumsum(grade))), id]
students[, sum_lag_3 := nafill(sum_lag_3, "locf"), id]

вывод:

     id year grade sum_lag_3
  1:  1 2000     9         9
  2:  1 2001    NA         9
  3:  1 2002    NA         9
  4:  1 2003     9        18
  5:  1 2004    10        28
  6:  1 2005    NA        28
  7:  1 2006    NA        28
  8:  1 2007    11        30
  9:  1 2008    NA        30
 10:  1 2009    10        31
 11:  2 2000    11        11    <-----
 12:  2 2001    11        22
 13:  2 2002     9        31
 14:  2 2003    NA        31
 15:  2 2004    NA        31
 16:  2 2005    10        30
 17:  2 2006    NA        30
 18:  2 2007    NA        30
 19:  2 2008    10        29
 20:  2 2009    NA        29
 21:  3 2000     9         9
 22:  3 2001    NA         9
 23:  3 2002    NA         9
 24:  3 2003    NA         9
 25:  3 2004     9        18
 26:  3 2005     9        27
 27:  3 2006    NA        27
 28:  3 2007    NA        27
 29:  3 2008    NA        27
 30:  3 2009    10        28
 31:  4 2000    10        10
 32:  4 2001    NA        10
 33:  4 2002     9        19
 34:  4 2003    NA        19
 35:  4 2004    NA        19
 36:  4 2005     9        28
 37:  4 2006    NA        28
 38:  4 2007    11        29
 39:  4 2008    NA        29
 40:  4 2009    10        30
 41:  5 2000    10        10
 42:  5 2001    NA        10
 43:  5 2002    NA        10
 44:  5 2003    NA        10
 45:  5 2004    NA        10
 46:  5 2005    NA        10
 47:  5 2006    10        20
 48:  5 2007    NA        20
 49:  5 2008     9        29
 50:  5 2009    NA        29
 51:  6 2000    NA        NA
 52:  6 2001     9         9
 53:  6 2002    NA         9
 54:  6 2003    NA         9
 55:  6 2004     9        18
 56:  6 2005    NA        18
 57:  6 2006    NA        18
 58:  6 2007    NA        18
 59:  6 2008    10        28
 60:  6 2009    NA        28
 61:  7 2000    11        11
 62:  7 2001    10        21
 63:  7 2002    NA        21
 64:  7 2003    NA        21
 65:  7 2004    NA        21
 66:  7 2005    NA        21
 67:  7 2006    10        31
 68:  7 2007    NA        31
 69:  7 2008    10        30
 70:  7 2009    NA        30
 71:  8 2000    NA        NA
 72:  8 2001    NA        NA
 73:  8 2002     9         9
 74:  8 2003    11        20
 75:  8 2004    11        31
 76:  8 2005    NA        31
 77:  8 2006    NA        31
 78:  8 2007    NA        31
 79:  8 2008    NA        31
 80:  8 2009    NA        31
 81:  9 2000    NA        NA
 82:  9 2001    NA        NA
 83:  9 2002    NA        NA
 84:  9 2003    11        11
 85:  9 2004     9        20
 86:  9 2005    NA        20
 87:  9 2006    NA        20
 88:  9 2007    NA        20
 89:  9 2008     9        29
 90:  9 2009    NA        29
 91: 10 2000     9         9
 92: 10 2001    NA         9
 93: 10 2002    NA         9
 94: 10 2003    NA         9
 95: 10 2004    NA         9
 96: 10 2005    NA         9
 97: 10 2006    NA         9
 98: 10 2007    NA         9
 99: 10 2008    NA         9
100: 10 2009    NA         9
     id year grade sum_lag_3

---

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

#for example using sum on past grades and mean on future grades
pastFunc <- sum
futureFunc <- mean

students[, {
  vapply(1L:.N, function(n) {
    past <- grade[seq_len(n-1)]
    future <- grade[seq_len(.N-n)+n]
    sum(past, na.rm=TRUE) + mean(future, na.rm=TRUE)
  }, numeric(1L))  
}, id]