如何进行仅在某些日期标准之间查看的条件总和

Question

假设我的数据看起来像

date, user, items_bought, event_number
2013-01-01, x, 2, 1
2013-01-02, x, 1, 2
2013-01-03, x, 0, 3
2013-01-04, x, 0, 4
2013-01-04, x, 1, 5
2013-01-04, x, 2, 6
2013-01-05, x, 3, 7
2013-01-06, x, 1, 8
2013-01-01, y, 1, 1
2013-01-02, y, 1, 2
2013-01-03, y, 0, 3
2013-01-04, y, 5, 4
2013-01-05, y, 6, 5
2013-01-06, y, 1, 6

获取每个用户每个数据点的累积总和

data.frame(cum_items_bought=unlist(tapply(as.numeric(data$items_bought), data$user, FUN = cumsum)))

这个输出看起来像

date, user, items_bought
2013-01-01, x, 2
2013-01-02, x, 3
2013-01-03, x, 3
2013-01-04, x, 3
2013-01-04, x, 4
2013-01-04, x, 6
2013-01-05, x, 9
2013-01-06, x, 10
2013-01-01, y, 1
2013-01-02, y, 2
2013-01-03, y, 2
2013-01-04, y, 7
2013-01-05, y, 13
2013-01-06, y, 14

但是，我想将总和限制为仅将每行 3 天内发生的总和相加（相对于用户）。即输出需要如下所示：

date, user, cum_items_bought_3_days
2013-01-01, x, 2
2013-01-02, x, 3
2013-01-03, x, 3
2013-01-04, x, 1
2013-01-04, x, 2
2013-01-04, x, 4
2013-01-05, x, 6
2013-01-06, x, 7
2013-01-01, y, 1
2013-01-02, y, 2
2013-01-03, y, 2
2013-01-04, y, 6
2013-01-05, y, 11
2013-01-06, y, 12

Answer 1

这是一个dplyr 解决方案，它将产生问题中指定的所需结果（14 行）。请注意，它会处理重复的日期条目，例如用户 x 的 2013-01-04。

# define a custom function to be used in the dplyr chain
myfunc <- function(x){
  with(x, sapply(event_number, function(y) 
    sum(items_bought[event_number <= event_number[y] & date[y] - date <= 2])))
}

require(dplyr)                 #install and load into your library

df %>%
  mutate(date = as.Date(as.character(date))) %>%
  group_by(user) %>%
  do(data.frame(., cum_items_bought_3_days = myfunc(.))) %>%
  select(-c(items_bought, event_number))

#         date user cum_items_bought_3_days
#1  2013-01-01    x                       2
#2  2013-01-02    x                       3
#3  2013-01-03    x                       3
#4  2013-01-04    x                       1
#5  2013-01-04    x                       2
#6  2013-01-04    x                       4
#7  2013-01-05    x                       6
#8  2013-01-06    x                       7
#9  2013-01-01    y                       1
#10 2013-01-02    y                       2
#11 2013-01-03    y                       2
#12 2013-01-04    y                       6
#13 2013-01-05    y                      11
#14 2013-01-06    y                      12

在我的回答中，我在 dplyr 链中使用了自定义函数 myfunc。这是使用来自dplyr 的do 运算符完成的。自定义函数由user 组传递子集df。然后它使用sapply 传递每个event_number 并计算items_bought 的总和。 dplyr 链的最后一行取消选择不需要的列。

如果您需要更详细的说明，请告诉我。

OP 评论后编辑：

如果您需要更大的灵活性来有条件地汇总其他列，您可以调整代码如下。我在这里假设其他列的总结方式应与items_bought 相同。如果这不正确，请指定您希望如何对其他列进行汇总。

我首先在数据中创建两个带有随机数的附加列（我将在答案底部发布数据的dput）：

set.seed(99)   # for reproducibility only

df$newCol1 <- sample(0:10, 14, replace=T)
df$newCol2 <- runif(14)

df
#         date user items_bought event_number newCol1     newCol2
#1  2013-01-01    x            2            1       6 0.687800094
#2  2013-01-02    x            1            2       1 0.640190769
#3  2013-01-03    x            0            3       7 0.357885360
#4  2013-01-04    x            0            4      10 0.102584999
#5  2013-01-04    x            1            5       5 0.097790922
#6  2013-01-04    x            2            6      10 0.182886256
#7  2013-01-05    x            3            7       7 0.227903474
#8  2013-01-06    x            1            8       3 0.080524150
#9  2013-01-01    y            1            1       3 0.821618422
#10 2013-01-02    y            1            2       1 0.591113977
#11 2013-01-03    y            0            3       6 0.773389019
#12 2013-01-04    y            5            4       5 0.350085977
#13 2013-01-05    y            6            5       2 0.006061323
#14 2013-01-06    y            1            6       7 0.814506223

接下来，您可以修改 myfunc 以采用 2 个参数，而不是 1 个。第一个参数将像以前一样保留子集的 data.frame（在 dplyr 链中由 . 表示，在函数定义中由 x 表示myfunc)，而 myfunc 的第二个参数将指定要汇总的列 (colname)。

myfunc <- function(x, colname){
  with(x, sapply(event_number, function(y) 
    sum(x[event_number <= event_number[y] & date[y] - date <= 2, colname])))
}

然后，如果你想有条件地总结几列，你可以多次使用myfunc：

df %>%
  mutate(date = as.Date(as.character(date))) %>%
  group_by(user) %>%
  do(data.frame(., cum_items_bought_3_days = myfunc(., "items_bought"),
                   newCol1Sums = myfunc(., "newCol1"),            
                   newCol2Sums = myfunc(., "newCol2"))) %>%
select(-c(items_bought, event_number, newCol1, newCol2))

#         date user cum_items_bought_3_days newCol1Sums newCol2Sums
#1  2013-01-01    x                       2           6   0.6878001
#2  2013-01-02    x                       3           7   1.3279909
#3  2013-01-03    x                       3          14   1.6858762
#4  2013-01-04    x                       1          18   1.1006611
#5  2013-01-04    x                       2          23   1.1984520
#6  2013-01-04    x                       4          33   1.3813383
#7  2013-01-05    x                       6          39   0.9690510
#8  2013-01-06    x                       7          35   0.6916898
#9  2013-01-01    y                       1           3   0.8216184
#10 2013-01-02    y                       2           4   1.4127324
#11 2013-01-03    y                       2          10   2.1861214
#12 2013-01-04    y                       6          12   1.7145890
#13 2013-01-05    y                      11          13   1.1295363
#14 2013-01-06    y                      12          14   1.1706535

现在您创建了 items_bought、newCol1 和 newCol2 列的条件总和。您还可以省略 dplyr 链中的任何总和，或添加更多列进行总和。

在 OP 评论后编辑#2：

要计算每个用户购买的不同（唯一）商品的累积总和，您可以定义第二个自定义函数 myfunc2 并在 dplyr 链中使用它。此函数与myfunc 一样灵活，因此您可以定义要应用该函数的列。

代码将是：

myfunc <- function(x, colname){
  with(x, sapply(event_number, function(y) 
    sum(x[event_number <= event_number[y] & date[y] - date <= 2, colname])))
}

myfunc2 <- function(x, colname){
  cumsum(sapply(seq_along(x[[colname]]), function(y) 
    ifelse(!y == 1 & x[y, colname] %in% x[1:(y-1), colname], 0, 1)))
}

require(dplyr)                 #install and load into your library

dd %>%
  mutate(date = as.Date(as.character(date))) %>%
  group_by(user) %>%
  do(data.frame(., cum_items_bought_3_days = myfunc(., "items_bought"),
                   newCol1Sums = myfunc(., "newCol1"),
                   newCol2Sums = myfunc(., "newCol2"),
                   distinct_items_bought = myfunc2(., "items_bought"))) %>%   
  select(-c(items_bought, event_number, newCol1, newCol2))

这是我使用的数据：

dput(df)
structure(list(date = structure(c(1L, 2L, 3L, 4L, 4L, 4L, 5L, 
6L, 1L, 2L, 3L, 4L, 5L, 6L), .Label = c("2013-01-01", "2013-01-02", 
"2013-01-03", "2013-01-04", "2013-01-05", "2013-01-06"), class = "factor"), 
user = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"), 
items_bought = c(2L, 1L, 0L, 0L, 1L, 2L, 3L, 1L, 1L, 1L, 
0L, 5L, 6L, 1L), event_number = c(1L, 2L, 3L, 4L, 5L, 6L, 
7L, 8L, 1L, 2L, 3L, 4L, 5L, 6L), newCol1 = c(6L, 1L, 7L, 
10L, 5L, 10L, 7L, 3L, 3L, 1L, 6L, 5L, 2L, 7L), newCol2 = c(0.687800094485283, 
0.640190769452602, 0.357885359786451, 0.10258499882184, 0.0977909218054265, 
0.182886255905032, 0.227903473889455, 0.0805241498164833, 
0.821618422167376, 0.591113976901397, 0.773389018839225, 
0.350085976999253, 0.00606132275424898, 0.814506222726777
)), .Names = c("date", "user", "items_bought", "event_number", 
"newCol1", "newCol2"), row.names = c(NA, -14L), class = "data.frame")

Answer 2

我想提出一个额外的data.table 方法结合zoo 包rollapplyr 函数

首先，我们将聚合 items_bought 列每个 user 每个唯一 date（正如您指出的，每个用户可能有多个唯一日期）

library(data.table)
data <- setDT(data)[, lapply(.SD, sum), by = c("user", "date"), .SDcols = "items_bought"]

接下来，我们将计算rollapplyr 与sum 和partial = TRUE 相结合，以便在3 天的间隔内弥补利润（感谢@G. Grothendieck 的建议）

library(zoo)
data[, cum_items_bought_3_days := lapply(.SD, rollapplyr, 3, sum, partial = TRUE), .SDcols = "items_bought", by = user]

#     user       date items_bought cum_items_bought_3_days
#  1:    x 2013-01-01            2                       2
#  2:    x 2013-01-02            1                       3
#  3:    x 2013-01-03            0                       3
#  4:    x 2013-01-04            0                       1
#  5:    x 2013-01-05            3                       3
#  6:    x 2013-01-06            1                       4
#  7:    y 2013-01-01            1                       1
#  8:    y 2013-01-02            1                       2
#  9:    y 2013-01-03            0                       2
# 10:    y 2013-01-04            5                       6
# 11:    y 2013-01-05            6                      11
# 12:    y 2013-01-06            1                      12

这是我用过的数据集

data <- structure(list(date = structure(c(15706, 15707, 15708, 15709, 15710, 15711, 15706, 15707, 15708, 15709, 15710, 15711), class = "Date"), user = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"), items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L)), .Names = c("date", "user", "items_bought"), row.names = c(NA, -12L), class = "data.frame")

Answer 3

这是一个相当简单的方法：

# replicate your data, shifting the days ahead by your required window,
# and rbind into a single data frame
d <- do.call(rbind,lapply(0:2, function(x) transform(data,date=date+x)))

# use aggregate to add it together, subsetting out "future" days
aggregate(items_bought~date+user,subset(d,date<=max(data$date)),sum)
         date user items_bought
1  2013-01-01    x            2
2  2013-01-02    x            3
3  2013-01-03    x            3
4  2013-01-04    x            1
5  2013-01-05    x            3
6  2013-01-06    x            4
7  2013-01-01    y            1
8  2013-01-02    y            2
9  2013-01-03    y            2
10 2013-01-04    y            6
11 2013-01-05    y           11
12 2013-01-06    y           12

Answer 4

以下看起来有效：

unlist(lapply(split(data, data$user), 
              function(x) {
                 ave(x$items_bought, 
                 cumsum(c(0, diff(x$date)) >= 3), FUN = cumsum) 
              }))   
#x1  x2  x3  x4  y1  y2  y3  y4 
# 2   3   3   4   1   6   6   7

data:

data = structure(list(date = structure(c(15706, 15707, 15710, 15711, 
15706, 15707, 15710, 15711), class = "Date"), user = structure(c(1L, 
1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"), 
    items_bought = c(2L, 1L, 3L, 1L, 1L, 5L, 6L, 1L)), .Names = c("date", 
"user", "items_bought"), row.names = c(NA, -8L), class = "data.frame")

Answer 5

这是一种不使用 cumsum 而是使用嵌套 lapply 的方法。第一个遍历用户，然后对于每个用户，第二个 lapply 通过汇总每个日期最后 2 天内购买的所有项目来构建所需的数据框。请注意，如果 data$date 未排序，则必须先按升序排序。

data <- structure(list(
    date = structure(c(15706, 15707, 15708, 15709, 15710, 15711, 
        15706, 15707, 15708, 15709, 15710, 15711), class = "Date"), 
    user = c("x", "x", "x", "x", "x", "x", "y", "y", "y", "y", "y", "y"),
    items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L)),
    .Names = c("date", "user", "items_bought"),
    row.names = c(NA, -12L),
    class = "data.frame")

do.call(rbind, lapply(unique(data$user),
   function(u) {
       subd <- subset(data, user == u)
       do.call(rbind, lapply(subd$date, 
           function(x) data.frame(date = x, 
               user = u, items_bought = 
               sum(subd[subd$date %in% (x - 2):x, "items_bought"]))))
}))

编辑

为了解决每天有多个时间戳（每个日期超过 1 行）的问题，我首先会汇总同一天每个时间购买的所有商品。你可以这样做，例如使用内置函数aggregate，但如果您的数据太大，您也可以使用data.table 来提高速度。我将调用您的原始数据框（每个日期超过 1 行）predata 和汇总的数据框（每个日期 1 行）data。所以通过调用

predt <- data.table(predata)
setkey(predt, date, user)
data <- predt[, list(items_bought = sum(items_bought)), by = key(predt)]

您会得到一个数据框，其中包含每个日期一行和列 date、user、items_bought。现在，我认为以下方式会比上面嵌套的lapply 更快，但我不确定，因为我无法在您的数据上进行测试。我使用 data.table 是因为它的目的是快速（如果使用正确，我不确定是否如此）。内部循环将被函数f 替换。不知道有没有更简洁的方法，避免这个函数，只用一次调用data.table替换双循环，或者如何编写一个执行速度更快的data.table调用。

library(data.table)
dt <- data.table(data)
setkey(dt, user)
f <- function(d, u) {
    do.call(rbind, lapply(d$date, function(x) data.frame(date = x,
        items_bought = d[date %in% (x - 2):x, sum(items_bought)])))
}
data <- dt[, f(.SD, user), by = user]

另一种不使用 data.table 的方法，假设您有足够的 RAM（同样，我不知道您的数据大小），是将 1 天前购买的商品存储在向量中，然后存储商品2天前在另一个向量中购买，等等，最后总结一下。像

sumlist <- vector("list", 2) # this will hold one vector, which contains items 
    # bought 1 or 2 days ago
for (i in 1:2) {
    # tmpstr will be used to find the items that a given user bought i days ago
    tmpstr <- paste(data$date - i, data$user, sep = "|")
    tmpv <- data$items_bought[
        match(tmpstr, paste(data$date, data$user, sep = "|"))]
    # if a date is not in the original data, assume no purchases
    tmpv[is.na(tmpv)] <- 0
    sumlist[[i]] <- tmpv
}
# finally, add up items bought in the past as well as the present day
data$cum_items_bought_3_days <- 
    rowSums(as.data.frame(sumlist)) + data$items_bought

我会尝试的最后一件事是并行化 lapply 调用，例如改用函数mclapply，或使用foreach 或plyr 的并行功能重写代码。根据你PC的强度和任务的大小，这可能会优于data.table单核性能...

Answer 6

似乎包xts 和zoo 包含执行您想要的功能，尽管您的实际数据集的大小可能与@alexis_laz 答案相同。使用xts 对this question 的回答中的函数似乎可以解决问题。

首先，我从上面链接到的答案中获取了代码，并确保它仅适用于一个 user。我包含了 apply.daily 函数，因为我相信从您的编辑/cmets 中您对某些用户有几天的多次观察 - 我在玩具数据集中添加了一个额外的行来反映这一点。

# Make dataset with two observations for one date for "y" user
dat <- structure(list(
    date = structure(c(15706, 15707, 15708, 15709, 15710, 15711, 
        15706, 15707, 15708, 15709, 15710, 15711, 15711), class = "Date"), 
    user = c("x", "x", "x", "x", "x", "x", "y", "y", "y", "y", "y", "y", "y"),
    items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L, 0L)),
    .Names = c("date", "user", "items_bought"),
    row.names = c(NA, -13L),
    class = "data.frame")

# Load xts package (also loads zoo)
require(xts)

# See if this works for one user
dat1 = subset(dat, user == "y")
# Create "xts" object for use with apply.daily()
dat1.1 = xts(dat1$items_bought, dat1$date)
dat2 = apply.daily(dat1.1, sum)
# Now use rollapply with a 3-day window
# The "partial" argument appears to only work with zoo objects, not xts
sum.itemsbought = rollapply(zoo(dat2), 3, sum, align = "right", partial = TRUE)

我认为输出看起来会更好（更像是您问题的示例输出）。我没有经常使用zoo 对象，但this question 的答案给了我一些将信息放入data.frame 的指示。

data.frame(Date=time(sum.itemsbought), sum.itemsbought, row.names=NULL)

一旦我为一个 user 解决了这个问题，就可以直接将其扩展到整个玩具数据集。这就是速度可能成为问题的地方。这一步我使用lapply 和do.call。

allusers = lapply(unique(dat$user), function(x) {
    dat1 = dat[dat$user == x,]
    dat1.1 = xts(dat1$items_bought, dat1$date)
    dat2 = apply.daily(dat1.1, sum)
    sum.itemsbought = rollapply(zoo(dat2), 3, sum, align = "right", partial = TRUE)
    data.frame(Date=time(sum.itemsbought), user = x, sum.itemsbought, row.names=NULL)
} )
do.call(rbind, allusers)

Answer 7

我更喜欢 James 的回答，但这里有一个替代方案：

with(data,{
  sapply(split(data,user),function(x){
    sapply(x$date,function(y) sum(x$items_bought[x$date %in% c(y,y-1,y-2)]))
  })
})