Question

问题是我想在侧栏中使用列表填充menuItem。但是，我必须单击Click to Load CWE Titles“menuItem，然后单击任何其他menuItem以填充它。

我希望能够隐藏列表：

library(shinydashboard)

cwetitles <- c("criosphinx","bibliophilic","billing","rudolf",
    "overromanticizing","nonunderstandable","carboniferous","wan",
    "calcanei","inimically","unenlivening","scissure","flamboyantly",
    "hypotonicity","impressionableness","coligny","attender",
    "perspective","enumclaw","diddicoy")

ui <- dashboardPage(
dashboardHeader(title ="CVE Reporting Dashboard", titleWidth = 350),
dashboardSidebar(
sidebarMenu(id = "tabs",
    menuItem("Overview", tabName="summary", icon=icon("info-circle")),
    menuItem("Dashboard", tabName = "dashboard", icon=icon("dashboard")),
    menuItem("Charts", tabName = "charts", icon = icon("bar-chart-o")),
    menuItem("Click to View CVE Category", icon = icon("info-circle"),
    menuSubItem("General CVEs",icon=icon("th"),tabName ="cvetable"),
    menuSubItem("Web Applications CVEs",icon=icon("th"),tabName ="WASC")
  ),
    actionButton(inputId="clearAll", label="Clear selection", icon=icon("square-o"),style="color:#fff; background-color:#337ab7; border-color: #2e6da4"),
    actionButton(inputId="selectAll", label="Select all", icon=icon("check-square-o"),style="color:#fff; background-color: #337ab7; border-color: #2e6da4"),
    menuItem("Click to Load CWE Titles",tabName = "cwetitlesControl", icon = icon("th"), uiOutput("cwetitlesControl"), selected = TRUE)
    )
 ),      

dashboardBody(
tabItems(
    tabItem(tabName = "summary",includeMarkdown("about.md"))
)
)
)    

 server <- function(input, output) {

      # use a reactive value to represent group level selection
      values <- reactiveValues()
      values$cwetitles <- cwetitles
      # Create event type checkbox
      output$cwetitlesControl <- renderUI({
        withProgress(message = 'Calculation in progress',
                     detail = 'This may take a while...', value = 0, {
                       for (i in 1:15) {
                         incProgress(1/15)
                         Sys.sleep(0.25)
                       }
                     })
        checkboxGroupInput('cwetitles', 'CWE Titles:',choices = cwetitles, selected = values$cwetitles)
      })
}

shinyApp(ui, server)

Answer 1

感谢@rosscova提供了一些方向。这是我提出的解决方案，它的工作原理。

library(shinydashboard)

cwetitles <- c("criosphinx","bibliophilic","billing","rudolf",
               "overromanticizing","nonunderstandable","carboniferous","wan",
               "calcanei","inimically","unenlivening","scissure","flamboyantly",
               "hypotonicity","impressionableness","coligny","attender",
               "perspective","enumclaw","diddicoy")

ui <- dashboardPage(
  dashboardHeader(title ="CVE Reporting Dashboard", titleWidth = 350),
  dashboardSidebar(
    sidebarMenu(id = "tabs",
                menuItem("Overview", tabName="summary", icon=icon("info-circle")),
                menuItem("Dashboard", tabName = "dashboard", icon=icon("dashboard")),
                menuItem("Charts", tabName = "charts", icon = icon("bar-chart-o")),
                menuItem("Click to View CVE Category", icon = icon("info-circle"),
                         menuSubItem("General CVEs",icon=icon("th"),tabName ="cvetable"),
                         menuSubItem("Web Applications CVEs",icon=icon("th"),tabName ="WASC")
                ),
                actionButton(inputId="clearAll", label="Clear selection", icon=icon("square-o"),style="color:#fff; background-color:#337ab7; border-color: #2e6da4"),
                actionButton(inputId="selectAll", label="Select all", icon=icon("check-square-o"),style="color:#fff; background-color: #337ab7; border-color: #2e6da4"),
                menuItem("Click to Load CWE Titles",tabName = "cwetitlesControl", 
                         icon = icon("th"), checkboxGroupInput('cwetitles',
                                                               'CWE Titles:',
                                                               choices = cwetitles,
                                                               selected = cwetitles), selected = TRUE)
    )
  ),      

  dashboardBody()
) 

server = function(input, output, session) {
  values <- reactiveValues()
  values$cwetitles <- cwetitles

  observe({
    if(input$selectAll == 0) return()
    updateCheckboxGroupInput(session,'cwetitles','CWE Titles:', 
                             choices = cwetitles,
                             selected = values$cwetitles)
    #values$cwetitles <- cwetitles
  })

  observe({
    if(input$clearAll == 0) return()
    updateCheckboxGroupInput(session,'cwetitles','CWE Titles:',
                             choices = cwetitles,
                             selected = c())
    #values$cwetitles <- NULL # empty list
  })

}

shinyApp(ui, server)

R - 如何填充闪亮的仪表板侧栏menuItem

1 个答案: