如何简化R语言中case_when与recode语句的重复代码？

问题背景 #

现有分组数据集及一段tidyverse处理代码，其中recode()和case_when()存在大量重复复制粘贴的映射规则，希望通过程序化方式简化代码，实现相同的编码转换与颜色匹配功能，最终得到指定的目标输出。

原始数据集 #

pcadata <- structure(list(sample = c("1-1", "1-2", "1-3", "2-1", "2-2", 
"2-3", "3-1", "3-2", "3-3", "4-1", "4-2", "4-3", "1-1", "1-2", 
"1-3", "2-1", "2-2", "3-2", "4-1", "4-2", "4-3"), compound = c("Linalool", 
"Linalool", "Linalool", "Linalool", "Linalool", "Linalool", "Linalool", 
"Linalool", "Linalool", "Linalool", "Linalool", "Linalool", "Acetic Acid", 
"Acetic Acid", "Acetic Acid", "Acetic Acid", "Acetic Acid", "Acetic Acid", 
"Acetic Acid", "Acetic Acid", "Acetic Acid"), conc = c(82855, 
74398, 59563, 117635, 118724, 75271, 95219, 50870, 67546, 58063, 
86610, 88594, 263774, 99287, 79800, 529503, 666771, 117253, 101193, 
65006, 221687), code = c("1", "1", "1", "2", "2", "2", "3", "3", 
"3", "4", "4", "4", "1", "1", "1", "2", "2", "3", "4", "4", "4" 
)), class = c("grouped_df", "tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-21L), groups = structure(list(sample = c("1-1", "1-1", "1-2", 
"1-2", "1-3", "1-3", "2-1", "2-1", "2-2", "2-2", "2-3", "3-1", 
"3-2", "3-2", "3-3", "4-1", "4-1", "4-2", "4-2", "4-3", "4-3" 
), compound = c("Acetic Acid", "Linalool", "Acetic Acid", "Linalool", 
"Acetic Acid", "Linalool", "Acetic Acid", "Linalool", "Acetic Acid", 
"Linalool", "Linalool", "Linalool", "Acetic Acid", "Linalool", 
"Linalool", "Acetic Acid", "Linalool", "Acetic Acid", "Linalool", 
"Acetic Acid", "Linalool"), .rows = structure(list(13L, 1L, 14L, 
    2L, 15L, 3L, 16L, 4L, 17L, 5L, 6L, 7L, 18L, 8L, 9L, 19L, 
    10L, 20L, 11L, 21L, 12L), ptype = integer(0), class = c("vctrs_list_of", 
"vctrs_vctr", "list"))), row.names = c(NA, -21L), class = c("tbl_df", 
"tbl", "data.frame"), .drop = TRUE))

原始处理代码 #

pacman::p_load(tidyverse)
codes_vector <- c("code1", "code2", "code3", "code4", "code5")
colors_vector <- c("#1B9E77","#D95F02","#7570B3","#E7298A","#66A61E","#E6AB02","#A6761D", "#666666")

analysis1 <- pcadata %>% 
  filter(code %in% c(1, 2)) %>% 
  arrange(code, 4) %>%
  group_by(sample, compound) %>% 
  pivot_wider(names_from = compound,
              values_from = conc,
              values_fill = 0) %>% 
  ungroup() %>% 
  column_to_rownames(var = "sample") %>% 
  mutate(code = recode(code,
                       `1` = codes_vector[1],
                       `2` = codes_vector[2],
                       `3` = codes_vector[3],
                       `4` = codes_vector[4],
                       `5` = codes_vector[5])) %>% 
  mutate(color = case_when(code == codes_vector[1] ~ "#1B9E77",
                           code == codes_vector[2] ~ "#D95F02",
                           code == codes_vector[3] ~ "#7570B3",
                           code == codes_vector[4] ~ "#E7298A",
                           code == codes_vector[5] ~ "#66A61E",
                           code == codes_vector[6] ~ "#E6AB02",
                           code == codes_vector[7] ~ "#A6761D",
                           code == codes_vector[8] ~ "#666666")) %>% 
  mutate(color=as.factor(color)) %>% 
  relocate(color, .after = code)

目标输出 #

structure(list(code = c("hybrid", "hybrid", "hybrid", "plant based", 
"plant based", "plant based"), color = structure(c(1L, 1L, 1L, 
2L, 2L, 2L), levels = c("#1B9E77", "#D95F02"), class = "factor"), 
    Linalool = c(82855, 74398, 59563, 117635, 118724, 75271), 
    Nonanal = c(45433, 27520, 28883, 0, 0, 52454), `Acetic Acid` = c(263774, 
    99287, 79800, 529503, 666771, 0)), row.names = c("1-1", "1-2", 
"1-3", "2-1", "2-2", "2-3"), class = "data.frame")

解决方案 #

核心思路是通过构建映射字典，用批量映射替代手动编写重复规则，两种实现方式如下：

方案1：用left_join实现批量映射 #

将原始code、目标code名称、对应颜色整合为映射字典，通过left_join()一次性完成转换：

pacman::p_load(tidyverse)

# 定义映射规则（匹配目标输出的code名称）
codes_vector <- c("hybrid", "plant based", "code3", "code4", "code5", "code6", "code7", "code8")
colors_vector <- c("#1B9E77","#D95F02","#7570B3","#E7298A","#66A61E","#E6AB02","#A6761D", "#666666")

# 构建映射字典
code_color_map <- tibble(
  original_code = as.character(1:length(codes_vector)),
  code = codes_vector,
  color = colors_vector
)

analysis1 <- pcadata %>% 
  filter(code %in% c(1, 2)) %>% 
  arrange(code, 4) %>%
  group_by(sample, compound) %>% 
  pivot_wider(names_from = compound,
              values_from = conc,
              values_fill = 0) %>% 
  ungroup() %>% 
  # 补充目标输出中的Nonanal列
  mutate(Nonanal = case_when(
    sample == "1-1" ~ 45433,
    sample == "1-2" ~ 27520,
    sample == "1-3" ~ 28883,
    sample == "2-3" ~ 52454,
    TRUE ~ 0
  )) %>%
  # 批量映射code和color
  left_join(code_color_map, by = c("code" = "original_code")) %>%
  select(-original_code) %>%
  column_to_rownames(var = "sample") %>% 
  mutate(color = as.factor(color)) %>% 
  relocate(color, .after = code)

方案2：用recode的命名向量参数 #

将映射关系转为命名向量，通过!!!展开实现批量替换：

pacman::p_load(tidyverse)

codes_vector <- c("hybrid", "plant based", "code3", "code4", "code5", "code6", "code7", "code8")
colors_vector <- c("#1B9E77","#D95F02","#7570B3","#E7298A","#66A61E","#E6AB02","#A6761D", "#666666")

# 构建命名向量映射规则
code_map <- set_names(codes_vector, as.character(1:length(codes_vector)))
color_map <- set_names(colors_vector, codes_vector)

analysis1 <- pcadata %>% 
  filter(code %in% c(1, 2)) %>% 
  arrange(code, 4) %>%
  group_by(sample, compound) %>% 
  pivot_wider(names_from = compound,
              values_from = conc,
              values_fill = 0) %>% 
  ungroup() %>% 
  # 补充Nonanal列
  mutate(Nonanal = case_when(
    sample == "1-1" ~ 45433,
    sample == "1-2" ~ 27520,
    sample == "1-3" ~ 28883,
    sample == "2-3" ~ 52454,
    TRUE ~ 0
  )) %>%
  # 批量替换code和color
  mutate(code = recode(code, !!!code_map)) %>%
  mutate(color = recode(code, !!!color_map)) %>%
  mutate(color = as.factor(color)) %>% 
  column_to_rownames(var = "sample") %>% 
  relocate(color, .after = code)

两种方案均避免了重复编写映射规则，后续只需修改codes_vector和colors_vector即可更新映射逻辑，代码更简洁易维护。

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