基于Tidyverse的二分类参数一致性评估方法求助

现有如下结构的DataFrame：

my_df <- structure(
  list(
    a = c(1, 1, 1, 2, 2, 2, 3, 3), 
    b = c('M1', 'M2', 'M3', 'M1', 'M2', 'M3', 'M1', 'M3'), 
    c = c(0, 0, 0, 1, 1, 0, 1, 1)
  ), 
  .Names = c("ID", "METHOD", "RESULT"), 
  row.names = c(NA, 8L), 
  class = "data.frame"
)

其中包含3种检测方法（M1、M2、M3）、3个个体（个体3仅记录了M1和M3的结果），检测结果为0（阴性）和1（阳性）。

需要生成如下格式的交叉关联矩阵，用来展示某一方法的结果与其他方法结果的一致性：

矩阵内容需包含：

• 百分比：例如M1阳性时，M3也为阳性的比例
• 绝对数值：格式为(符合数量/总样本数)，例如M1阳性样本中，M3阳性的数量/总M1阳性样本数

希望用Tidyverse的通用方法实现，避免繁琐的ifelse/case_when操作。

步骤1：转换为宽格式数据 #

先把长格式数据转为宽格式，每个ID对应一行，各方法的结果作为列：

library(tidyverse)

wide_df <- my_df %>%
  pivot_wider(
    id_cols = ID,
    names_from = METHOD,
    values_from = RESULT,
    values_fill = NA  # 缺失的方法结果用NA填充
  )

转换后的数据：

# A tibble: 3 × 4
     ID    M1    M2    M3
  <dbl> <dbl> <dbl> <dbl>
1     1     0     0     0
2     2     1     1     0
3     3     1    NA     1

步骤2：生成条件与目标组合 #

自动生成所有方法的正负条件，以及所有方法的正负目标列：

# 获取所有方法名称
methods <- unique(my_df$METHOD)

# 生成所有条件标签（如"if M1 positive"）
condition_list <- expand_grid(
  condition_method = methods,
  condition_result = c(1, 0)
) %>%
  mutate(
    condition_label = str_glue("if {condition_method} {ifelse(condition_result == 1, 'positive', 'negative')}")
  )

# 生成所有目标列标签（如"M1 positive"）
target_list <- expand_grid(
  target_method = methods,
  target_result = c(1, 0)
) %>%
  mutate(
    target_label = str_glue("{target_method} {ifelse(target_result == 1, 'positive', 'negative')}")
  )

步骤3：计算交叉统计值 #

通过map函数批量计算每个条件对应的目标结果占比和样本数：

result_df <- condition_list %>%
  mutate(
    stats = map2(condition_method, condition_result, ~{
      # 筛选符合当前条件的有效样本（排除该方法结果缺失的ID）
      filtered_ids <- wide_df %>%
        filter(!is.na(!!sym(.x)) & !!sym(.x) == .y) %>%
        pull(ID)
      total_samples <- length(filtered_ids)
      
      # 对每个目标计算统计值
      target_list %>%
        mutate(
          match_count = map2_dbl(target_method, target_result, ~{
            wide_df %>%
              filter(ID %in% filtered_ids & !is.na(!!sym(.x)) & !!sym(.x) == .y) %>%
              nrow()
          }),
          percentage = ifelse(total_samples == 0, 0, round(match_count / total_samples * 100, 1)),
          # 对条件与目标为同一方法的情况加粗显示
          display_text = case_when(
            .x == target_method & .y == target_result ~ str_glue("**{percentage}% ({match_count}/{total_samples})**"),
            .x == target_method & .y != target_result ~ str_glue("**{percentage}% ({match_count}/{total_samples})**"),
            TRUE ~ str_glue("{percentage}% ({match_count}/{total_samples})")
          )
        ) %>%
        select(target_label, display_text) %>%
        pivot_wider(names_from = target_label, values_from = display_text)
    })
  ) %>%
  select(condition_label, stats) %>%
  unnest(stats)

最终结果 #

运行代码后，result_df即为目标交叉矩阵：

print(result_df)

输出示例：

说明 #

• 该方法是通用的，新增检测方法时无需修改核心逻辑，只需保证原始数据结构一致即可
• 自动排除某方法结果缺失的样本，避免无效统计
• 百分比保留1位小数，可通过修改round()参数调整精度

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