Shiny应用跨标签更新下拉菜单时如何阻止默认值的执行逻辑

问题根因 #

你遇到的两次渲染问题来自执行顺序的异步错位：

1. 前端点击按钮后，JS同步触发两个操作：向服务端发送foo参数、切换到Table标签页
2. 前端切换标签速度远快于服务端处理输入更新的速度，Table标签激活后，renderDT立刻读取当前input$lists的默认值setosa完成第一次渲染
3. 服务端接收到foo参数后执行updateSelectInput，input$lists更新为versicolor，触发第二次渲染

解决方案 #

最直接的修复是把标签页切换的控制权移到服务端，等下拉选框更新完成后再切换标签，同时配合freezeReactiveValue彻底阻断无效的渲染触发：

修改步骤 #

1. 给tabsetPanel新增id，用于服务端控制切换
2. 移除JS中切换标签的代码，只保留设置foo参数的逻辑
3. 服务端更新下拉选框后，再执行标签页切换操作

完整可运行代码 #

library(shiny)
library(DT)
library(dplyr)
library(bslib)

iris2 <- data.frame()
for(i in 1:10000) {
  iris2 <- bind_rows(iris2,iris)
}

theme <- bslib::bs_theme(version = 4)

ui <- fluidPage(
  title = "Hello Shiny!",
  theme = theme,
  # 给tabsetPanel加id用于服务端控制
  tabsetPanel(id = "main_tabs",
    tabPanel("Plot", 
             uiOutput("tab1")),
    tabPanel("Table", 
             selectInput("lists", "Select Category",
                         choices = unique(iris2$Species),
                         selected = "setosa"
             ),
             DTOutput('tbl'))
  )
)

server <-  function(input, output, session) {
  
  observeEvent(input$foo, {
    # 冻结input$lists的响应触发，直到当前observer执行完成
    freezeReactiveValue(input, "lists")
    updateSelectInput(session, "lists", selected = input$foo)
    # 下拉选框更新完成后再切换到Table标签，避免触发默认值渲染
    updateTabsetPanel(session, "main_tabs", selected = "Table")
  })
  
  output$tbl = renderDT(
    iris2 %>% filter(Species %in% input$lists), 
    options = list(lengthChange = FALSE)
  ) 
  
  output$tab1 <- renderUI({
    tagList(
      actionButton("mybtn", "Hit me"),
      # 移除JS中切换标签的代码，只保留设置输入值的逻辑
      tags$script("
      $('#mybtn').on('click', function() {
        Shiny.setInputValue('foo', 'versicolor', {priority: 'event'});
      });")    
    )
  })    
  
}

shinyApp(ui, server)

如果你不愿意修改JS逻辑，也可以给renderDT加上判断逻辑，忽略初始的默认值触发，但上述方案的性能最优，完全不会执行无效的过滤渲染。

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