Sidebar switch button shared across several pages

Consider this multi-pages app.

library(shiny)
library(bslib)

shinyApp(
  ui = page_fluid(
    navset_bar(
      nav_panel(
        "Foo",
        page_sidebar(
          sidebar = sidebar(
            textInput("foo", "Foo field", value = NULL),
            conditionalPanel(
              condition = "input.blah === true",
              numericInput(
                "foo-num",
                "Foo numeric",
                value = 1,
                min = 1
              )
            )
          )
        )
      ),
      nav_panel(
        "Bar",
        page_sidebar(
          sidebar = sidebar(
            textInput("bar", "Bar field", value = NULL),
            conditionalPanel(
              condition = "input.blah === true",
              numericInput(
                "bar-num",
                "Bar numeric",
                value = 1,
                min = 1
              )
            )
          )
        )
      )
    )
  ),
  server = function(input, output, session) {}
)

I'd like to have a switch button in the sidebar shared across all pages.

Currently, solutions I can think of to do this include:

  1. A global bslib::input_switch() button.

  2. Multiple switch buttons (one in every page) that inherit the value of each other from page to page.

Solution #1 is the easiest to implement but it has to be outside the main sidebar (for example in bslib::navset_bar(header =)). Don't know how I could have it as if it was inside bslib::sidebar() though.

Solution #2 makes it easy to insert the button exactly where I want but I can't think of a simple way to inherit its value across all pages because the function doesn't seem to return the actual value of the button. It's probably possible to pass reactive values along every button but it's not very convenient.

Inserting multiple button with:

insertUI(
  selector = ".sidebar-content",
  ui = input_switch("blah", "Blah", value = FALSE),
  where = "afterBegin",
  immediate = TRUE,
  multiple = TRUE
)

Seems to work but buttons are not updated across pages (will be displayed as if turned off although they're turned on).

Any idea of a simple way to do this?

#1 is indeed most elegant, but you're right that you'd have to position it outside of the nav_panels where it is always visible.

If you want a switch inside each nested sidebar, then you have to use different inputs and then keep them in sync with update* functions (example below). It's not pretty but you can generalise it to apply to however many switches you have (example also below).

The problem with your insertUI method is that the switches all have the same ID which isn't valid HTML.

library(shiny)
library(bslib)

ui <- page_navbar(
  nav_panel("Tab 1",
    input_switch("switch_tab1", "Enable Feature", value = FALSE)
  ),
  nav_panel("Tab 2", 
    input_switch("switch_tab2", "Enable Feature", value = FALSE)
    )
)

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

  switch_state <- reactiveVal(FALSE)
  
  observeEvent(input$switch_tab1, {
    switch_state(input$switch_tab1)
    update_switch("switch_tab2", value = input$switch_tab1, session = session)
  })
  
  observeEvent(input$switch_tab2, {
    switch_state(input$switch_tab2)
    update_switch("switch_tab1", value = input$switch_tab2, session = session)
  })
 
}

shinyApp(ui = ui, server = server)


  switch_ids <- paste0("switch_tab", 1:2)
  for (switch_id in switch_ids) {
    local({
      current_id <- switch_id  # Capture in local scope
      observeEvent(input[[current_id]], {
        switch_state(input[[current_id]])
        
        other_switches <- setdiff(switch_ids, current_id)
        for (other_id in other_switches) {
          update_switch(other_id, value = input[[current_id]], session = session)
        }
      })
    })
  }

1 Like