Search code examples
rshinyshinydashboard

Generating Information on Specific Tabs in Shiny Dashboard Dependent on Which Radio Button is Selected


I'm trying to generate information in specific tabs of my shiny dashboard dependent on which radio button is selected by the user. For example, if the person selected "18-29", I'd like to add age-specific information to the "Breast Cancer" tab and to the "Cervical Cancer" tab. However, it is currently adding the age-specific information to ALL tabs rather than the ones specified. I'm not sure where I went wrong or how to fix it. Below is a simplified version of the code I am using.

library(shiny)
library(shinydashboard)
library(shinyjs)

header <- dashboardHeader(
  title = "Breast and Cervical Cancer: How to Help You"
)

sidebar <- dashboardSidebar(
  sidebarMenu(
    radioButtons("age", "Select Your Age Range",
                choices = c("18-29", "30-39", "40-49", "50-59", "60+"),
                selected = "18-29"),
    menuItem("About the Tool", tabName = "about"),
    menuItem("Breast Cancer", tabName = "breast"),
    menuItem("Cervical Cancer", tabName = "cervical"),
    menuItem("More Information", tabName = "info")
  )
)


body <- dashboardBody(
# Creating the Tabs  
tabItems(
    tabItem("about",
            h1("About the Tool"),
            p("Here's some information about the tool"),
            ),
    tabItem("breast",
            h1("Breast Cancer"),
            p("You can use the following resources to learn some more about breast"),
    ),
    tabItem("cervical",
              h1("Cervical Cancer"),
              p("You can use the following resources to learn some more about cervical"),
    ),
    tabItem("info",
            h1("More Information"),
            p("You can use the following resources to learn some more"),
            ),
    uiOutput("dynamic_tabs")
  )
)
# Adding Age-Specific Information to Two Tabs
server = function(input, output) {
  output$dynamic_tabs <- renderUI({
    selected_age <- input$age
    # Cervical Cancer Tab
    if (selected_age == "18-29") {
      tab_content <- tabItem(tabName = "cervical",
                             h2("Okay, this works"))
    } else if (selected_age == "30-39") {
      tab_content <- tabItem(tabName = "cervical",
                             h2("Testing again"))
    } else if (selected_age == "40-49") {
      tab_content <- tabItem(tabName = "cervical",
                             h2("Keep testing"))
    } else if (selected_age == "50-59"){
      tab_content <- tabItem(tabName = "cervical",
                             h2("One more to go"))
    } else if (selected_age == "60+") {
      tab_content <- tabItem(tabName = "cervical",
                             h2("finally"))
    }
    # Breast Cancer Tab
    if (selected_age == "18-29") {
      tab_content <- tabItem(tabName = "Breast",
                             h2("You and Your Breasts"))
    } else if (selected_age == "30-39") {
      tab_content <- tabItem(tabName = "Breast",
                             h2("Start Having Discussions"))
    } else if (selected_age == "40-49") {
      tab_content <- tabItem(tabName = "Breast",
                             h2("Time for Your Mammogram!"))
    } else if (selected_age == "50-59"){
      tab_content <- tabItem(tabName = "Breast",
                             h2("It's Time to See Your OBGYN"))
    } else if (selected_age == "60+") {
      tab_content <- tabItem(tabName = "Breast",
                             h2("Continue Discussions and Get Checked"))
    }
    tab_content
    })
    }
    

  

shinyApp(ui = dashboardPage(header, sidebar, body), server)```

Solution

  • Welcome Rodriguez,

    One issue with your code is that you use tabItem, where only h2 would be needed. ( The tabItems "breast" and "cervical" are already invoked in the UI, no need to recall them in renderUI). So just use the if else logic to define the h2 contents. Second uiOutput should be called under the respective tabItem in the UI ( so make one dynamic UI for BC and one for CC).

    library(shiny)
    library(shinydashboard)
    library(shinyjs)
    
    header <- dashboardHeader(
      title = "Breast and Cervical Cancer: How to Help You"
    )
    
    sidebar <- dashboardSidebar(
      sidebarMenu(
        radioButtons("age", "Select Your Age Range",
                     choices = c("18-29", "30-39", "40-49", "50-59", "60+"),
                     selected = "18-29"),
        menuItem("About the Tool", tabName = "about"),
        menuItem("Breast Cancer", tabName = "breast"),
        menuItem("Cervical Cancer", tabName = "cervical"),
        menuItem("More Information", tabName = "info")
      )
    )
    
    
    body <- dashboardBody(
      # Creating the Tabs  
      tabItems(
        tabItem("about",
                h1("About the Tool"),
                p("Here's some information about the tool"),
        ),
        tabItem("breast",
                h1("Breast Cancer"),
                p("You can use the following resources to learn some more about breast"),
                uiOutput("dynamic_tabs_BC"),
        ),
        tabItem("cervical",
                h1("Cervical Cancer"),
                p("You can use the following resources to learn some more about cervical"),
                uiOutput("dynamic_tabs_CC"),
                
        ),
        tabItem("info",
                h1("More Information"),
                p("You can use the following resources to learn some more"),
        )
      )
    )
    # Adding Age-Specific Information to Two Tabs
    server = function(input, output) {
      output$dynamic_tabs_CC <- renderUI({
        selected_age <- input$age
        # Cervical Cancer Tab
        if (selected_age == "18-29") {
          tab_content <- h2("Okay, this works")
        } else if (selected_age == "30-39") {
          tab_content <- h2("Testing again")
        } else if (selected_age == "40-49") {
          tab_content <- h2("Keep testing")
        } else if (selected_age == "50-59"){
          tab_content <- h2("One more to go")
        } else if (selected_age == "60+") {
          tab_content <- h2("finally")
        }
        tab_content
      })
      output$dynamic_tabs_BC <- renderUI({
        selected_age <- input$age
        if (selected_age == "18-29") {
          tab_content <- h2("You and Your Breasts")
        } else if (selected_age == "30-39") {
          tab_content <- h2("Start Having Discussions")
        } else if (selected_age == "40-49") {
          tab_content <- h2("Time for Your Mammogram!")
        } else if (selected_age == "50-59"){
          tab_content <- h2("It's Time to See Your OBGYN")
        } else if (selected_age == "60+") {
          tab_content <- h2("Continue Discussions and Get Checked")
        }
        tab_content
      })
    }
    
    shinyApp(ui = dashboardPage(header, sidebar, body), server)
    
    

    This is one soultion close to what you already have, however i would suggest to get rid of all the if else stuff and use a dataframe with indices to render the h2's . Something along the lines of:

    headers<-data.frame(
      age= c("18-29","30-39","40-49","50-59","60+"),
      CC = c("Okay, this works","Testing again","Keep testing","One more to go","finally"),
      BC = c("You and Your Breasts","Start Having Discussions","Time for Your Mammogram!","It's Time to See Your OBGYN","Continue Discussions and Get Checked")
      )
    
    server = function(input,output){
      selected_age <- reactive({input$age})
      output$dynamic_tabs_CC <- renderUI({
        h2(headers[headers$age == selected_age(),]$CC)
      })
      output$dynamic_tabs_BC <- renderUI({
        h2(headers[headers$age == selected_age(),]$BC)
      })
    }