rshinybslib

How to disable specific nav_panels in bslib::navset_tab based on radioButton responses in Shiny?


Is it possible to have the "Favorite food" and "Favorite color" nav_panels be visible (displayed in the tab bar), but disabled (not selectable/clickable) unless the corresponding radioButton in the "Main questions" tab was answered with "Yes"?

So ideally: If the user selects "No" for "Do you want to answer a question about your favorite food?", the "Favorite food" tab is visible but greyed out or unclickable. Same for "Favorite color".

I know I could dynamically remove or add tabs based on the responses, but I would prefer the tabs to always be visible and only enable them based on user input, similar to disabling tabs in other UI frameworks.

Is this possible with Shiny (and bslib)? If not, is there a workaround with JavaScript or another approach?

library(shiny)
library(bslib)

questionnaire_panel <- function() {
  bslib::card(
    title = "Questionnaire",
    bslib::navset_tab(
      id = "questionnaire_tabs",
      
      # Tab 1: Main questions
      bslib::nav_panel(
        title = "Main questions",
        shiny::radioButtons(
          inputId = "wants_food_question",
          label = tags$b("Do you want to answer a question about your favorite food?"),
          choices = c("No" = "no", "Yes" = "yes"),
          selected = character(0),
          width = "100%"
        ),
        shiny::radioButtons(
          inputId = "wants_color_question",
          label = tags$b("Do you want to answer a question about your favorite color?"),
          choices = c("No" = "no", "Yes" = "yes"),
          selected = character(0),
          width = "100%"
        )
      ),
      
      # Tab 2: Favorite Food
      bslib::nav_panel(
        title = "Favorite food",
        shiny::radioButtons(
          inputId = "favorite_food",
          label = tags$b("What is your favorite food?"),
          choices = c(
            "Pizza" = "pizza",
            "Pasta" = "pasta",
            "Sushi" = "sushi",
            "Salad" = "salad",
            "Other" = "other"
          ),
          selected = character(0),
          width = "100%"
        )
      ),
      
      # Tab 3: Favorite Color
      bslib::nav_panel(
        title = "Favorite color",
        shiny::radioButtons(
          inputId = "favorite_color",
          label = tags$b("What is your favorite color?"),
          choices = c(
            "Red" = "red",
            "Blue" = "blue",
            "Green" = "green",
            "Yellow" = "yellow",
            "Other" = "other"
          ),
          selected = character(0),
          width = "100%"
        )
      )
    )
  )
}

# Example app
ui <- fluidPage(
  theme = bs_theme(bootswatch = "flatly"),
  questionnaire_panel()
)

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

shinyApp(ui, server)

Solution

  • I currently don't see a native way using bslib functions, but with custom Javascript it is possible. What I do here is to add the disabled class to the .nav_link, see here for an example within the Bootstrap docs. It makes the tab on the one hand not clickable and on the other hand changes the font color.

    enter image description here

    Additionally please use bslib's page_fluid() instead of Shiny's fluidPage().

    We use session$sendCustomMessage():

    library(shiny)
    library(bslib)
    
    questionnaire_panel <- function() {
      bslib::card(
        title = "Questionnaire",
        bslib::navset_tab(
          id = "questionnaire_tabs",
          
          # Tab 1: Main questions
          bslib::nav_panel(
            title = "Main questions",
            shiny::radioButtons(
              inputId = "wants_food_question",
              label = tags$b("Do you want to answer a question about your favorite food?"),
              choices = c("No" = "no", "Yes" = "yes"),
              selected = character(0),
              width = "100%"
            ),
            shiny::radioButtons(
              inputId = "wants_color_question",
              label = tags$b("Do you want to answer a question about your favorite color?"),
              choices = c("No" = "no", "Yes" = "yes"),
              selected = character(0),
              width = "100%"
            )
          ),
          
          # Tab 2: Favorite Food
          bslib::nav_panel(
            title = "Favorite food",
            shiny::radioButtons(
              inputId = "favorite_food",
              label = tags$b("What is your favorite food?"),
              choices = c(
                "Pizza" = "pizza",
                "Pasta" = "pasta",
                "Sushi" = "sushi",
                "Salad" = "salad",
                "Other" = "other"
              ),
              selected = character(0),
              width = "100%"
            )
          ),
          
          # Tab 3: Favorite Color
          bslib::nav_panel(
            title = "Favorite color",
            shiny::radioButtons(
              inputId = "favorite_color",
              label = tags$b("What is your favorite color?"),
              choices = c(
                "Red" = "red",
                "Blue" = "blue",
                "Green" = "green",
                "Yellow" = "yellow",
                "Other" = "other"
              ),
              selected = character(0),
              width = "100%"
            )
          )
        )
      )
    }
    
    # Example app
    ui <- page_fluid(
      theme = bs_theme(bootswatch = "flatly"),
      questionnaire_panel(),
      tags$head(
        tags$script('
          Shiny.addCustomMessageHandler("disableNav",
            function(message) {
              if (message.disable !== "yes") {
                $("a:contains(" + message.value + ")").addClass("disabled");
              } else {
                $("a:contains(" + message.value + ")").removeClass("disabled");
              }
            }
          );'
        )
      )
    )
    
    
    server <- function(input, output, session) { 
      
      lapply(
        c("wants_food_question", "wants_color_question"), 
        function (q) {
          observeEvent(input[[q]], {
            session$sendCustomMessage(
              "disableNav", 
              message = list(
                value = sub(".*\\_(.*?)\\_.*", "\\1", q), # food, color, ...
                disable = input[[q]]
              )
            )
          })      
        }
      )
      
    }
    
    shinyApp(ui, server)