我对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))
答案 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
,然后使用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)
答案 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 变量