2

Say I have data that looks like

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

to get the cumulative sum per user per data point I was doing 

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

output from this looks like

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

However I want to restrict my sum to only add up those that happened within 3 days of each row (relative to the user). i.e. the output needs to look like this:

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
4

7 回答 7

6

这是一个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

在我的回答中，我myfunc在dplyr链中使用了自定义函数。这是使用do操作符 from完成的dplyr。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总和。您还可以省略 dplyr 链中的任何总和，或添加更多列进行总和。newCol1newCol2

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")
于 2014-06-10T21:18:49.863 回答
3

我想提出一种data.table结合zoo包rollapplyr功能的附加方法

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

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

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

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")
于 2014-06-08T12:58:29.813 回答
2

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

# 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
于 2014-06-06T13:25:24.043 回答
1

I like James' answer better, but here's an alternative:

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)]))
  })
})
于 2014-06-07T19:44:27.040 回答
1

这是一种不使用 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)]

您会得到一个数据框，其中每个日期包含一行，列日期、用户、项目_购买。现在，我认为以下方式会比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调用，例如通过使用该函数，或者通过使用ormclapply的并行功能重写代码 。根据您的 PC 的强度和任务的大小，这可能会优于 data.table 单核性能...foreachplyr

于 2014-06-06T10:25:46.637 回答
1

尽管您的实际数据集的大小可能与@alexis_laz 答案相同，但它看起来像是包xts并包含可以执行您想要的功能。zoo使用这个问题xts的答案中的函数似乎可以解决问题。

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

# 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的答案给了我一些将信息放入.data.frame

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

一旦我解决了这个问题user，就可以直接将其扩展到整个玩具数据集。这就是速度可能成为问题的地方。我使用lapplyanddo.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)
于 2014-06-06T17:25:42.633 回答
1

以下看起来有效：

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")
于 2014-06-03T17:57:40.973 回答