【问题标题】:R/dplyr: Using a loop to create lags and calculate cumulative sums based on column namesR/dplyr:使用循环创建滞后并根据列名计算累积总和
【发布时间】:2018-11-08 17:56:51
【问题描述】:

我想遍历大型数据框中的一长列列,并计算列滞后值的累积总和。换句话说,我在计算每次观察之前“完成”了多少。

Toy 数据框有助于使这一点更清晰。

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

所以它不是 id 组内 v1 或 v2 的累积和,而是每个 id 的滞后值的累积和。

我可以在单个列上执行此操作没问题,但我似乎无法通过循环对其进行概括:

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(或 ifelse() 后为 0)。我知道我还没有完全掌握 mutate()。
  • 累计求和结果为 NA

有什么想法吗?谢谢您的帮助! (我想在休息几年后重新开始编码。然而,我的主要“语言”是 Stata,所以我想我正在接近这个有点不稳定。很高兴完全修改这个!)

【问题讨论】:

    标签: r loops dplyr


    【解决方案1】:

    如果我对您的理解正确,以下应该有效:

    可重现的样本数据(有 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
    

    按 id 分组,按日期排序(以防它们不按顺序排列),并对两个命名变量之间的所有命名变量进行变异(在这种情况下为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
    

    【讨论】:

    • 啊——这更有意义。感谢您的帮助!
    【解决方案2】:

    这是使用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
    

    【讨论】:

      【解决方案3】:

      我使用了与 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()
      

      正如 andrew-reece 提到的,!!cumname := ... 的语法相同,而且更方便:

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

      【讨论】:

      • 你可以使用!!:!!cumname := ...
      • 哦,我以前不知道那个。这样方便多了,谢谢!
      【解决方案4】:

      考虑一个带有ave 的简单基R:

      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
      

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 1970-01-01
        • 2023-01-18
        • 2019-07-08
        • 1970-01-01
        • 1970-01-01
        • 2019-01-18
        • 2019-04-24
        • 1970-01-01
        相关资源
        最近更新 更多