R语言中基于分数列最小值提取对应年龄列值的实现方法

我的数据框包含15列：

• 受试者ID（subject_id）
• 7个记录不同时间点年龄的列（age1、age2……age7）
• 7个对应上述时间点的分数列（score1、score2……score7）

多数受试者仅拥有age1和score1的数据（仅完成单次测试），部分受试者存在多个时间点的测试数据。需要新增两列：

1. minScore：取score1至score7列中的最小值，忽略NA值；若所有分数均为NA，则该列值为NA
2. scoreAge：对应minScore所在时间点的受试者年龄，若对应年龄缺失则为NA；若所有分数均为NA，则该列值为NA

示例数据：

data <- structure(list(subject_id = c("191-11173897", "191-11561329", 
"191-11700002", "191-11857141", "191-11933910"), age1 = c(39, 
7, NA, NA, 16), age2 = c(36, NA, NA, NA, 37), age3 = c(9, NA, 
NA, NA, NA), age4 = c(NA_real_, NA_real_, NA_real_, NA_real_, 
NA_real_), age5 = c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_
), age6 = c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), 
age7 = c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_
), score1 = c(10.6, 12.1, 9.8, NA, 10.6), score2 = c(9.8, 
NA, NA, NA, 11), score3 = c(11.3, NA, NA, NA, NA), score4 = c(NA_real_, 
NA_real_, NA_real_, NA_real_, NA_real_), score5 = c(NA_real_, 
NA_real_, NA_real_, NA_real_, NA_real_), score6 = c(NA_real_, 
NA_real_, NA_real_, NA_real_, NA_real_), score7 = c(NA_real_, 
NA_real_, NA_real_, NA_real_, NA_real_)), row.names = c(NA, 
-5L), class = c("tbl_df", "tbl", "data.frame"))

以下提供两种基于tidyverse工具包的实现方法，可根据数据规模和个人习惯选择：

方法一：行处理（rowwise） #

适合数据量较小的场景，直接按行提取分数和年龄列进行计算：

library(tidyverse)

result <- data %>%
  rowwise(subject_id) %>%
  # 将每行的分数、年龄分别打包为列表
  mutate(
    score_list = list(c_across(starts_with("score"))),
    age_list = list(c_across(starts_with("age")))
  ) %>%
  ungroup() %>%
  # 计算minScore和对应的scoreAge
  mutate(
    minScore = map_dbl(score_list, ~if (all(is.na(.x))) NA else min(.x, na.rm = TRUE)),
    # 找到最低分的位置，若有多个相同最低分则取第一个出现的
    min_pos = map_int(score_list, ~if (all(is.na(.x))) NA else which.min(.x)),
    scoreAge = map2_dbl(age_list, min_pos, ~ifelse(is.na(.x[.y]) | is.na(.y), NA, .x[.y]))
  ) %>%
  # 移除中间辅助列
  select(-score_list, -age_list, -min_pos)

print(result)

方法二：宽转长再合并 #

逻辑更清晰，适合数据量较大的场景，通过重塑数据结构来匹配分数和年龄：

library(tidyverse)

# 将宽格式数据转为长格式，匹配每个时间点的年龄和分数
long_data <- data %>%
  pivot_longer(
    cols = -subject_id,
    names_to = c(".value", "time"),
    names_pattern = "(age|score)(\\d+)"
  )

# 按受试者分组，筛选出最低分对应的记录（多个相同最低分取第一个）
min_score_info <- long_data %>%
  group_by(subject_id) %>%
  filter(score == min(score, na.rm = TRUE)) %>%
  slice(1) %>%
  select(subject_id, minScore = score, scoreAge = age) %>%
  # 处理所有分数均为NA的情况
  mutate(
    minScore = ifelse(is.infinite(minScore), NA, minScore),
    scoreAge = ifelse(is.na(minScore), NA, scoreAge)
  ) %>%
  ungroup()

# 将结果合并回原数据框
result <- data %>%
  left_join(min_score_info, by = "subject_id")

print(result)

两种方法运行后，都会得到包含新增minScore和scoreAge列的结果数据框，其中示例数据的输出结果如下（以方法二为例）：

# A tibble: 5 × 17
  subject_id    age1  age2  age3  age4  age5  age6  age7 score1 score2 score3 score4 score5 score6 score7 minScore scoreAge
  <chr>        <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>    <dbl>    <dbl>
1 191-11173897    39    36     9    NA    NA    NA    NA   10.6    9.8   11.3     NA     NA     NA     NA      9.8       36
2 191-11561329     7    NA    NA    NA    NA    NA    NA   12.1     NA     NA     NA     NA     NA     NA     12.1        7
3 191-11700002    NA    NA    NA    NA    NA    NA    NA    9.8     NA     NA     NA     NA     NA     NA      9.8       NA
4 191-11857141    NA    NA    NA    NA    NA    NA    NA    NA     NA     NA     NA     NA     NA     NA     NA         NA
5 191-11933910    16    37    NA    NA    NA    NA    NA   10.6   11       NA     NA     NA     NA     NA     10.6       16

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