循环循环数据帧：如何提高循环的性能，该循环基于数据集的另一个循环计算结果答案

【问题标题】：Loop-through-loop-through dataframe: How to improve performance on loop that calculates the result based on another loop through the dataset循环循环数据帧：如何提高循环的性能，该循环基于数据集的另一个循环计算结果
【发布时间】：2019-09-28 09:43:24
【问题描述】：

我需要处理包含数百万个条目的庞大数据集，格式如下：

表格：访问次数

|----------------|--------------|------------|
|   PERSON_ID    |      DATE    |  #Clicks   |
|----------------|--------------|------------|
|          1     |  2017-05-04  |          4 |
|          1     |  2018-05-04  |          1 |
|          1     |  2016-02-04  |          5 |
|          1     |  2018-05-06  |          7 |
|          2     |  2018-05-04  |          8 |
|          2     |  2018-05-16  |          1 |
|          2     |  2018-01-04  |          1 |
|          2     |  2018-02-04  |          2 |
|          ...   |  ...         |        ... |
|----------------|--------------|------------|

我想统计每天的点击次数 + 之后的 30 天。

数据 N=2,000,000 人=15,000

遍历每个人大约需要 1 秒，这太慢了。任何关于如何调整代码的建议都将不胜感激。

我已经尝试使用 apply/lapply，但没有取得巨大成功。

代码示例：图书馆（润滑）；

#Initial Data Set
visits <- data.frame(person_id=c(1,1,1,1,2,2,2,2),
date=c(ymd("2017-05-04"),ymd("2018-05-04"),ymd("2016-02-04"),ymd("2018-05-06"),ymd("2018-05-04"),ymd("2018-05-16"),ymd("2018-01-04"),ymd("2018-02-04")),
clicks=c(4,1,5,7,8,1,1,2),
clicks_30days=0)

unique_visitors <- unique(visits$person_id)
#For Each Person
for(person_id in unique_visitors)
{
    #Subset person's records and order the, descending
    person_visits <- visits[visits$person_id == person_id,]
    person_visits <- person_visits[order(person_visits$date),]

    #For each visit count the # of clicks of the visit + all visits within visit's date + 30 days
    for(i in 1:nrow(person_visits))
    {
        search_interval <- interval( person_visits$date[i] , person_visits$date[i]+days(30)) 

        #####This is the interesting codeline#####
        calc_result <- sum(person_visits$clicks[person_visits$date %within% search_interval])** 
        ##########################################

        #save the clicks + 30 days
        visits[rownames(person_visits)[i],"clicks_30days"] <- calc_result
    }

}

真的非常感谢任何比这更快的东西。

【问题讨论】：

可能重复：stackoverflow.com/questions/46396417/…stackoverflow.com/questions/48434157/…
考虑使用data.table 包，看看是否能解决您的问题，对于这么小的数据集应该不会花很长时间

标签： r performance loops dataframe optimization

【解决方案1】：

使用非等连接的data.table 方法：

library(data.table)
setDT(visits)[, clicks_30days :=
    visits[.(person_id=person_id, start=date, end=date+30L),
        on=.(person_id, date>=start, date<=end), sum(clicks), by=.EACHI]$V1
]

输出：

   person_id       date clicks clicks_30days
1:         1 2017-05-04      4             4
2:         1 2018-05-04      1             8
3:         1 2016-02-04      5             5
4:         1 2018-05-06      7             7
5:         2 2018-05-04      8             9
6:         2 2018-05-16      1             1
7:         2 2018-01-04      1             1
8:         2 2018-02-04      2             2

计时码：

library(data.table)
set.seed(0L)
npers <- 15e3L
ndates <- 150L
visits <- data.frame(person_id=rep(1L:npers, each=ndates),
    date=sample(seq(Sys.Date()-5L*365L, Sys.Date(), by="1 day"), npers*ndates, TRUE),
    clicks=sample(10, npers*ndates, TRUE))
vi <- visits

mtd0 <- function() {
    visits$person_id <- as.integer(visits$person_id) # faster for integers
    unique_visitors <- unique(visits$person_id)
    # create columns as vectors (accessing elements in loop will be fast)
    r <- visits$clicks_30days2 <- 0 # result vector
    j <- 1L
    person_id <- visits$person_id
    CL <- visits$clicks
    DATE_as_int <- as.integer(visits$date) # convert dates to integers
    for (id in unique_visitors){
        x <- person_id == id # indicates current person
        dates <- DATE_as_int[x] # take dates of this person
        clicks <- CL[x] # clicks of this person
        for (i in 1:length(dates)) {
            i_date <- dates[i] # take i-th date
            ii <- i_date <= dates & dates <= i_date + 30 # test interval
            # r[x][i] <- sum(clicks[ii]) # sum
            r[j] <- sum(clicks[ii]) # faster using one index
            j <- j + 1L
        }
    }
    visits$clicks_30days2 <- r # assigne to results
    visits
}

mtd1 <- function() {
    setDT(vi)[, clicks_30days :=
        vi[.(person_id=person_id, start=date, end=date+30L),
            on=.(person_id, date>=start, date<=end), sum(clicks), by=.EACHI]$V1
    ]
}

library(microbenchmark)
microbenchmark(mtd0(), mtd1(), times=3L)

时间安排：

Unit: seconds
   expr        min         lq       mean     median         uq        max neval cld
 mtd0() 144.847468 145.339189 146.358507 145.830910 147.114026 148.397141     3   b
 mtd1()   2.367768   2.398254   2.445058   2.428741   2.483703   2.538665     3  a

【讨论】：

【解决方案2】：

您可以通过按person_id 分组来减少和简化代码，并计算每个clicks 在30 天内sum 的clicks。

library(tidyverse)

visits %>%
  group_by(person_id) %>%
  mutate(clicks_30days = map_dbl(date, ~sum(clicks[date >= . & 
                                            date <= (. + 30)])))

# Groups:   person_id [2]
#  person_id date       clicks clicks_30days
#      <dbl> <date>      <dbl>         <dbl>
#1         1 2017-05-04      4             4
#2         1 2018-05-04      1             8
#3         1 2016-02-04      5             5
#4         1 2018-05-06      7             7
#5         2 2018-05-04      8             9
#6         2 2018-05-16      1             1
#7         2 2018-01-04      1             1
#8         2 2018-02-04      2             2

【讨论】：

【解决方案3】：

# creation of interval for each row can be slow
# and this is not needed here

visits$person_id <- as.integer(visits$person_id) # faster for integers
unique_visitors <- unique(visits$person_id)
# create columns as vectors (accessing elements in loop will be fast)
r <- visits$clicks_30days2 <- 0 # result vector
j <- 1L
person_id <- visits$person_id
CL <- visits$clicks
DATE_as_int <- as.integer(visits$date) # convert dates to integers
for (id in unique_visitors){
  x <- person_id == id # indicates current person
  dates <- DATE_as_int[x] # take dates of this person
  clicks <- CL[x] # clicks of this person
  for (i in 1:length(dates)) {
    i_date <- dates[i] # take i-th date
    ii <- i_date <= dates & dates <= i_date + 30 # test interval
    # r[x][i] <- sum(clicks[ii]) # sum
    r[j] <- sum(clicks[ii]) # faster using one index
    j <- j + 1L
  }
}
visits$clicks_30days2 <- r # assigne to results
visits
#   person_id       date clicks clicks_30days clicks_30days2
# 1         1 2017-05-04      4             4              4
# 2         1 2018-05-04      1             8              8
# 3         1 2016-02-04      5             5              5
# 4         1 2018-05-06      7             7              7
# 5         2 2018-05-04      8             9              9
# 6         2 2018-05-16      1             1              1
# 7         2 2018-01-04      1             1              1
# 8         2 2018-02-04      2             2              2

一些时间安排：

# running on 280000 row data set:
visits2 <- visits2[order(visits2$person_id), ]
# data need to be sorted by person_id for my approach to yield correct results

system.time(rr <- minem(visits2)) # 4.50
system.time(rr2 <- ronak(visits2)) # 25.64

【讨论】：

@Parfait 未能获得正确的结果 + 56000 行数据集已经花费了 +/- 50 sek。
明白。什么是不正确的结果？请注意我按 person_id 和 date 对行重新排序？如果规格不同且不是完全 R 风格，您的解决方案会更快，但无疑更难阅读和维护！
@Parfait 似乎，如果一个客户有多个单一日期条目，您的方法会产生不同的结果。
感谢伙伴，这将我在性能测试中的计算时间从接近 1/10 减少了！

【解决方案4】：

考虑与vapply 的运行总和：

visits$date30 <- visits$date + 30
visits$person_id <- as.integer(visits$person_id)

visits$clicks_30days <- vapply(1:nrow(visits), function(i) 
                with(visits, sum(clicks[(person_id == person_id[i]) &
                                        (date >= date[i] & date <= date30[i])])),
                numeric(1))
visits
#   person_id       date clicks clicks_30days     date30
# 1         1 2017-05-04      4             4 2017-06-03
# 2         1 2018-05-04      1             8 2018-06-03
# 3         1 2016-02-04      5             5 2016-03-05
# 4         1 2018-05-06      7             7 2018-06-05
# 5         2 2018-05-04      8             9 2018-06-03
# 6         2 2018-05-16      1             1 2018-06-15
# 7         2 2018-01-04      1             1 2018-02-03
# 8         2 2018-02-04      2             2 2018-03-06

【讨论】：