How to create a conditional renderUI in Shiny dashboard

问题

I am unable to create a conditional sidebar menu via renderMenu because the if statement fails. "Warning: Error in if: argument is of length zero".

I found conditional RenderUI R shiny and Conditional panel in Shiny dashboard but neither are what I am looking for. A conditional panel might work in this instance but in the long run I will need to be able to do this server side.

    if (interactive()) {
  library(ggplot2)
  library(shiny)
  library(shinydashboard)
  library(shinipsum)

  ui <- dashboardPage(
    header = dashboardHeader(),
    dashboardSidebar(
      sidebarMenuOutput("plotDataVHA"),
      sidebarMenuOutput("tabSelector")
    ),
    dashboardBody(tabItems(
      tabItem(tabName = "facilities",
              fluidRow(box(
                uiOutput("selectedFacilityTime")
              ))),
      tabItem(tabName = "service",
              fluidRow(box(
                uiOutput("selectedFacilityYyCases")
              )))
    ))
  )

  server <- function(input, output) {
    output$renderedSelectedFacilityTime <- renderPlot({
      random_ggplot(type = "line")
    })
    output$selectedFacilityTime <- renderUI({
      plotOutput("renderedSelectedFacilityTime")
    })

    output$renderedFacilityYyCases <- renderPlot({
      random_ggplot(type = "bar")
    })
    output$selectedFacilityYyCases <- renderUI({
      plotOutput("renderedFacilityYyCases")
    })

    output$tabSelector <- renderMenu({
      sidebarMenu(id = "test",
                  menuItem(
                    text = "Chart data",
                    menuSubItem(
                      text = "Facilities",
                      tabName = "facilities",
                      selected = TRUE
                    ),
                    menuSubItem(
                      text = "Service & Specialty",
                      tabName = "service",
                      icon = NULL
                    )
                  ))
    })

    output$plotDataVHA <- renderMenu({
      if (input$test == "facilities") {
      sidebarMenu(
        menuItem(
          text = "VHA data",
          menuSubItem(
            text = "None",
            selected = TRUE,
            icon = NULL
          ),
          menuSubItem(text = "Mean", icon = NULL)
        )
      )
    }
     })
  }

  shinyApp(ui, server)
}

When working properly the menu "VHA data" should only be visible when the submenu "facilities" is selected.

回答1:

Interesting question. The reason you were getting the argument is of length zero error is because you are rendering both menus on the server side through renderMenu(). So when the app starts, input$test doesn't have a value assigned to it. You can avoid this by using req() which will evaluate the test input$test == "facilities" only after input$test has been initiated.

Now for the menu to only appear when another submenu is selected, you want to create the menu independently of renderMenu(). It is better to evaluate the condition in a normal reactive() and then pass this reactive function as input to renderMenu(). Finally, to remove the menu when input$test == "facilities" is FALSE, you can render an empty html container.

Here is the updated code:

  library(ggplot2)
  library(shiny)
  library(shinydashboard)
  library(shinipsum)

  ui <- dashboardPage(
    header = dashboardHeader(),
    dashboardSidebar(
      sidebarMenuOutput("plotDataVHA"),
      sidebarMenuOutput("tabSelector")
    ),
    dashboardBody(tabItems(
      tabItem(tabName = "facilities",
              fluidRow(box(
                uiOutput("selectedFacilityTime")
              ))),
      tabItem(tabName = "service",
              fluidRow(box(
                uiOutput("selectedFacilityYyCases")
              )))
    ))
  )

  server <- function(input, session, output) {
    output$renderedSelectedFacilityTime <- renderPlot({
      random_ggplot(type = "line")
    })
    output$selectedFacilityTime <- renderUI({
      plotOutput("renderedSelectedFacilityTime")
    })

    output$renderedFacilityYyCases <- renderPlot({
      random_ggplot(type = "bar")
    })
    output$selectedFacilityYyCases <- renderUI({
      plotOutput("renderedFacilityYyCases")
    })

    output$tabSelector <- renderMenu({
      sidebarMenu(id = "test",
                  menuItem(
                    text = "Chart data",
                    menuSubItem(
                      text = "Facilities",
                      tabName = "facilities",
                      selected = TRUE
                    ),
                    menuSubItem(
                      text = "Service & Specialty",
                      tabName = "service",
                      selected = FALSE,
                      icon = NULL
                    )
                  ))
    })

    make_menu <- reactive({
      cat("Current submenu selected: ", input$test, "\n\n")

      if (req(input$test) == "facilities") {
      sidebarMenu(
        menuItem(
          text = "VHA data",
          menuSubItem(
            text = "None",
            selected = TRUE,
            icon = NULL
          ),
          menuSubItem(text = "Mean", icon = NULL)
        )
      )
      } else {
        # return an empty HTML container
        div()
      } 
    })

    output$plotDataVHA <- renderMenu({
        make_menu()
    })

  }

  shinyApp(ui, server)

来源：https://stackoverflow.com/questions/57598536/how-to-create-a-conditional-renderui-in-shiny-dashboard

标签

shinydashboard