rshinyshinyjsbslib

Shiny.setInputValue to open a new tab and set a value in dynamic selectInput only works after the tab has been loaded already


I am using shinyJS on a bslib page made with shiny in R to make links that are dynamically created within a DT. The link should open a different tab on the page as well as choose the value for a selectInput on that new tab. The choices for the selectInput are dynamically created using renderUI as the choices will depend on what the user has set so far on other parts of the page.

This actually works fine once you have clicked on the new tab once (because this forces the app to load the selectInput). However, it does not work the first time you click on it if you have never loaded the second tab yet. It will open the tab fine, but the selectInput will have its default value, not the one that the link is telling it to.

I was able to recreate the error here. If you click on the link right away, Panel 2 is opened but Choice 1 is still selected. If you go back to Panel 1 and click the link a second time, then Panel 2 opens and Choice 2 is selected. Is there a way to force the second tab to load even if the user has not visited it yet or is there some other solution to get this to work?

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)


Solution

  • The reason this is happening is because in rendering output$select_test you render the selectInput() without any selection. And so the default selection is the first choice in the list (which is Choice 1). What is needed is to render it using the choice that is submitted when the setInputValue is clicked.

    There are some other issues, too: that "select_test" is defined as both an input variable and also as an output variable -- each should be unique. This may or may not be an issue in this toy example, but redundantly named objects can cause conflicts (especially when these IDs are passed up and back via Javascript).

    I've also simplified the "select_test" observer to both set the choices for the selectInput and also update the page navigation, as this a bit more straight forward than separating each into different observers (and possibly encountering priority issues).

    Finally, to ensure that clicking on the setInputValue link will always trigger this behavior (even if "Choice 2" is already selected), the "event" priority behavior can be passed as an argument.

    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)