基于时间区间识别唯一行并按出现情况评分的R语言实现求助

示例输入数据 #

先定义符合需求的示例输入数据框：

library(tibble)
df <- tibble(
  IDcol = c(1,1,1,2,2,3,3,4,4,5,5),
  Result = c("N1", "N2", "N4", "N1", "N4", "N2", "N4", "N1", "N2", "N1", "N4"),
  Date = as.Date(c("2022-01-01", "2022-02-01", "2021-03-01", 
                   "2023-05-01", "2022-06-01", "2021-10-01", 
                   "2020-08-01", "2022-03-01", "2022-03-01",
                   "2020-01-01", "2021-05-01"))
)

修正后的dplyr处理代码 #

library(dplyr)
library(lubridate)

processed_df <- df %>%
  # 确保日期格式为Date类型
  mutate(Date = as.Date(Date)) %>%
  group_by(IDcol) %>%
  # 计算每个ID下N1/N2的最早测量日期
  mutate(earliest_N1N2 = min(Date[Result %in% c("N1", "N2")], na.rm = TRUE)) %>%
  # 判断N4是否在N1/N2最早日期的前1年内
  mutate(n4_valid = Result == "N4" & Date >= earliest_N1N2 - years(1) & Date <= earliest_N1N2) %>%
  # 按规则打分：N4有效得3分，N1/N2最早得2分，其余0分
  mutate(score = case_when(
    n4_valid ~ 3,
    Result %in% c("N1", "N2") & Date == earliest_N1N2 ~ 2,
    TRUE ~ 0
  )) %>%
  # 筛选每个ID下得分最高的行（得分相同则全部保留）
  filter(score == max(score, na.rm = TRUE)) %>%
  # 剔除无有效得分的ID（如日期差异过大的ID5）
  filter(score > 0) %>%
  # 清理临时辅助列
  select(-earliest_N1N2, -n4_valid) %>%
  ungroup()

代码关键逻辑说明 #

• N1/N2最早日期计算：通过min(Date[Result %in% c("N1", "N2")])精准定位每个ID下目标类别的最早测量时间，na.rm=TRUE避免无N1/N2的ID触发报错。
• N4有效性判断：用lubridate::years(1)处理跨年度的日期差，确保1年周期计算准确（含闰年），判断N4是否落在N1/N2最早日期的前1年内。
• 优先级筛选：通过打分机制明确优先级（3分>N1/N2的2分），保留每个ID下得分最高的行；若得分相同（如同一ID多个N1/N2在同一天测量），则全部保留。
• 无效ID剔除：通过filter(score > 0)直接移除无有效行的ID（如示例中的ID5，N4与N1日期差超过1年，无符合条件的行）。

示例输出结果 #

# # A tibble: 5 × 3
#   IDcol Result Date      
#   <dbl> <chr>  <date>    
# 1     1 N4     2021-03-01
# 2     2 N4     2022-06-01
# 3     3 N2     2021-10-01
# 4     4 N1     2022-03-01
# 5     4 N2     2022-03-01

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