如何在 R 中的 data.table 中汇总给定条件的滞后时间数据？

Question

我对 R 相当陌生，并且已经阅读了一些教程。我想做的是找到一种根据某些条件将数据连接到自身的好方法。

在这种情况下，我想做的是选择任意长度的延迟并创建一个滚动窗口。例如，如果滞后 = 1 且窗口宽度 = 2，我想将每个月前 1 个月的 2 个月（如果存在）汇总起来。

如果我从这样的数据表开始：

mytable = data.table(Month = c(6, 5, 4, 6, 5), Year = c(2016, 2016, 2016, 2016, 2016), Company = c('Kellog', 'Kellog', 'General Mills', 'General Mills', 'General Mills'), ProducedCereals = c(6, 3, 12, 5, 7), CommercialsShown = c(12, 15, 4, 20, 19))

Month Year Company   ProducedCereals CommercialsShown
  6   2016  Kellog         6              12
  5   2016  Kellog         3              15
  4   2016  Kellog        12               4
  6   2016  General Mills  5              20
  5   2016  General Mills  7              19

包含计算字段的表格可能如下所示：

Month Year Company   ProducedCereals CommercialsShown
  6   2016  Kellog        15              19
  5   2016  Kellog        12               4
  4   2016  Kellog        NA              NA
  6   2016  General Mills  7              19
  5   2016  General Mills NA              NA

我已尝试使用列表宽度的 rollapply()，但它似乎取决于数据是否为常规时间序列。然而，我的不是。它需要按公司分组，并且可能缺少某些行。它还需要根据 Month 和 Year 字段取前 n 行。

我意识到一种解决方法可能是渲染数据，以便为每个公司子集执行操作，并在中间注入几个月缺失的虚拟数据，但我认为可能存在更好的方法。

我尝试了以下方法，它应用了滞后和滚动窗口，但不考虑月份、年份和公司。

newthing <- lapply(mytable[,c('ProducedCereals'),with=F], function(x) rollapply(x, width=list(2:3),sum,align='left',fill=NA))

Answer 1

1) 使用注释中定义的数据，最后使用rollapply，如下图所示。 nms 是要执行滚动窗口计算的列的名称，或者它可以指定为列索引（即nms <- 4:5）。 Sum 与 sum 类似，只是如果给定一个完全为 NA 的系列，它将返回 NA，而不是 0，否则它将执行 sum(X, na.rm = TRUE)。请注意，roll 中添加的 NA 值是为了使系列不短于窗口宽度。

library(data.table)
library(zoo)

k <- 2 # prior two months

Sum <- function(x) if (all(is.na(x))) NA else sum(x, na.rm = TRUE)
roll <- function(x) rollapply(c(x, rep(NA, k)), list(1:k), Sum)
nms <- names(mytable)[4:5]

mytable[, (nms) := lapply(.SD, roll), .SDcols = nms, by = "Company"]

给予：

> mytable
   Month Year       Company ProducedCereals CommercialsShown
1:     6 2016        Kellog              15               19
2:     5 2016        Kellog              12                4
3:     4 2016        Kellog              NA               NA
4:     6 2016 General Mills               7               19
5:     5 2016 General Mills              NA               NA

1a) 在评论中提到了缺少行的情况，并且仅使用当前行之前的最近两个日历月，因此可能使用少于 2 行任何金额。

在这种情况下，首先按公司顺序对数据框进行排序，然后按升序对日期进行排序，这意味着我们希望在rollapply 中右对齐而不是左对齐。

我们将带有 yearmon 索引的 zoo 对象传递给 rollapply，以便我们有一个时间索引，Sum 可以检查以将输入子集化到所需窗口。我们使用大小为 3 的窗口，并且只对时间在指定范围内的窗口中的值求和。我们将指定coredata = FALSE 到rollapply，以便将数据和索引传递给rollapply 函数，而不仅仅是数据。

k <- 2 # prior 2 months

# inputs zoo object x, subsets it to specified window and sums
Sum2 <- function(x) {
  w <- window(x, start = end(x) - k/12, end = end(x) - 1/12)
  if (length(w) == 0 || all(is.na(w))) NA_real_ else sum(w, na.rm = TRUE)
}

nms <- names(mytable)[4:5]

setkey(mytable, Company, Year, Month) # sort

# create zoo object from arguments and run rollapplyr using Sum2
roll2 <- function(x, year, month) {
  z <- zoo(x, as.yearmon(year + (month - 1)/12))
  coredata(rollapplyr(z, k+1, Sum2, coredata = FALSE, partial = TRUE))
}

mytable[, (nms) := lapply(.SD, roll2, Year, Month), .SDcols = nms, by = "Company"]

给予：

> mytable
    Month Year       Company ProducedCereals CommercialsShown
1:     5 2016 General Mills              NA               NA
2:     6 2016 General Mills               7               19
3:     4 2016        Kellog              NA               NA
4:     5 2016        Kellog              12                4
5:     6 2016        Kellog              15              

1b) 另一种缺失行的方法是将数据转换为长格式，然后转换为矩形格式，用 NA 填充缺失的单元格。只要每个公司都没有缺少相同的月份和年份，这将起作用。

k <- 2 # sum over k prior months
m <- melt(mytable, id = 1:3)
dd <- as.data.frame.table(tapply(m$value, m[, 1:4, with = FALSE], c), 
    responseName = "value")
Sum1 <- function(x) {
   x <- head(x, -1)
   if (length(x) == 0 || all(is.na(x))) NA_real_ else sum(x, na.rm = TRUE)
}
setDT(dd)[, value := rollapplyr(value, k+1, Sum1, partial = TRUE), 
     by = .(Company, variable)]
dc <- as.data.table(dcast(... ~ variable, data = dd, value = "value"))
setkey(dc, Company, Year, Month)
dc

给予：

   Month Year       Company ProducedCereals CommercialsShown
1:     4 2016 General Mills              NA               NA
2:     5 2016 General Mills              NA               NA
3:     6 2016 General Mills               7               19
4:     4 2016        Kellog              NA               NA
5:     5 2016        Kellog              12                4
6:     6 2016        Kellog              15               19

2) 另一种可能性是将mytable 转换为动物园对象z 拆分mytable，然后在上面使用rollapply。 mytable 再次如最后的注释所示。 Sum 来自 (1)。

k <- 2 # prior 2 months

ym <- function(m, y) as.yearmon(paste(m, y), format = "%m %Y")
z <- read.zoo(mytable, index = 1:2, split = k+1, FUN = ym)

Sum <- function(x) if (all(is.na(x))) NA else sum(x, na.rm = TRUE)
rollapply(z, list(-1:-k), Sum, partial = TRUE, fill = NA) 

给予：

         ProducedCereals.General Mills CommercialsShown.General Mills
Apr 2016                            NA                             NA
May 2016                            NA                             NA
Jun 2016                             7                             19
         ProducedCereals.Kellog CommercialsShown.Kellog
Apr 2016                     NA                      NA
May 2016                     12                       4
Jun 2016                     15                      19

注意：问题中的代码不会生成问题中显示的数据，因此我们将其用于data.table mytable：

library(data.table)
mytable <-
structure(list(Month = c(6, 5, 4, 6, 5), Year = c(2016, 2016, 
2016, 2016, 2016), Company = c("Kellog", "Kellog", "Kellog", 
"General Mills", "General Mills"), ProducedCereals = c(6, 3, 
12, 5, 7), CommercialsShown = c(12, 15, 4, 20, 19)), .Names = c("Month", 
"Year", "Company", "ProducedCereals", "CommercialsShown"), row.names = c(NA, 
-5L), class = "data.frame")
mytable <- as.data.table(mytable)

Answer 2

我尝试了非 equi 连接——它不喜欢与自身连接，所以我复制了表。虽然我确信这不是最好的方法，但它确实可以处理缺少的月份。

lag = 2 # The lag in number of months
block = 3 # The number of contiguous months to roll up

mytable = data.table(Month = c(6, 5, 4, 6, 5), Year = c(2016, 2016, 2016, 2016, 2016), Company = c('Kellog', 'Kellog', 'General Mills', 'General Mills', 'General Mills'), ProducedCereals = c(6, 3, 12, 5, 7), CommercialsShown = c(12, 15, 4, 20, 19))

setDT(mytable)[, "MonthsSinceEpoch" := {
  MonthsSinceEpoch = (Year - 2000) * 12 + Month
 .(MonthsSinceEpoch)
}]

mytable2 <- mytable

setDT(mytable2)[, "EndMonths" := {
  EndMonths = MonthsSinceEpoch - lag
  .(EndMonths)
}]
setDT(mytable2)[, "StartMonths" := {
  StartMonths = MonthsSinceEpoch - lag - block + 1
  .(StartMonths)
}]

mytable3 <- mytable[mytable2, on = .(Company, MonthsSinceEpoch >= StartMonths, MonthsSinceEpoch <= EndMonths),
                   .(CommercialsShown = sum(CommercialsShown), ProducedCereals = sum(ProducedCereals)),
                   by=.EACHI]

mytable3 <- mytable3[order(rank(Company), -MonthsSinceEpoch)]
mytable3

Answer 3

要对 data.table 执行此过程，您必须使用 data.table 包和 frollapply 函数，如下所述。

dt[, x.value.sum := frollapply(x = x, n = 2, sum, fill = NA, align = "right", na.rm =TRUE), by = ID]

在哪里： dt 数据表 x.value.sum 您将在 data.table 中创建的变量 x 将在 2 的窗口中累积的变量 n 窗口大小 sum 是函数，在本例中为 sum 要分组的 ID 变量