我对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((，但它似乎取决于数据是常规时间序列。 然而，我的不是。它需要按公司分组，并且某些行可能丢失。它还需要根据"月份"和"年份"字段获取前 n 行。
我意识到一种解决方法可能是呈现数据，以便为每个公司子集执行操作，并在中间注入几个月的虚拟数据，但我认为可能存在更好的方法。
我尝试了以下方法，该方法应用滞后和滚动窗口，但不考虑月份、年份和公司。
newthing <- lapply(mytable[,c('ProducedCereals'),with=F], function(x) rollapply(x, width=list(2:3),sum,align='left',fill=NA))
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 索引的动物园对象传递给rollapply这样我们就有一个时间索引，Sum可以检查该索引以将输入子集到所需窗口。 我们使用窗口大小 3，并且仅对窗口中时间在指定范围内的值求和。 我们将指定要rollapplycoredata = FALSE，以便将数据和索引传递给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(另一种可能性是z公司拆分mytable，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.tablemytable：
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)
我尝试了一个非 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
若要对 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 数据表(dt the data.table x.value.sum 您将在 data.table 中创建的变量 x 将在 2 的窗口中累积的变量 n 窗口的大小 sum 是函数，在本例中为 sum 要分组的 ID 变量