总结下周客户的所有访问

sum all visits by customer in the next week

我需要计算未来 7 天内特定客户的访问次数。我用 purrr:map2 解决了这个问题,但我遇到了非常慢的性能。我想我一定遗漏了一些关于如何使用 purrr 的基本知识。我该如何加快速度?谢谢

这个玩具示例处理 100 行需要 2.3 秒,但在我的机器上处理 1000 行需要 3.3 分钟。我的实际数据有 400K 行!

library(tidyverse)
set.seed(123)
rows <- 1000
df= data.frame(cust_num = sample(c("123","124","128"),rows,replace=T), 
               date = sample(seq(as.Date('2017/01/01'), as.Date('2017/01/31'), by="day"), rows, replace=T))

df <- df %>%
  rowwise() %>%
  mutate( visits.next.7.days = map2_lgl(df$cust_num,df$date,~.x==cust_num&.y>date&.y<(date+7)) %>% sum() )

使用 zoo 包的解决方案。思路是按cust_numdate对数据进行分组,先统计行号,然后用lead函数将计数值平移1,用rollapply计算接下来六天的总和(不包括开始日期)。最后,使用 left_join 将结果合并回原始数据框。这应该比您原来的方法快得多。 df3 是最终输出。

library(dplyr)
library(zoo)
df2 <- df %>%
  count(cust_num, date) %>%
  ungroup() %>%
  mutate(n2 = lead(n)) %>%
  mutate(visits.next.7.days = rollapply(n2, width = 6, FUN = sum, na.rm = TRUE, 
                                        align = "left", partial = TRUE)) %>%
  select(cust_num, date, visits.next.7.days)


df3 <- df %>% left_join(df2, by = c("cust_num", "date"))

head(df3)
#   cust_num       date visits.next.7.days
# 1      123 2017-01-09                 70
# 2      128 2017-01-19                 54
# 3      124 2017-01-05                 58
# 4      128 2017-01-27                 37
# 5      128 2017-01-27                 37
# 6      123 2017-01-15                 68

这是一个选项,它使用 purrr::reducedata.table::shiftlead/lag 的矢量化版本)返回的向量列表求和。如果您愿意,pmap_intsum 的效果与 reduce+ 的效果相同,但速度稍慢。您可以类似地执行 map(1:7, ~lead(n, .x, default = 0L)) 而不是 data.table::shift,但它的代码更多且速度更慢。

library(tidyverse)
set.seed(123)
rows <- 1000
df = data.frame(cust_num = sample(c("123","124","128"), rows, replace = TRUE), 
                date = sample(seq(as.Date('2017/01/01'), 
                                  as.Date('2017/01/31'), 
                                  by = "day"), 
                              rows, replace = TRUE))

df2 <- df %>% 
    count(cust_num, date) %>%
    group_by(cust_num) %>% 
    # add dates with no occurrences; none in sample data, but quite possible in real
    complete(date = seq(min(date), max(date), by = 'day'), fill = list(n = 0L)) %>% 
    mutate(visits_next_7 = reduce(data.table::shift(n, 1:7, type = 'lead', fill = 0L), `+`)) %>% 
    right_join(df)

df2
#> # A tibble: 1,000 x 4
#> # Groups:   cust_num [?]
#>    cust_num       date     n visits_next_7
#>      <fctr>     <date> <int>         <int>
#>  1      123 2017-01-09    10            78
#>  2      128 2017-01-19    12            70
#>  3      124 2017-01-05    15            73
#>  4      128 2017-01-27    14            37
#>  5      128 2017-01-27    14            37
#>  6      123 2017-01-15    19            74
#>  7      124 2017-01-24    12            59
#>  8      128 2017-01-10    10            78
#>  9      124 2017-01-03    19            77
#> 10      124 2017-01-14     8            84
#> # ... with 990 more rows

这可能不是最有效的算法,因为根据您的数据间距,complete 可能会显着扩展您的数据。

此外,对于这种大小的数据,您可能会发现 data.table 更实用,除非您想将数据放入数据库并使用 dplyr 访问它。