R / dplyr: использование цикла для создания лагов и расчета кумулятивных сумм на основе имен столбцов

Question

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

Игрушечный фрейм данных, чтобы помочь сделать это более ясным.

id = c("a", "a", "a", "b", "b")
date = seq(as.Date("2015-12-01"), as.Date("2015-12-05"), by="days")
v1 = sample(seq(1, 20), 5)
v2 = sample(seq(1, 20), 5)
df = data.frame(id, date, v1, v2)

Я хочу, чтобы он выглядел как

id   date         v1   v2   v1Cum   v2Cum
a    2015-12-01   1    13     0       0
a    2015-12-02   7    11     1       13
a    2015-12-03   12   2      8       24
b    2015-12-04   18   6      0       0
b    2015-12-05   4    9      18      6

Так что это не кумулятивная сумма v1 или v2 в пределахгруппы идентификаторов, а скорее накопленная сумма отстающих значений каждого идентификатора.

Я могу сделать это для отдельных столбцов без проблем, но я не могу обобщить это с помощью цикла:

vars = c("v1", "v2")
for (var in vars) {
  lagname = paste(var, "Lag", sep="")
  cumname = paste(var, "Cum", sep="")
  df = arrange(df, id, date)
  df = df %>% 
    group_by(id) %>% 
    mutate(!!lagname := dplyr::lag(var, n = 1, default = NA))
  df[[lagname]] = ifelse(is.na(df[[lagname]]), 0, df[[lagname]])
  df = df %>% group_by(id) %>% arrange(date) %>% mutate(!!cumname := cumsum(!!lagname))
}

Проблемы, на мой взгляд, состоят в том, что

• переменная запаздывания просто оценивается как NA (или 0 после ifelse ()).Я знаю, что не совсем прибил mutate ().
• Суммарное суммирование оценивается как NA

Есть идеи?Спасибо за помощь!(Я пытаюсь вернуться к кодированию после паузы в пару лет. Однако моим основным «языком» был Stata, поэтому я представляю, что подхожу к этому немного странно. Рад полностью пересмотреть это!)

Answer 1

Рассмотрим простую базу R с ave:

set.seed(22)
id = c("a", "a", "a", "b", "b")
date = seq(as.Date("2015-12-01"), as.Date("2015-12-05"), by="days")
v1 = sample(seq(1, 20), 5)
v2 = sample(seq(1, 20), 5)
df = data.frame(id, date, v1, v2)

for (col in c("v1", "v2")) {
   df[[paste0(col, "_cum")]] <- ave(df[[col]], df$id, FUN=function(x) 
                                       cumsum(c(0,x[1:(length(x)-1)])))
} 

print(df)
#  id       date  v1  v2 v1_cum v2_cum
#   a 2015-12-01   7  15      0      0
#   a 2015-12-02  10  12      7     15
#   a 2015-12-03  18  14     17     27
#   b 2015-12-04   9   8      0      0
#   b 2015-12-05  14   6      9      8

Answer 2

Я использовал такой же подход, как Z.Lin.

Еще одна вещь, которую вам нужно знать, это:

вам нужно использовать синтаксис, такой как UQ(rlang::sym(cumname)), чтобы преобразовать символ в исполняемый файл выраженияв dplyr, поскольку dplyr использует нестандартную оценку.

library(dplyr)
id = c("a", "a", "a", "b", "b")
date = seq(as.Date("2015-12-01"), as.Date("2015-12-05"), by="days")
set.seed(1)
v1 = sample(seq(1, 20), 5)
set.seed(2)
v2 = sample(seq(1, 20), 5)
df = data.frame(id, date, v1, v2)
var_list <- c("v1","v2")
cumname <- "Cum"


df %>%
    group_by(id) %>%
    mutate_at(vars(one_of(var_list)),
              funs(UQ(rlang::sym(cumname)) := cumsum(lag(.,default = 0)))) %>%
    ungroup()

Как упоминалось Эндрю-Рисом, синтаксис !!cumname := ... работает так же и намного удобнее:

df %>%
    group_by(id) %>%
    mutate_at(vars(one_of(var_list)),
              funs(!!cumname := cumsum(lag(.,default = 0)))) %>%
    ungroup()

Answer 3

Вот решение с использованием data.table.

id <- c("a", "a", "a", "b", "b")
date <- seq(as.Date("2015-12-01"), as.Date("2015-12-05"), by="days")
v1 <- sample(seq(1, 20), 5)
v2 <- sample(seq(1, 20), 5)
df <- data.frame(id, date, v1, v2)
df

  id       date v1 v2
1  a 2015-12-01 19  9
2  a 2015-12-02  3 17
3  a 2015-12-03  7 14
4  b 2015-12-04 10 15
5  b 2015-12-05  8 11

library(data.table)
tab <- as.data.table(df)[, (c("v1Cum", "v2Cum")) := lapply(.SD, function(x) {
  # Shift v1 and v2.
  xs <- shift(x)

  # Cumulate those values, making an allowance for <NA> values created by the
  # shift function.
  cumsum(ifelse(is.na(xs), 0, xs))
}), by = id, .SDcols = c("v1", "v2")]
tab[]

   id       date v1 v2 v1Cum v2Cum
1:  a 2015-12-01 19  9     0     0
2:  a 2015-12-02  3 17    19     9
3:  a 2015-12-03  7 14    22    26
4:  b 2015-12-04 10 15     0     0
5:  b 2015-12-05  8 11    10    15

Answer 4

Если я правильно вас понимаю, должно работать следующее:

Воспроизводимые выборочные данные (с 3 переменными для суммирования):

set.seed(123)
df = data.frame(
  id = c("a", "a", "a", "b", "b"),
  date = seq(as.Date("2015-12-01"), as.Date("2015-12-05"), by="days"),
  v1 = sample(seq(1, 20), 5),
  v2 = sample(seq(1, 20), 5),
  v3 = sample(seq(1, 20), 5)
)

> df
  id       date v1 v2 v3
1  a 2015-12-01  6  1 20
2  a 2015-12-02 15 11  9
3  a 2015-12-03  8 17 13
4  b 2015-12-04 16 10 10
5  b 2015-12-05 17  8  2

Группировка по идентификатору, сортировка по дате (в случаеони не в последовательности), & mutate для всех именованных переменных между двумя именованными (v1:v3 в данном случае):

df %>%
  group_by(id) %>%
  arrange(date) %>%
  mutate_at(vars(v1:v3), funs(Cum = cumsum(lag(., default = 0)))) %>%
  ungroup()


# A tibble: 5 x 8
# Groups: id [2]
  id     date          v1    v2    v3 v1_Cum v2_Cum v3_Cum
  <fctr> <date>     <int> <int> <int>  <int>  <int>  <int>
1 a      2015-12-01     6     1    20      0      0      0
2 a      2015-12-02    15    11     9      6      1     20
3 a      2015-12-03     8    17    13     21     12     29
4 b      2015-12-04    16    10    10      0      0      0
5 b      2015-12-05    17     8     2     16     10     10