如何在Shiny中使用purrr将单个renderText应用到多个输出？

purrr 批量渲染方案 #

这是满足需求的最简实现，仅需修改server部分逻辑即可，完整可运行代码如下：

library(shiny)
library(purrr)

ui <- fluidPage(
  fluidRow(
    column(3,
      textAreaInput(inputId = "ta1", 
                    label = "Fill in this field."),
      actionButton(inputId = "btn_next_ta1", label = "Next"),
      textOutput("ta1_error")
      ),
    column(3,
      textAreaInput(inputId = "ta2",
                    label = "Fill in this field."),
      actionButton(inputId = "btn_next_ta2", label = "Next"),
      textOutput("ta2_error")
    ),
  )
)

server <- function(input, output) {
  # 统一维护所有需要校验的文本输入框id，新增字段仅需在这里添加id即可
  ta_ids <- c("ta1", "ta2")
  
  # 用purrr::walk遍历所有id，批量生成renderText逻辑
  walk(ta_ids, function(id) {
    # 动态为output挂载对应错误提示的渲染规则
    output[[paste0(id, "_error")]] <- renderText({
      if (input[[id]] == "") {
        "Please fill in the field."
      }
    })
  })
  
  # 若需要点击Next按钮才触发校验（更适配多标签页的实际使用场景，避免提前弹出提示），替换为下方代码即可
  # walk(ta_ids, function(id) {
  #   observeEvent(input[[paste0("btn_next_", id)]], {
  #     output[[paste0(id, "_error")]] <- renderText({
  #       req(input[[paste0("btn_next_", id)]])
  #       if (input[[id]] == "") {
  #         "Please fill in the field."
  #       }
  #     })
  #   })
  # })
}

shinyApp(ui = ui, server = server)

核心逻辑说明 #

• walk是purrr中专门用于执行带副作用操作的函数，给output对象动态添加渲染逻辑属于典型的无返回值副作用操作，适配性很高
• 所有校验规则完全复用，后续新增字段不需要重复编写renderText代码，仅需要更新ta_ids向量即可

替代方案：shiny模块封装 #

如果字段数量非常多，且每组「输入框+Next按钮+错误提示」的结构完全一致，可以用shiny模块实现更高程度的复用：

1. 封装模块UI，生成统一结构的输入、按钮、提示组件
2. 封装模块服务端逻辑，内置校验规则
3. 直接调用模块生成所有标签页内容，新增字段仅需要加一次模块调用即可

内容的提问来源于stack exchange，提问作者Michael S Taylor