使用html=TRUE的模块化shinyalert for循环迭代时如何动态更新下拉框

• 代码笔误：你在服务端循环中写了nms <- options[[i]]，但变量i未定义，应替换为循环变量col。
• 惰性求值陷阱：R的for循环中，renderUI属于异步执行的响应式表达式，不会在循环执行时立刻捕获当前col的取值，等renderUI实际运行时，循环已经执行完毕，col固定为最终值2，导致第一个弹窗对应的下拉框渲染逻辑被覆盖。
• 弹窗触发逻辑错误：直接在for循环中连续调用shinyalert会导致后一个弹窗直接覆盖前一个，无法实现「用户选中选项后再弹出下一个」的需求，shinyalert默认不会阻塞后续代码执行。

放弃for循环的实现方式，改用链式监听弹窗确认事件的方式依次触发弹窗，同时用local()包裹每一轮的渲染逻辑，强制捕获当前循环变量的取值，修正后完整可运行代码如下：

library(shiny)

# 模块UI
mod_match_columns_ui <- function(id){
  ns <- NS(id)
  tagList(
    shinyalert::useShinyalert(),
    actionButton(ns("run"), label = "Start!")
  )
}

# 模块服务端
mod_match_columns_server <- function(input, output, session){
  ns <- session$ns
  
  options <- list(c("option_1","option_2"),
                  c("option_3","option_4"))
  # 记录当前需要弹出的弹窗索引
  current_col <- reactiveVal(1)
  
  # 点击按钮触发第一个弹窗
  observeEvent(input$run, {
    current_col(1)
  })
  
  # 监听当前弹窗索引，弹出对应弹窗
  observeEvent(current_col(), {
    col <- current_col()
    if(col > length(options)) return() # 所有弹窗展示完毕后退出
    
    # 用local强制捕获当前col的取值，解决惰性求值问题
    local({
      current_nms <- options[[col]]
      output[[paste0("dropdown",col)]] <- renderUI({
        shinyWidgets::pickerInput(
          inputId = ns(paste0("options",col)),
          label = "Options listed below", 
          choices = current_nms,
          selected = current_nms[1],
          multiple = FALSE,
          options = shinyWidgets::pickerOptions(size = 15)
        )
      })
      
      shinyalert::shinyalert(
        title = paste0("Pick an option (", col, "/", length(options), ")"),
        html = TRUE,
        text = tagList(
          uiOutput(ns(paste0("dropdown", col)))
        ),
        inputId = ns(paste0("modal", col)),
        showConfirmButton = TRUE,
        confirmButtonText = ifelse(col == length(options), "Finish", "Next")
      )
    })
  })
  
  # 监听弹窗确认事件，触发下一个弹窗
  lapply(1:length(options), function(col){
    observeEvent(input[[paste0("modal", col)]], {
      if(input[[paste0("modal", col)]] == TRUE && col < length(options)){
        current_col(col + 1)
        # 可在此处存储当前弹窗用户选择的结果：input[[paste0("options", col)]]
      }
    })
  })
}

# 运行应用
ui <- fluidPage(
  mod_match_columns_ui("match_columns_ui_1")
)

server <- function(input, output, session) {
  callModule(mod_match_columns_server, "match_columns_ui_1")
}

shinyApp(ui = ui, server = server)

修复后两个弹窗均可正常渲染下拉框，且会按顺序弹出，用户确认前一个弹窗后才会展示后一个。

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