使用R语言统计个体与当前组成员的历史共同组次数

我们有一份记录个体随时间加入不同组的数据集，个体有时会和旧成员同组，有时和新成员同组。需要创建变量NPrevKnown，统计每个个体在当前组中，与其他组成员在**更早的组（按时间顺序，不计未来组）**的共同组参与总次数。

示例输入数据 #

SampleData <- tribble(~ID, ~GROUP_NUM, ~Date,
               "abc", 22,"2022-01-15", 
               "def", 22,"2022-01-15", 
               "ghi", 22,"2022-01-15", 
               "jkl", 22,"2022-01-15", 
               "abc", 14,"2022-02-19", 
               "mno", 14,"2022-02-19", 
               "pqr", 14,"2022-02-19", 
               "stv", 14,"2022-02-19", 
               "abc", 18,"2022-05-11", 
               "stv", 18,"2022-05-11", 
               "wxy", 18,"2022-05-11", 
               "zzz", 18,"2022-05-11", 
               "abc", 35,"2022-10-06", 
               "def", 35,"2022-10-06", 
               "pqr", 35,"2022-10-06", 
               "bbb", 35,"2022-10-06", 
               "abc", 44,"2021-04-14", 
               "stv", 44,"2021-04-14", 
               "pqr", 44,"2021-04-14", 
               "bbb", 44,"2021-04-14")

期望输出数据 #

AimedData <- tribble(~ID, ~GROUP_NUM, ~Date, ~NPrevKnown,
                      "abc", 22,"2022-01-15", 0,
                      "def", 22,"2022-01-15", 0,
                      "ghi", 22,"2022-01-15", 0,
                      "jkl", 22,"2022-01-15", 0,
                      "abc", 14,"2022-02-19", 2,
                      "mno", 14,"2022-02-19", 0,
                      "pqr", 14,"2022-02-19", 2,
                      "stv", 14,"2022-02-19", 2,
                      "abc", 18,"2022-05-11", 2,
                      "stv", 18,"2022-05-11", 2,
                      "wxy", 18,"2022-05-11", 0,
                      "zzz", 18,"2022-05-11", 0,
                      "abc", 35,"2022-10-06", 4,
                      "def", 35,"2022-10-06", 1,
                      "pqr", 35,"2022-10-06", 3,
                      "bbb", 35,"2022-10-06", 2,
                      "abc", 44,"2021-04-14", 0,
                      "stv", 44,"2021-04-14", 0,
                      "pqr", 44,"2021-04-14", 0,
                      "bbb", 44,"2021-04-14", 0)

解决方案代码 #

library(tidyverse)

# 转换日期格式，确保时间排序准确
SampleData <- SampleData %>%
  mutate(Date = ymd(Date))

# 预先生成每个个体的历史组参与记录（当前日期之前的所有组）
individual_history <- SampleData %>%
  group_by(ID) %>%
  arrange(Date) %>%
  mutate(prev_groups = map(Date, ~filter(cur_data(), Date < .x) %>% pull(GROUP_NUM))) %>%
  ungroup()

# 构建成员历史组的查询表，避免重复计算
member_past_lookup <- individual_history %>%
  select(ID, Date, prev_groups) %>%
  rename(member_id = ID, member_date = Date, member_prev_groups = prev_groups)

# 计算每个个体的NPrevKnown
result <- SampleData %>%
  group_by(GROUP_NUM, Date) %>%
  mutate(group_members = list(ID)) %>%
  ungroup() %>%
  left_join(individual_history, by = c("ID", "GROUP_NUM", "Date")) %>%
  mutate(
    NPrevKnown = map2_dbl(group_members, prev_groups, function(members, current_past) {
      # 排除自身，只统计组内其他成员
      other_members <- setdiff(members, ID)
      # 统计每个其他成员与当前个体的共同历史组数量，再求和
      sum(map_int(other_members, function(mem) {
        mem_past <- member_past_lookup %>%
          filter(member_id == mem, member_date < !!cur_data()$Date) %>%
          pull(member_prev_groups) %>%
          flatten_int()
        length(intersect(current_past, mem_past))
      }))
    })
  ) %>%
  select(ID, GROUP_NUM, Date, NPrevKnown) %>%
  arrange(Date, GROUP_NUM, ID)

# 输出结果
result

代码说明 #

1. 日期转换：将Date列转为标准日期格式，保证时间排序的正确性。
2. 个体历史组记录：为每个个体生成截至当前日期之前参与过的所有组的列表，存储在prev_groups列。
3. 查询表构建：提前整理所有成员的历史组数据，避免重复查询，提升计算效率。
4. 共同组次数计算：对每个个体，遍历当前组的其他成员，统计每个成员与当前个体的共同历史组数量，求和后得到NPrevKnown。
5. 结果整理：选择目标列并按日期、组号、ID排序，输出与期望格式一致的结果。

内容的提问来源于stack exchange，提问作者iwuzborn