如何在单次data.table调用中实现分组多变量提取与日期计算？

原始数据 #

library(tidyverse)
library(data.table)
set.seed(1)
df <- data.frame(id = rep(letters[1:3], each = 3),
                 result = c("negative", "positive", "positive", "negative", "negative", "negative",
                            "positive", "negative", "positive"),
                 test_date = seq.Date(from = as.Date("01/01/1998", "%d/%m/%Y"), 
                                 to = as.Date("09/01/1998", "%d/%m/%Y"), by = "day"),
                 type = c("car", "truck", "bike", "wheel", "tyre", "lorry", "car", "bike", "wheel"),
                 colour = c("gre", "blu", "re", "dblu", "yel", "re", "ora", "ti", "bla"),
                 x1 = sample(letters, 9),
                 x2 = sample(letters, 9))

需求说明 #

按id分组后完成以下操作：

• 提取type、colour列的首行值
• 提取x1、x2列的末行值
• 提取首次出现result=="positive"对应的test_date；若分组内无positive结果，则取最后一次negative对应的test_date

dplyr实现参考 #

out_dplyr <- df %>% 
  group_by(id) %>% 
  summarise(across(c(type, colour), dplyr::first),
            across(c(x1, x2), dplyr::last),
            test_date = if (is.na(dplyr::first(test_date[result == "positive"])))
              dplyr::last(test_date[result == "negative"])
            else dplyr::first(test_date[result == "positive"])) %>% 
  ungroup()

运行结果：

#   id    type  colour x1    x2    test_date 
#   <chr> <chr> <chr>  <chr> <chr> <date>    
# 1 a     car   gre    g     j     1998-01-02
# 2 b     wheel dblu   k     x     1998-01-06
# 3 c     car   ora    w     o     1998-01-07

data.table正确实现 #

可以在单次分组调用中整合所有逻辑，利用data.table的分组特性直接计算每个字段：

df_dt <- data.table(df)
out_dt <- df_dt[, .(
  type = first(type),
  colour = first(colour),
  x1 = last(x1),
  x2 = last(x2),
  test_date = {
    pos_dates = test_date[result == "positive"]
    if (length(pos_dates) > 0) first(pos_dates) else last(test_date[result == "negative"])
  }
), by = id]

代码说明 #

• 用first()直接提取分组内type、colour的首行值，last()提取x1、x2的末行值
• 针对test_date，先筛选出分组内所有positive对应的日期，若存在则取第一个；否则取所有negative对应的日期的最后一个
• 所有逻辑在同一个by = id的分组调用中完成，无需拆分操作

运行结果：

id  type colour x1 x2  test_date
1:  a   car    gre  g  j 1998-01-02
2:  b wheel   dblu  k  x 1998-01-06
3:  c   car    ora  w  o 1998-01-07

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