如何在R中的data.table中给出条件时累加滞后时间数据?

时间:2017-08-07 14:33:51

标签: r dataframe data.table rollapply

我对R很新,并且已经完成了一些教程。我想做的是找到一种基于某些条件将数据连接到自身的好方法。

在这种情况下,我想要做的是选择任意长度的滞后并创建一个滚动窗口。例如,如果滞后= 1且窗口宽度= 2,我想卷起每个月前一个月的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))

3 个答案:

答案 0 :(得分:2)

1)最后使用Note中定义的数据使用rollapply,如下所示。 nms是执行滚动窗口计算的列的名称,或者它可以仅指定为列索引(即nms <- 4:5)。 Sum类似于sum,除非它返回NA而不是0,如果给出一个完全是NA的系列,否则它将执行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,然后使用rollapplymytable再次如最后的注释中所示。 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)

答案 1 :(得分:1)

我尝试了一个非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

答案 2 :(得分:0)

要对 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 变量