Shiny.setInputValue 打开新选项卡并在动态 selectInput 中设置值仅在选项卡加载后才有效

Question

我在用 R 中的shiny 制作的bslib 页面上使用shinyJS 来创建在DT 中动态创建的链接。该链接应在页面上打开另一个选项卡，并在该新选项卡上选择 selectInput 的值。 selectInput 的选择是使用 renderUI 动态创建的，因为选择将取决于用户到目前为止在页面其他部分设置的内容。

一旦您单击新选项卡一次，这实际上就可以正常工作（因为这会强制应用程序加载 selectInput）。但是，如果您尚未加载第二个选项卡，则第一次单击它时它将不起作用。它将很好地打开选项卡，但 selectInput 将具有其默认值，而不是链接告诉它的值。

我能够在这里重新创建错误。如果您立即单击该链接，则会打开面板 2，但仍会选择选项 1。如果您返回面板 1 并再次单击该链接，则面板 2 将打开并选择选项 2。即使用户尚未访问第二个选项卡，是否有办法强制加载第二个选项卡，或者是否有其他解决方案可以使其正常工作？

library(shiny)
library(bslib)
library(shinyjs)

ui <- fluidPage(

    page_navbar(
      id="main_tab",
      nav_panel("Panel 1",
                htmlOutput("link_test")),
      nav_panel("Panel 2",
                uiOutput("select_test")
      )
    )
)

server <- function(input, output, session) {
  observeEvent(input$main_tab,{
    updateTabsetPanel(session, "main_tab", input$main_tab)
  })
  
  observeEvent(input$select_test, {
    updateSelectInput(session, "select_test", selected=input$select_test)
  })
  
  output$select_test <- renderUI({
    selectInput("select_test", "Select Test:", choices = c("Choice 1", "Choice 2", "Choice 3"))
  })
  
  output$link_test <- renderText(
    paste0('<a href="', 
           "#" ,"\",",
           " onclick=\"Shiny.setInputValue('",
           "main_tab", "', '",
           "Panel 2", "'); ",
           "Shiny.setInputValue('",
           "select_test", "', '",
           "Choice 2", "')\">",
           "Choice 2", "</a>")
  )
  
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

发生这种情况的原因是因为在渲染时

output$select_test

您渲染了 selectInput() 而不进行任何选择。因此，默认选择是列表中的第一个选择（即选项 1）。需要的是使用单击 setInputValue 时提交的选择来呈现它。

还有一些其他问题：“select_test”既被定义为输入变量，又被定义为输出变量——每个变量都应该是唯一的。在这个玩具示例中，这可能是问题，也可能不是问题，但冗余命名的对象可能会导致冲突（特别是当这些 ID 通过 Javascript 传递和返回时）。

我还简化了“select_test”观察者来设置 selectInput 的选择并更新页面导航，因为这比将每个观察者分成不同的观察者（并且可能会遇到优先级问题）更直接。

最后，为了确保单击 setInputValue 链接始终会触发此行为（即使已选择“选择 2”），可以将“事件”优先级行为作为参数传递。

library(shiny)
library(bslib)
library(shinyjs)

ui <- fluidPage(

    page_navbar(
      id="main_tab",
      nav_panel("Panel 1",
                htmlOutput("link_test")),
      nav_panel("Panel 2",
                uiOutput("select_test_UI")
      )
    )
)

server <- function(input, output, session) {
  
  observeEvent(input$select_test, {
    updateTabsetPanel(session, "main_tab", "Panel 2")
    updateSelectInput(session, 
                      "select_test",
                      selected=input$select_test)
  })
  
  output$select_test_UI <- renderUI({
    
    current_selection <- input$select_test
    if (!isTruthy(current_selection)) current_selection <- "Choice 1"
    selectInput("select_test", 
                "Select Test:", 
                choices = c("Choice 1", "Choice 2", "Choice 3"),
                selected = current_selection)
  })
  
  output$link_test <- renderText(
    paste0('<a href="', 
           "#" ,"\",",
           " onclick=\"Shiny.setInputValue('select_test','Choice 2',{priority:'event'}) \">",
           "Choice 2", "</a>")
  )
  
}
shinyApp(ui = ui, server = server)