如何在 Shiny 仪表板中创建条件渲染 UI答案

【问题标题】：How to create a conditional renderUI in Shiny dashboard如何在 Shiny 仪表板中创建条件渲染 UI
【发布时间】：2019-12-27 03:22:21
【问题描述】：

我无法通过 renderMenu 创建条件侧边栏菜单，因为 if 语句失败。 “警告：如果：参数长度为零时出错”。

我找到了conditional RenderUI R shiny 和Conditional panel in Shiny dashboard，但都不是我想要的。在这种情况下，条件面板可能会起作用，但从长远来看，我需要能够在服务器端执行此操作。

    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)
}

如果工作正常，菜单“VHA 数据”应该只在选择子菜单“设施”时可见。

【问题讨论】：

标签： r shinydashboard

【解决方案1】：

有趣的问题。您收到argument is of length zero 错误的原因是您正在通过renderMenu() 在服务器端呈现两个菜单。因此，当应用程序启动时，input$test 没有分配给它的值。您可以通过使用req() 来避免这种情况，它只会在input$test 启动后评估测试input$test == "facilities"。

现在菜单仅在选择另一个子菜单时出现，您希望创建独立于renderMenu() 的菜单。最好在正常的reactive() 中评估条件，然后将此反应函数作为输入传递给renderMenu()。最后，要在input$test == "facilities" 为FALSE 时移除菜单，可以渲染一个空的html 容器。

这是更新后的代码：

  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)

【讨论】：

感谢您对我问题的两个方面的详细回答。非常感谢。