计算R中特定过去时间长度内当前两个ID对的出现次数

Question

目的

我想在 R 中计算一个时间范围内每对两个 ID 的过去出现次数。

具体来说，在下面的示例数据集中，我有 10 个人在同一家公司工作。两名工人成对工作，他们可以在给定日期在不同房间一起工作零到多次。我想计算他们在每个观察日期的 6 个月时间范围内之前在房间里一起工作的次数（即，当数据从最早日期到最晚日期排序时，一对出现在当前日期前 6 个月内的房间？）

当前进展

另外，我用两种方法搜索后计算，发现方法1（ddply）生成了想要的输出，但是方法2（Data.Table）生成的输出不正确，但类似于想要的。因为方法 2 在我的原始数据集中进行大量观察所需的时间要少得多，所以我还想知道如何更正我的方法 2 代码。

最后提供了比较代码，以便您轻松比较两个输出。

感谢您的帮助。

数据集

  library(tidyverse)
  library(tibble)
  
  rename <- dplyr::rename
  select <- dplyr::select
  
  set.seed(10000)
  room <- sample(1:5, 1000, replace=T)
  
  set.seed(10001)
  agent <- sample(1:10, 1000, replace=T)
  
  set.seed(10000)
  partner <- sample(1:10, 1000, replace=T)
  
  set.seed(10000)
  date <- sample(seq(as.Date('1999/01/01'), as.Date('2000/01/01'), by="day"), 1000, replace=T)

  df <-
    data.frame(room, agent, partner, date) %>% 
    rowid_to_column %>% 
    rename(
      aid = agent,
      pid = partner,
      o3.room = room,
      o4.in = date,
      oid = rowid
    ) %>% 
    filter(aid != pid) %>% 
    arrange(o3.room, aid, pid, o4.in) %>%
    mutate(cases = 1) %>%  # for cumsum in t1
    mutate(o4.in_6mos = o4.in %m-% months(6))  # for t2

方法1 - ddply

  t1 <- 
    df %>% 
    ddply(c('aid', 'pid', 'o3.room'), function(i){
      i %>% 
        arrange(aid, pid, o3.room, o4.in) %>% 
        filter(o4.in > o4.in %m-% months(6)) %>% 
        mutate(j1.room = cumsum(cases)-1)
    }, .progress = 'text') %>% 
    select(oid, o4.in, o3.room, aid, pid, j1.room) %>% 
    arrange(o3.room, aid, pid, o4.in)  

方法2 - 数据表

我在 Stock Overflow 中修改了来自 a post 的答案。

  t2 <- 
    df %>% 
    select(oid, o3.room, o4.in) %>% 
    cbind(
      setDT(df)[df, .(j1.room = .N), 
                on = .(o3.room, aid, pid, o4.in < o4.in, o4.in > o4.in_6mos), 
                by = .EACHI] %>% 
        select(aid, pid, j1.room) 
    ) %>% 
    arrange(o3.room, aid, pid, o4.in) 

比较

  t_compare <- 
    t1 %>% 
    select(-o4.in) %>% 
    rename(j1.room1 = j1.room) %>% 
    left_join(
      t2 %>% rename(j1.room2 = j1.room),
      by = c('o3.room', 'aid', 'pid', 'oid')
    )  %>% 
    arrange(o3.room, aid, pid, o4.in) %>% 
    mutate(j3.room = ifelse(j1.room1 != j1.room2, 'non-match', '-')) %>% 
    mutate(j2.room = ifelse(j1.room1 != j1.room2, '0', '1'))

Answer 1

要对data.table 执行相同的步骤，您可以这样做，例如：

# used a different seed for `partner` to generate `df`

library(data.table)
library(lubridate)
ks <- c('aid', 'pid', 'o3.room')
DT <- data.table(df, key=ks)[
     o4.in > o4.in %m-% months(6)][, j1.room:=cumsum(cases)-1, by=ks][
         ,.(oid, o4.in, o3.room, aid, pid, j1.room)]
setorder(DT, o3.room, aid, pid, o4.in)[]

# check if you get the same result:
identical(DT, as.data.table(t1))