How to sync 'selectizeInput' between menu items for 'navbarPage' in R Shiny?

[andrii]

Let see the following code of R Shiny dashboard with 'navbarPage' layout and 2 items "Page one" and "Page two" in the main menu. Each page has selector "Selector" with the same elements (1, 2, 3). There is an issue how to sync two 'selectizeInput' elements to show the same value.

For example, if selected "2" on "Page one" - the selector on "Page two" should have "2" value when user go to "Page two" and vice verse. I guess some kind of globall variable for the R session could be use. Will be glad to know your ideas and code how it can be implemented efficiently.

library(shiny)

server <- function(input, output, session) {

  # 1. Selector for 'Page one'
  output$uo_page_one_selector <- renderUI({

    # 1. Values
    list_values <- c(1:3)
    names(list_values) <- c("One", "Two", "Three")

    # 2. Index of selected element
    index_selected <- 1

    # 3. Result
    selectizeInput('si_page_one_selector', "Selector",
               choices = list_values, multiple = FALSE, 
               selected = list_values[index_selected])
  })

  # 2. Selector for 'Page two'
  output$uo_page_two_selector <- renderUI({

    # 1. Values
    list_values <- c(1:3)
    names(list_values) <- c("One", "Two", "Three")

    # 2. Index of selected element
    index_selected <- 1

    # 3. Result
    selectizeInput('si_page_two_selector', "Selector",
               choices = list_values, 
               multiple = FALSE, 
               selected = list_values[index_selected])
  })

}

ui <- fluidPage(

  navbarPage("Demo",

    tabPanel("One",
         fluidPage(
           fluidRow(uiOutput("uo_page_one_selector")),
           fluidRow("Page one"))),

    tabPanel("Two",
         fluidPage(
           fluidRow(uiOutput("uo_page_two_selector")),
           fluidRow("Page two")))

  )
)

# Run the application 
shinyApp(ui, server)

[raytong]

Hi, andrii. I would suggest the following modification of the script using reactiveValues. The two observe functions will change the sync value when selectizeInput value changed. And the sync value will update the selected of the selectizeInputs.

And I move the selectizeInputs script back to ui because if rendering ui in server, the selectizeInput on page two will not available initially and cannot update. And the selectizeInput on page two can be only rendering lazily when you click tab "Two".

library(shiny)

# 1. Values
list_values <- c(1:3)
names(list_values) <- c("One", "Two", "Three")

# 2. Index of selected element
index_selected <- 1

server <- function(input, output, session) {
    vals <- reactiveValues(sync = 1)

    observe(
        {
            req(input$si_page_one_selector)
            vals$sync <- input$si_page_one_selector
        }
    )

    observe(
        {
            req(input$si_page_two_selector)
            vals$sync <- input$si_page_two_selector
        }
    )

    observe(
        {
            req(vals$sync)
            updateSelectizeInput(session, 'si_page_one_selector', selected = vals$sync)
            updateSelectizeInput(session, 'si_page_two_selector', selected = vals$sync)
        }
    )
}

ui <- fluidPage(

    navbarPage("Demo",

               tabPanel("One",
                        fluidPage(
                            fluidRow(selectizeInput('si_page_one_selector', "Selector",
                                                    choices = list_values,
                                                    multiple = FALSE,
                                                    selected = list_values[index_selected])),
                            fluidRow("Page one"))),

               tabPanel("Two",
                        fluidPage(
                            fluidRow(selectizeInput('si_page_two_selector', "Selector",
                                                    choices = list_values,
                                                    multiple = FALSE,
                                                    selected = list_values[index_selected])),
                            fluidRow("Page two")))

    )
)

# Run the application
shinyApp(ui, server)

[andrii]

Thanks a lot ! It seems work!

[hadley]

I think you could make it a bit simpler still by eliminating the reactiveValues() and just updating directly. I think observeEvent() makes this sort of code quite nice to write:

library(shiny)

list_values <- c(1:3)
names(list_values) <- c("One", "Two", "Three")
index_selected <- 1

ui <- fluidPage(
  navbarPage("Demo",
    tabPanel("One",
      selectInput("page1", "Selector",
        choices = list_values,
        selected = list_values[index_selected]
      )
    ),
    tabPanel("Two",
      selectInput("page2", "Selector",
        choices = list_values,
        selected = list_values[index_selected]
      )
    )
  )
)

server <- function(input, output, session) {
  observeEvent(
    input$page1,
    updateSelectizeInput(session, "page2", selected = input$page1)
  )

  observeEvent(
    input$page2,
    updateSelectizeInput(session, "page1", selected = input$page2)
  )
}

shinyApp(ui, server)