R 编码：创建复杂的条件摘要

Question

我有一个（缩减的）表格，其中包含以下与信用申请流程相关的信息：

1. 申请日期
2. 电子邮件地址

该表可以包含多次相同的电子邮件地址，但申请日期不同（可以假设同一个人多次申请）。

我想添加第三列，告诉我在申请日期之前的 90 天内，有多少其他申请使用相同的电子邮件地址。

我将如何在 R 中做到这一点？通过电子邮件地址创建摘要很简单，但添加 90 天条件对我来说是棘手的部分。

来自 SAS，我会按电子邮件地址对表格进行排序，然后使用延迟函数，但对 R 的任何帮助都会非常有帮助。

感谢阅读。

Answer 1

一个可重现的例子在这里会很有帮助，但如果没有它，这是我最好的选择。您所要求的可以通过多种方式完成。最简单的编程方法可能是对数据行使用 for 循环。

library(data.table)
library(lubridate)

set.seed(124)
emails <- 'None'
dates <- ymd('1900/01/01')
n_email = 500
for(i in seq_len(n_email)) {
  n <- rpois(1, 3) + 1
  d <- sample(seq(ymd('2018/01/01'), ymd('2019/09/01'), by = 'day'), n)
  emails <- c(emails, rep(as.character(i), n))
  dates <- c(dates, d)
}
dat <- data.table(emails, dates)
dat <- dat[order(emails, dates)]
dat[,counts := 0][]
#>       emails      dates counts
#>    1:      1 2018-06-16      0
#>    2:      1 2019-02-15      0
#>    3:     10 2018-09-08      0
#>    4:     10 2018-09-26      0
#>    5:     10 2019-02-05      0
#>   ---                         
#> 1942:     99 2018-07-03      0
#> 1943:     99 2018-07-07      0
#> 1944:     99 2019-02-07      0
#> 1945:     99 2019-04-09      0
#> 1946:   None 1900-01-01      0

for(i in 1:nrow(dat)) {
  diffs = difftime(dat[i,dates], dat[emails == dat[i,emails],dates], units = 'days')
  count = sum(diffs < 90 & diffs > 0)
  dat[i, counts := count]
}
dat[]
#>       emails      dates counts
#>    1:      1 2018-06-16      0
#>    2:      1 2019-02-15      0
#>    3:     10 2018-09-08      0
#>    4:     10 2018-09-26      1
#>    5:     10 2019-02-05      0
#>   ---                         
#> 1942:     99 2018-07-03      1
#> 1943:     99 2018-07-07      2
#> 1944:     99 2019-02-07      0
#> 1945:     99 2019-04-09      1
#> 1946:   None 1900-01-01      0
dat[emails %in% dat[counts > 3,emails]][order(emails, dates)]
#>     emails      dates counts
#>  1:    396 2018-05-27      0
#>  2:    396 2018-07-10      1
#>  3:    396 2018-10-02      1
#>  4:    396 2019-02-13      0
#>  5:    396 2019-04-21      1
#>  6:    396 2019-04-22      2
#>  7:    396 2019-04-27      3
#>  8:    396 2019-05-02      4
#>  9:    396 2019-06-13      4
#> 10:    496 2018-03-06      0
#> 11:    496 2019-01-31      0
#> 12:    496 2019-04-08      1
#> 13:    496 2019-06-10      1
#> 14:    496 2019-06-24      2
#> 15:    496 2019-07-11      2
#> 16:    496 2019-07-23      3
#> 17:    496 2019-08-25      4
#> 18:     56 2018-11-16      0
#> 19:     56 2019-02-27      0
#> 20:     56 2019-04-09      1
#> 21:     56 2019-04-13      2
#> 22:     56 2019-04-25      3
#> 23:     56 2019-05-13      4
#>     emails      dates counts

^{由reprex package (v0.3.0) 于 2019-09-18 创建}

但是，这里有一种更简洁、更有效的方法，同时更多地利用了 data.table 的功能。请注意，这种方式不需要预先排序

library(data.table)
library(lubridate)

set.seed(124)
emails <- 'None'
dates <- ymd('1900/01/01')
n_email = 500
for(i in seq_len(n_email)) {
  n <- rpois(1, 3) + 1
  d <- sample(seq(ymd('2018/01/01'), ymd('2019/09/01'), by = 'day'), n)
  emails <- c(emails, rep(as.character(i), n))
  dates <- c(dates, d)
}
dat <- data.table(emails, dates)
dat <- dat[sample(seq_len(nrow(dat)))]
dat
#>       emails      dates
#>    1:     70 2018-12-21
#>    2:    416 2018-10-02
#>    3:    289 2018-12-14
#>    4:     87 2018-03-02
#>    5:    441 2018-12-08
#>   ---                  
#> 1942:    365 2018-01-25
#> 1943:    200 2019-02-02
#> 1944:     14 2019-03-20
#> 1945:    166 2018-06-20
#> 1946:    161 2018-02-07
dat[order(dates), 
    counts := sapply(1:.N, FUN = function(i) {
        if(i == 1) return(0)
        x = c(0, diff(dates))
        days = 0
        place = i
        ret = 0
        while(days < 90 & place > 1) {
          if(x[place] + days < 90) ret = ret + 1
          days = days + x[place]
          place = place - 1
        }
        ret
      }),
    emails][order(emails, dates)]
#>       emails      dates counts
#>    1:      1 2018-06-16      0
#>    2:      1 2019-02-15      0
#>    3:     10 2018-09-08      0
#>    4:     10 2018-09-26      1
#>    5:     10 2019-02-05      0
#>   ---                         
#> 1942:     99 2018-07-03      1
#> 1943:     99 2018-07-07      2
#> 1944:     99 2019-02-07      0
#> 1945:     99 2019-04-09      1
#> 1946:   None 1900-01-01      0

dat[emails %in% dat[counts > 3,emails]][order(emails, dates)]
#>     emails      dates counts
#>  1:    396 2018-05-27      0
#>  2:    396 2018-07-10      1
#>  3:    396 2018-10-02      1
#>  4:    396 2019-02-13      0
#>  5:    396 2019-04-21      1
#>  6:    396 2019-04-22      2
#>  7:    396 2019-04-27      3
#>  8:    396 2019-05-02      4
#>  9:    396 2019-06-13      4
#> 10:    496 2018-03-06      0
#> 11:    496 2019-01-31      0
#> 12:    496 2019-04-08      1
#> 13:    496 2019-06-10      1
#> 14:    496 2019-06-24      2
#> 15:    496 2019-07-11      2
#> 16:    496 2019-07-23      3
#> 17:    496 2019-08-25      4
#> 18:     56 2018-11-16      0
#> 19:     56 2019-02-27      0
#> 20:     56 2019-04-09      1
#> 21:     56 2019-04-13      2
#> 22:     56 2019-04-25      3
#> 23:     56 2019-05-13      4
#>     emails      dates counts

^{由reprex package (v0.3.0) 于 2019 年 9 月 18 日创建}