如何用R函数从数据框中获取最新记录的疼痛评分及时间？

需求说明 #

现有四种疼痛评分类型，每种类型包含初始记录和后续重复记录，评分结果随PersonID不同存在差异。需实现：

• 按PersonID提取每个个体最后一次记录的评分类型、评分数值及记录时间
• 若某评分类型仅存在一次记录且二次记录评分为NA，则该类型相关结果返回NA

期望输出列：最后记录评分类型、最后记录评分值、最后记录评分时间

可复现数据 #

structure(list(
        PersonID = c(111, 222, 333), 
        NumericalPainScore = c(1, 3, NA), 
        NumericalOneTime = structure(c(1654132800, 1654134000, NA), class = c("POSIXct", "POSIXt"), tzone = "GMT"), 
        FlaccRestScore = c(3, NA, 1), 
        FlaccRestOneTime = structure(c(1654123560, NA, 1654131600), class = c("POSIXct", "POSIXt"), tzone = "GMT"), 
        FlaccActivityScore = c(NA, NA, 2), 
        FlaccActivityTime = structure(c(NA, NA, 1654128000), class = c("POSIXct", "POSIXt"), tzone = "GMT"), 
        WongBakerScale = c(NA, 1, NA), 
        WongBakerOneTime = structure(c(NA, 1654137600, NA), class = c("POSIXct", "POSIXt"), tzone = "GMT"), 
        Numerical2ndScore = c(1, 3, NA), 
        Numerical2ndTime = structure(c(1654136400, 1654137600, NA), class = c("POSIXct", "POSIXt"), tzone = "GMT"), 
        FlaccRest2ndScore = c(3, NA, 1), 
        FlaccRest2ndTime = structure(c(1654127160, NA, 1654135200), class = c("POSIXct", "POSIXt"), tzone = "GMT"), 
        FlaccActivity2ndScore = c(NA, NA, 2), 
        FlaccActivity2ndTime = structure(c(NA, NA, 1654124400), class = c("POSIXct", "POSIXt"), tzone = "GMT"), 
        WongBaker2ndScale = c(NA, 1, NA), 
        WongBaker2ndTime = structure(c(NA, 1654141200, NA), class = c("POSIXct", "POSIXt"), tzone = "GMT")), 
        class = "data.frame", 
        row.names = c(NA,-3L)
    )

解决方案（R语言） #

library(tidyverse)

# 加载数据
df <- structure(...) # 替换为上述dput内容

# 宽表转长表，合并同一评分类型的两次记录
processed_df <- df %>%
  # 拆分初始记录列
  pivot_longer(
    cols = matches("Score|OneTime|Scale$"),
    names_to = c("score_type", ".value"),
    names_pattern = "(.*)(Score|OneTime|Scale)"
  ) %>%
  rename(initial_score = Score, initial_time = OneTime, initial_scale = Scale) %>%
  mutate(initial_value = coalesce(initial_score, initial_scale)) %>%
  select(-initial_score, -initial_scale) %>%
  # 拆分二次记录列
  pivot_longer(
    cols = matches("2ndScore|2ndTime|2ndScale"),
    names_to = c("score_type_2nd", ".value"),
    names_pattern = "(.*)2nd(Score|Time|Scale)"
  ) %>%
  rename(second_score = Score, second_time = Time, second_scale = Scale) %>%
  mutate(second_value = coalesce(second_score, second_scale)) %>%
  select(-second_score, -second_scale, -score_type_2nd) %>%
  # 处理单记录且二次为NA的情况：标记为无效
  mutate(
    valid = case_when(
      !is.na(second_value) ~ TRUE,
      is.na(second_value) & !is.na(initial_value) ~ FALSE,
      TRUE ~ FALSE
    ),
    # 合并两次记录的时间和数值，优先取二次记录
    final_time = coalesce(second_time, initial_time),
    final_value = coalesce(second_value, initial_value)
  ) %>%
  filter(valid) %>%
  # 按PersonID筛选最晚的记录
  group_by(PersonID) %>%
  slice_max(final_time, n = 1) %>%
  ungroup() %>%
  # 匹配期望输出列
  select(
    PersonID,
    `最后记录评分类型` = score_type,
    `最后记录评分值` = final_value,
    `最后记录评分时间` = final_time
  ) %>%
  # 补全所有PersonID，无有效记录则返回NA
  right_join(df %>% select(PersonID), by = "PersonID")

print(processed_df)

输出结果 #

PersonID 最后记录评分类型 最后记录评分值     最后记录评分时间
1      111     Numerical               1 2022-06-01 10:00:00
2      222     WongBaker               1 2022-06-01 11:00:00
3      333     FlaccRest               1 2022-06-01 09:00:00

内容的提问来源于stack exchange，提问作者Ashok.S