如何让R代码中Acad_Year变量更灵活，无需重复修改case_when

问题背景 #

现有R代码可循环读取学期数据文件、计算衍生字段并输出数据集，但Acad_Year字段的case_when实现方式扩展性差，每次新增学期数据集都需要手动修改该条件分支，维护成本高。

优化思路 #

将学期与学年的映射关系抽离为独立的配置表，通过数据匹配的方式替代硬编码的case_when，后续新增学期只需更新配置表即可，无需修改核心逻辑代码。

具体实现 #

1. 定义学年映射配置表 #

先创建一个包含所有学期-学年对应关系的 tibble，后续新增学期直接在这个表中追加行即可：

# 定义学期到学年的映射表
acad_year_map <- tibble(
  Sem_Year = c("Fall_18", "Spring_19", "Summer_19",
               "Fall_19", "Spring_20", "Summer_20",
               "Fall_20", "Spring_21", "Summer_21",
               "Fall_21", "Spring_22", "Summer_22",
               "Fall_22", "Spring_23"),
  Acad_Year = c(rep("AY2018-19", 3),
                rep("AY2019-20", 3),
                rep("AY2020-21", 3),
                rep("AY2021-22", 3),
                rep("AY2022-23", 2))
)

如果学期数量较多，也可以将这个映射表保存为外部CSV文件，用read_csv()读取，维护更方便：

# 从外部文件读取映射表（可选）
# acad_year_map <- read_csv("acad_year_mapping.csv")

2. 替换原代码中的case_when逻辑 #

将原代码中生成Acad_Year的case_when部分删除，改为通过left_join匹配映射表：

# 原代码中生成Acad_Year的部分替换为：
res[[i]] <- bind_rows(ASPH, ID) %>%
  # ...（保留原有的distinct、rowwise、racecount等计算步骤）
  mutate(
    # ...（保留原有的racecode、gender_long、DEPT等字段计算）
    Sem_Year = paste0(d$Sem[i],"_",d$Year[i]),
    StudentCount = 1
    # 移除原有的Acad_Year case_when代码
  ) %>%
  # 加入学年映射匹配
  left_join(acad_year_map, by = "Sem_Year") %>%
  # ...（保留后续的Deg_group计算、left_join PhGrad等步骤）

完整修改后的核心循环代码片段 #

# 先定义学年映射表
acad_year_map <- tibble(
  Sem_Year = c("Fall_18", "Spring_19", "Summer_19",
               "Fall_19", "Spring_20", "Summer_20",
               "Fall_20", "Spring_21", "Summer_21",
               "Fall_21", "Spring_22", "Summer_22",
               "Fall_22", "Spring_23"),
  Acad_Year = c(rep("AY2018-19", 3),
                rep("AY2019-20", 3),
                rep("AY2020-21", 3),
                rep("AY2021-22", 3),
                rep("AY2022-23", 2))
)

# 循环部分
for(i in seq_along(res)){
  ASPH <- rio::import(d$ASPH[i])
  ID <- rio::import(d$ID[i])
  
  res[[i]] <- bind_rows(ASPH, ID) %>%
    distinct(ID, Program, .keep_all = T) %>% 
    rowwise() %>% 
    mutate(racecount= sum(c_across(`Race-Am Ind`:`Race- Caucasian`)== "Y", na.rm=T)) %>% 
    ungroup() %>% 
    mutate(racecode= case_when(Citizenship %in% list("NN", "NV") ~ "foreign_national",
                               `Race- Hispanic`== "Y" ~ "hispanic_latino", 
                                racecount >1 ~ "two_or_more_races",
                               `Race-Am Ind`== "Y"  ~ "american_indian_alaskan_native",
                               `Race- Asian`== "Y"  ~ "asian",
                               `Race-Afr Amer`== "Y"  ~ "black_african_american",
                               `Race- Hawaiian` == "Y"  ~ "native_hawaiian_pacific_islander",
                               `Race- Caucasian`== "Y" ~ "white",
                               `Race-Not Rept`== "Y" ~ "race_unknown",
                               TRUE~ "race_unknown"),
           gender_long= case_when(Gender== "F"~ "Female",
                                  Gender== "M"~ "Male",
                                  Gender== "N"~ "Other",
                                  TRUE~ "other"),
           DEPT= case_when(Program %in% list("3GPH363AMS", "3GPH363AMSP", "3GPH378AMCD", "3GPH378AMS", "3GPH379APHD")~ "COMD",
                           Program %in% list("3GPH593AMPH", "3GPH593AMS", "3GPH593APHD", "3GPH569ACGS")~ "ENHS",
                           Program %in% list("3GPH596AMS", "3GPH596AMSPH", "3GPH596APHD","3GPH594AMPH", "3GPH594AMS", "3GPH594AMSPH", "3GPH594APHD", "3GPH586APBAC")~ "EPID/BIOS", 
                           Program %in% list("3GPH331AMS","3GPH331APHD","3GPH334AMS","3GPH335ADPT", "3GPH377AMS", "3GPH388AMS", "3GPH588AMPH", "3GPHJ331MS", "3UPH331ABS")~ "EXSC",
                           Program %in% list("3GPH568APBAC","3GPH592ACGS","3GPH592AMPH", "3GPH592APHD", "3GPH576ACGS", "3GPH121ACGS", "3GID635ACGS")~ "HPEB",
                           Program %in% list("3GPH591AMPH", "3GPH591APHD", "3GPH597AMHA","3GPH591ADPH")~ "HSPM",
                           TRUE~ "Missing"), 
           degree_delivery_type= case_when(`First Concentration`== "R999" | `Second Concentration`== "R999" ~ "Distance-based",
                                           `First Concentration`== "3853" | `Second Concentration`== "3853" ~ "Executive", 
                                           TRUE~ "Campus-based"),
           Sem_Year= paste0(d$Sem[i],"_",d$Year[i]),
           StudentCount= 1) %>%
    # 匹配学年映射
    left_join(acad_year_map, by = "Sem_Year") %>%
    mutate(Deg_group = case_when(Degree %in% list("DPT", "PHD", "DPH")~ "Doctorate",
                                Degree %in% list("MSP", "MCD", "MPH", "MHA", "MS","MSPH")~ "Masters",
                                Degree %in% list("CGS", "PBACC")~ "Certificate")) %>%
    left_join(., PhGrad %>% mutate_at(vars(BannerID), ~as.character(.)), by= c("ID"="BannerID", "DEPT"), unmatched= "drop", relationship= "many-to-many") %>% 
    mutate(New_Deg= case_when(is.na(Degree.y)== T~ Degree.x,
                       is.na(Degree.y)== F~ Degree.y,
                            TRUE~ "Error")) %>% 
    select(-c(ApplicationID:StudentStatus))
}

优势说明 #

• 扩展性强：新增学期时，只需在acad_year_map中添加对应的Sem_Year和Acad_Year行，无需修改核心逻辑代码
• 维护便捷：映射关系集中管理，逻辑清晰，不易出错
• 灵活性高：若后续学年规则调整，仅需修改映射表即可，无需重构条件判断代码

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