基于相同cpx与参数列，将data中低于lim阈值的值替换为NA

数据准备 #

有两个衍生自原始数据的数据框：

阈值数据框 lim #

lim <- structure(list(cpx = c("A", "B", "C", "D"), par_1 = c(5, 10, 
5, 1), par_2 = c(KET = 4.34, HNK = 8.68, NKT = 4.3, DHNK = 0.86
), par_3 = c(KET = 18.24, HNK = 36.21, NKT = 19.22, DHNK = 3.87
)), out.attrs = list(dim = c(4L, 2L), dimnames = list(Var1 = c("Var1=HNK", 
"Var1=KET", "Var1=NKT", "Var1=DHNK"), Var2 = c("Var2=LLOQ", "Var2=ULOQ"
))), class = "data.frame", row.names = c(NA, -4L))

测量数据框 data #

data <- structure(list(smp_id = c("aa", "aa", "aa", "aa", "bb", "bb", 
"bb", "bb", "cc", "cc", "cc", "cc", "dd", "dd", "dd", "dd", "ee", 
"ee", "ee", "ee"), cpx = c("A", "B", "C", "D", "A", "B", "C", 
"D", "A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D"
), par_1 = c(4, 8, 4, 4, 4.5, 83, 6, 0.5, 5.5, 9, 4.5, 0.5, 20, 
13, 18, 0.5, 100, 33, 53, 0.5), par_2 = c(4, 4, 4, 4, 4.5, 3, 
3, 0.5, 5.5, 3, 3, 0.5, 20, 3, 3, 0.5, 100, 3, 3, 0.5), par_3 = c(4, 
4, 4, 0.4, 4.5, 3, 3, 0.9, 5.5, 3, 3, 2, 20, 3, 3, 4, 100, 3, 
3, 44)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-20L))

需求说明 #

需要将data中所有低于lim对应cpx/参数对阈值的值替换为NA。要求：

• 适配任意数量的par_*参数列（参数列数量随数据集变化）
• 避免使用循环，采用更优雅的dplyr实现方式

已尝试的方法 #

单个cpx的处理（可行） #

limm_a <- lim %>% 
  filter(cpx == "A")

data_a <- data %>% 
  filter(cpx == "A") %>%
  mutate(across(matches("par"),
                ~if_else(.x < limm_a[[cur_column()]], NA, .x)
                  ))

批量处理的失败尝试 #

写法1：

data <- data %>% 
  mutate(across(matches("par"),
                ~if_else(.x < limm[[cur_column()]][limm$cpx == data$cpx], NA, .x)
                  ))

写法2：

data <- data %>% 
  mutate(across(matches("par"),
                ~if_else(.x < filter(limm, cpx == .$cpx)[[cur_column()]], NA, .x)
                  ))

优雅解决方案 #

方法1：合并阈值列后批量处理（高效推荐） #

通过left_join将对应cpx的阈值匹配到data中，再逐个参数比较替换，最后清理临时列：

library(dplyr)

data_processed <- data %>%
  # 合并lim的阈值数据，添加后缀区分原列和阈值列
  left_join(lim, by = "cpx", suffix = c("", "_thresh")) %>%
  # 遍历所有参数列，和对应阈值比较
  mutate(
    across(matches("^par_\\d+$"), 
           ~if_else(.x < get(paste0(cur_column(), "_thresh")), NA_real_, .x)
    )
  ) %>%
  # 删除临时的阈值列
  select(-ends_with("_thresh"))

方法2：按行匹配阈值（直观易懂） #

用rowwise()按行分组，每一行匹配对应cpx的阈值进行比较：

data_processed <- data %>%
  rowwise() %>%
  mutate(
    across(matches("par"),
           ~{
             # 获取当前行cpx对应的参数阈值
             thresh <- lim[lim$cpx == cpx, cur_column()]
             if_else(.x < thresh, NA_real_, .x)
           }
    )
  ) %>%
  ungroup()

两种方法均兼容任意数量的par_*列，无需修改代码即可适配不同数据集。

内容的提问来源于stack exchange，提问作者Radek Jaźwiec