优化Shiny中嵌套ifelse结构的技术方案咨询

我开发了一款帮同事选择最优统计测试的Shiny应用，目前UI功能正常，但Server端用了大量嵌套ifelse结构，代码冗余，后续维护和扩展（包括个人更大项目）难度很高。试过用case_when()但没成功，想请教有没有更优的实现方式来提升代码可维护性。

应用UI代码 #

ui <- fixedPage(
  titlePanel("Choisir son test statistique"),
  fluidRow(
    column(3,selectInput("choix","Que voulez-vous faire ?", c('a1',
                                                              'b1',
                                                              'c1',
                                                              'd1'))),
    column(3,conditionalPanel(
      condition="input.choix=='stat'",
      selectInput("type","Quel type d'analyse ?", c('a2',
                                                    "b2",
                                                    "c2",
                                                    "d2")))),
    column(3,conditionalPanel(
      condition="input.choix=='d1'&&input.type=='b2'||input.choix=='d1'&&input.type=='c2'",
      selectInput("groupe","Combien de groupes ?", c('a3',
                                                     "b3",
                                                     "c3",
                                                     "d3"))),
      conditionalPanel(
        condition = "input.type=='Lien entre Variable'",
        selectInput("variable","Quel type de variables ?", c('a4',
                                                             "b4",
                                                             "c4",
                                                             "d4")))),
    column(3, conditionalPanel(
      condition = "input.choix=='d1'&&input.type=='b2'||input.choix=='d1'&&input.type=='c2'",
      selectInput("indep", "Indépendance des données ?",c('a5',
                                                          "b5",
                                                          "c5"))),
      conditionalPanel(
        condition = "input.choix=='d1'&&input.type=='b2'||input.choix=='d1'&&input.type=='c2'",
        selectInput("param", "Normalité des données ?",c('a6',
                                                         "b6",
                                                         "c6",
                                                         "d6")))),
    
    mainPanel(htmlOutput("texte"))))

Server端核心嵌套ifelse代码示例 #

server <- function(input, output) {   output$texte <- renderText({ 
    if(input$choix=="a1"){ 
      paste(analyse_desc)}
    else{if(input$choix=="b1" ){
      paste(shapiro, levene, bartlett)}
      else{if(input$choix=="c1"){
        groupe<-input$groupe
        param<-input$param
        indep<-input$indep
        type<-input$type
        if(input$param=="d6"){
          paste(shapiro, levene, bartlett)}
        else{if(input$groupe=="b3" &&
                input$param=="b6" && 
                input$type=="b2"){
          paste(student1)}
          else{if(input$groupe=="c3" &&
                  input$param=="b6" && 
                  input$indep=="b5"&&
                  input$type=="b2"){
            paste(student2, welch)}
            else{if(input$groupe=="d3" &&
                    input$param=="b6" &&  
                    input$indep=="b5"&&
                    input$type=="b2"){
              paste(anova1)}
              else{if(input$groupe=="b3" &&
                      input$param=="c6" && 
                      input$type=="b2"){
                paste(wilcoxon1)}
                else{if(.........)}

可行优化方案 #

1. 规则映射表法（推荐） #

把所有判断条件和对应的输出结果整理成一个数据框，通过匹配找到对应结果，彻底替代嵌套判断。这种方式规则集中管理，可读性和扩展性都很强。

示例代码：

library(tibble)

# 提前定义规则表，NA表示该条件不限制
test_rules <- tibble(
  choix = c("a1", "b1", "c1", "c1", "c1", "c1", "c1"),
  groupe = c(NA, NA, NA, "b3", "c3", "d3", "b3"),
  param = c(NA, NA, "d6", "b6", "b6", "b6", "c6"),
  indep = c(NA, NA, NA, NA, "b5", "b5", NA),
  type = c(NA, NA, NA, "b2", "b2", "b2", "b2"),
  output = list(analyse_desc, 
                paste(shapiro, levene, bartlett),
                paste(shapiro, levene, bartlett),
                student1,
                paste(student2, welch),
                anova1,
                wilcoxon1)
)

server <- function(input, output) {
  output$texte <- renderText({
    # 整理当前输入为匹配用的列表
    input_vals <- list(
      choix = input$choix,
      groupe = input$groupe,
      param = input$param,
      indep = input$indep,
      type = input$type
    )
    
    # 匹配规则表，取第一个符合条件的结果
    match_row <- test_rules %>%
      filter(
        is.na(choix) | choix == input_vals$choix,
        is.na(groupe) | groupe == input_vals$groupe,
        is.na(param) | param == input_vals$param,
        is.na(indep) | indep == input_vals$indep,
        is.na(type) | type == input_vals$type
      ) %>%
      slice(1)
    
    # 返回结果，无匹配时提示
    if(nrow(match_row) > 0) {
      match_row$output[[1]]
    } else {
      "无匹配的统计测试"
    }
  })
}

2. 拆分函数，模块化处理 #

将不同分支的逻辑拆分为独立的小函数，减少嵌套层级，让每个函数只处理单一场景，逻辑更清晰，也方便单独测试和维护。

示例代码：

# 拆分各场景处理函数
handle_a1 <- function() paste(analyse_desc)
handle_b1 <- function() paste(shapiro, levene, bartlett)
handle_c1 <- function(input) {
  if(input$param == "d6") {
    paste(shapiro, levene, bartlett)
  } else if(input$groupe == "b3" && input$param == "b6" && input$type == "b2") {
    paste(student1)
  } else if(input$groupe == "c3" && input$param == "b6" && input$indep == "b5" && input$type == "b2") {
    paste(student2, welch)
  }
  # 其他分支逻辑依次补充
}
handle_d1 <- function(input) {
  # 处理d1分支的逻辑
}

server <- function(input, output) {
  output$texte <- renderText({
    switch(input$choix,
           "a1" = handle_a1(),
           "b1" = handle_b1(),
           "c1" = handle_c1(input),
           "d1" = handle_d1(input),
           "无匹配选项")
  })
}

3. 正确使用case_when() #

之前使用case_when()失败大概率是语法或条件顺序问题。case_when()按顺序判断条件，前面的条件优先匹配，需将具体条件放在前面，通用条件放后面，最后用TRUE设置默认值。

示例代码：

library(dplyr)

server <- function(input, output) {
  output$texte <- renderText({
    case_when(
      input$choix == "a1" ~ paste(analyse_desc),
      input$choix == "b1" ~ paste(shapiro, levene, bartlett),
      input$choix == "c1" && input$param == "d6" ~ paste(shapiro, levene, bartlett),
      input$choix == "c1" && input$groupe == "b3" && input$param == "b6" && input$type == "b2" ~ paste(student1),
      input$choix == "c1" && input$groupe == "c3" && input$param == "b6" && input$indep == "b5" && input$type == "b2" ~ paste(student2, welch),
      # 其他条件依次添加
      TRUE ~ "无匹配的统计测试"
    )
  })
}

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