R 日期范围/窗口内唯一值的条件计数答案

【问题标题】：R conditional count of unique value over date range/windowR 日期范围/窗口内唯一值的条件计数
【发布时间】：2021-10-31 06:09:18
【问题描述】：

在 R 中，如何计算在时间范围内满足条件的观察次数？具体来说，我想通过 country 在过去 8 个月内计算不同 id 的数量，但前提是 id 在这 8 个月内至少出现两次。因此，对于计数，id 出现 2 倍还是 100 倍都没有关系（分两步执行此操作可能更容易）。 NA 存在于 id 和 country 中。由于这可以通过其他方式解决，因此无需考虑这一点，但仍然有帮助。

我目前最好的尝试是，但没有考虑到限制（ID 在过去 8 个月中必须至少出现两次），而且我在查看 dates="2017-12-12" 时发现它的计数很奇怪，其中 desired_unrestricted 应该是根据我的计数等于 4 但代码给出了 2。

dt[, date := as.Date(date)][
  , totalids := sapply(date, 
   function(x) length(unique(id[between(date, x - lubridate::month(8), x)]))), 
   by = country]

数据

library(data.table)
library(lubridate)

ID    <- c("1","1","1","1","1","1","2","2","2","3","3",NA,"4")
Date <- c("2017-01-01","2017-01-01", "2017-01-05", "2017-05-01", "2017-05-01","2018-05-02","2017-01-01", "2017-01-05", "2017-05-01", "2017-05-01","2017-05-01","2017-12-12","2017-12-12" )
Value <- c(2,4,3,5,2,5,8,17,17,3,7,5,3)
Country <- c("UK","UK","US","US",NA,"US","UK","UK","US","US","US","US","US")
Desired <- c(1,1,0,2,NA,0,1,2,2,2,2,1,1)
Desired_unrestricted <- c(2,2,1,3,NA,1,2,2,3,3,3,4,4)

dt <- data.frame(id=ID, date=Date, value=Value, country=Country, desired_output=Desired, desired_unrestricted=Desired_unrestricted)
setDT(dt)

提前致谢。

【问题讨论】：

标签： r date data.table

【解决方案1】：

这个data.table-only 答案的动机是comment，

dt[, date := as.Date(date)] # if not already `Date`-class
dt[, date8 := do.call(c, lapply(dt$date, function(z) seq(z, length=2, by="-8 months")[2]))
  ][, results := dt[dt, on = .(country, date > date8, date <= date), 
                    length(Filter(function(z) z > 1, table(id))), by = .EACHI]$V1
  ][, date8 := NULL ]
#         id       date value country desired_output desired_unrestricted results
#     <char>     <Date> <num>  <char>          <num>                <num>   <int>
#  1:      1 2017-01-01     2      UK              1                    2       1
#  2:      1 2017-01-01     4      UK              1                    2       1
#  3:      1 2017-01-05     3      US              0                    1       0
#  4:      1 2017-05-01     5      US              1                    3       2
#  5:      1 2017-05-01     2    <NA>             NA                   NA       0
#  6:      1 2018-05-02     5      US              0                    1       0
#  7:      2 2017-01-01     8      UK              1                    2       1
#  8:      2 2017-01-05    17      UK              2                    2       2
#  9:      2 2017-05-01    17      US              1                    3       2
# 10:      3 2017-05-01     3      US              2                    3       2
# 11:      3 2017-05-01     7      US              2                    3       2
# 12:   <NA> 2017-12-12     5      US              2                    4       1
# 13:      4 2017-12-12     3      US              2                    4       1

要吸收很多东西。

快速演练：

“8 个月前”：
```
seq(z, length=2, by="-8 months")[2]
```
seq.Date（通过使用Date-class 第一个参数调用seq 来推断）从z（每行当前的date）开始，并产生一个长度为2 的序列，它们之间有8 个月。 seq 总是从第一个参数开始，所以length=1 不起作用（它只会返回z）； length=2 保证返回向量中的第二个值将是我们需要的“date 之前的 8 个月”。
日期减法：
```
[, date8 := do.call(c, lapply(dt$date, function(z) seq(...)[2])) ]
```
减去 8 个月的简单 base-R 方法是 seq(date, length=2, by="-8 months")[2]。 seq.Date 要求它的第一个参数是length-1，所以我们需要sapply 或lapply 它；不幸的是，sapply 放弃了课程，所以我们 lapply 它然后以编程方式 combine 它们与 do.call(c, ...) （因为 c(..) 创建一个列表列，而 unlist 将取消分类它）。（也许这部分可以改进。）

我们在dt first 中需要它，因为我们基于此值进行非 equi（基于范围）连接。
计数id 有 2 次或更多访问：
```
length(Filter(function(z) z > 1, table(id)))
```
我们生成一个table(id)，它为我们提供了加入周期内每个id 的计数。 Filter(fun, ...) 允许我们减少计数低于 2 的那些，并且我们留下了具有 2 次或更多访问的 ids 的命名向量。检索length 是我们所需要的。
自非等连接：
```
dt[dt, on = .(country, date > date8, date <= date), ... ]
```
相对直截了当。这是一个开放/封闭的范围，如果您愿意，可以将其更改为双封闭。
自非等连接但计数ids by-row:by=.EACHI。
检索结果并分配给原始dt：
```
[, results := dt[...]$V1 ]
```
由于非 equi 连接包含一个没有名称的值 (length(Filter(...)))，因此它被命名为 V1，而我们想要的就是这个。（老实说，我不知道为什么更直接地分配它不起作用......但计数都是错误的。也许它是倒退的逐行统计。）
清理：
```
[, date8 := NULL ]
```
（这里没什么特别的，只是适当的数据管理 :-)

我的计数与您的desired_output 有一些差异，我想知道这些是否只是 OP 中的拼写错误；我认为数学是正确的......

【讨论】：

很好的答案，谢谢！我首先有点担心，事实证明它显然只有在date 是日期格式时才有效：dt[, date := as.Date(date)]。数学（一如既往）是正确的，我更正了desired_output。
我还没有完全理解lapply(dt$date, function(z) seq(z, length=2, by="-8 months")[2] 部分。为什么是length=2，[2] 是做什么的？
是的，Date-class，我的假设，对不起。 seq.Date 返回具有特殊间隔的序列；如果我们使用seq.Date(..., length=1)，那么我们得到z不变，即"2017-01-01"; length=2`返回c("2017-01-01", "2016-05-01")，其中第二个元素是我们想要的。因此，我们使用seq(...)[2]。（我们调用seq，但因为第一个参数是Date-class，所以它在后台使用seq.Date。）希望能解释一下。很高兴它成功了！
lubridate 提供了执行date-months(8) 的能力，为什么要使用seq 技巧？
不是每个人都使用lubridate。

【解决方案2】：

这是另一种选择：

setkey(dt, country, date, id)
dt[, date := as.IDate(date)][, 
    eightmthsago := as.IDate(sapply(as.IDate(date), function(x) seq(x, by="-8 months", length.out=2L)[2L]))]

dt[, c("out", "out_unres") := 
    dt[dt, on=.(country, date>=eightmthsago, date<=date), 
        by=.EACHI, {
                v <- id[!is.na(id)]
                .(uniqueN(v[duplicated(v)]), uniqueN(v))
            }][,1L:3L := NULL]
]
dt

输出（如 r2evans，我也得到了与期望不同的输出，因为期望的输出似乎有误）：

      id       date value country desired_output desired_unrestricted eightmthsago out out_unres
 1:    1 2017-05-01     2    <NA>             NA                   NA   2016-09-01   0         1
 2:    1 2017-01-01     2      UK              1                    2   2016-05-01   1         2
 3:    1 2017-01-01     4      UK              1                    2   2016-05-01   1         2
 4:    2 2017-01-01     8      UK              1                    2   2016-05-01   1         2
 5:    2 2017-01-05    17      UK              2                    2   2016-05-05   2         2
 6:    1 2017-01-05     3      US              0                    1   2016-05-05   0         1
 7:    1 2017-05-01     5      US              1                    3   2016-09-01   2         3
 8:    2 2017-05-01    17      US              1                    3   2016-09-01   2         3
 9:    3 2017-05-01     3      US              2                    3   2016-09-01   2         3
10:    3 2017-05-01     7      US              2                    3   2016-09-01   2         3
11: <NA> 2017-12-12     5      US              2                    4   2017-04-12   1         4
12:    4 2017-12-12     3      US              2                    4   2017-04-12   1         4
13:    1 2018-05-02     5      US              0                    1   2017-09-02   0         2

【讨论】：

谢谢，也是很好的解决方案，也许更容易理解。您的输出是正确的，我编辑了 desired_output 向量以更正拼写错误。

【解决方案3】：

虽然这个问题被标记为data.table，但这里有一个dplyr::rowwise 解决问题的方法。这是你的想法吗？输出对我来说似乎有效：过去 8 个月中 ìds 的数量至少大于 2。

library(dplyr)
library(lubridate)

dt <- dt %>% mutate(date = as.Date(date))

dt %>% 
  group_by(country) %>% 
  group_modify(~ .x %>% 
  rowwise() %>% 
  mutate(totalids = .x %>%
           filter(date <= .env$date, date >= .env$date %m-% months(8)) %>% 
           pull(id) %>% 
           table() %>% 
           `[`(. >1) %>% 
           length
  )) 

#> # A tibble: 13 x 7
#> # Groups:   country [3]
#>    country id    date       value desired_output desired_unrestricted totalids
#>    <chr>   <chr> <date>     <dbl>          <dbl>                <dbl>    <int>
#>  1 UK      1     2017-01-01     2              1                    2        1
#>  2 UK      1     2017-01-01     4              1                    2        1
#>  3 UK      2     2017-01-01     8              1                    2        1
#>  4 UK      2     2017-01-05    17              2                    2        2
#>  5 US      1     2017-01-05     3              0                    1        0
#>  6 US      1     2017-05-01     5              1                    3        2
#>  7 US      1     2018-05-02     5              0                    1        0
#>  8 US      2     2017-05-01    17              1                    3        2
#>  9 US      3     2017-05-01     3              2                    3        2
#> 10 US      3     2017-05-01     7              2                    3        2
#> 11 US      <NA>  2017-12-12     5              2                    4        1
#> 12 US      4     2017-12-12     3              2                    4        1
#> 13 <NA>    1     2017-05-01     2             NA                   NA        0

^{由reprex package (v2.0.1) 于 2021-09-02 创建}

【讨论】：

谢谢，这也很好，输出确实有效。 data.table 似乎在这里有速度优势。
绝对是data.table 方法会快得多！ dplyr::rowwise 可读，但速度慢。