如何在闪亮的仪表板侧边栏中的 menuItem 或固定框下创建 checkBoxGroup 项？

Posted 2023-03-22

【中文标题】如何在闪亮的仪表板侧边栏中的 menuItem 或固定框下创建 checkBoxGroup 项？

【英文标题】：How to create a checkBoxGroup item under a menuItem or fixed box in shiny dashboard sidebar?

【发布时间】：2021-09-22 22:49:39

【问题描述】：

我正在创建一个闪亮的仪表板，在正文中显示数据表。我正在尝试在带有过滤数据表的复选框组的一侧添加一个侧边栏。现在复选框显示但标题和选项名称丢失。如果我不使用侧边栏并将复选框放在仪表板正文中，它会显示。但我试图放在侧边栏或固定在页面的一侧。

library(shiny)
library(shinydashboard)
library(tidyverse)



df <- mpg


header <- dashboardHeader(
    title = "NSCLC Market Share"
)

body <- dashboardBody(
    
    fluidRow(
        column(width = 9,
               tabBox(width = NULL,
                      title = "MarketShare",
                      id = "tabset1", height = "250px",
                      tabPanel("Incidence", 
                               tableOutput('mpg_tbl'),
                               br(),
                      tabPanel("Prevalence", "Tab content 2")
               )
               
        )
    )
))

sidebar <- dashboardSidebar(box(width = NULL, status = "warning",
                                
                                checkboxGroupInput('modelFilter', "Select model",
                                                   choices = 
                                                       unique(df$model),
                                                   selected = unique(df$model)
                                )),
                            br(),
                            box(width = NULL, status = "warning",
                                uiOutput("classFilter"),
                                checkboxGroupInput('classFilter', "Select class",
                                                   choices = unique(df$class),
                                                   selected = unique(df$class)
                                ))
)



ui <- dashboardPage(
    header,
    sidebar,
    body
)

server = function(input, output) 
    
    filtData <- reactive(
        
        df %>% 
            filter(model %in% input$modelFilter) %>% 
            filter(class %in% input$classFilter ) %>% 
            group_by(manufacturer) %>% 
            summarise(count = n())
        
    )
    
    
    
    
    output$mpg_tbl <- renderTable(
        filtData()
        
        
    )
    
    


# Run the application 
shinyApp(ui = ui, server = server)

【参考方案1】：

这个问题是因为box，如果你删除它就可以了-

library(shiny)
library(shinydashboard)
library(tidyverse)

df <- mpg

header <- dashboardHeader(
  title = "NSCLC Market Share"
)

body <- dashboardBody(
  
  fluidRow(
    column(width = 9,
           tabBox(width = NULL,
                  title = "MarketShare",
                  id = "tabset1", height = "250px",
                  tabPanel("Incidence", 
                           tableOutput('mpg_tbl'),
                           br(),
                           tabPanel("Prevalence", "Tab content 2")
                  )
                  
           )
    )
  ))

sidebar <- dashboardSidebar(checkboxGroupInput('modelFilter', "Select model",
                                                   choices = 
                                                     unique(df$model),
                                                   selected = unique(df$model)
                                ),
                            br(),
                            checkboxGroupInput('classFilter', "Select class",
                                               choices = unique(df$class),
                                               selected = unique(df$class)
                            )
)



ui <- dashboardPage(
  header,
  sidebar,
  body
)

server = function(input, output) 
  
  filtData <- reactive(
    
    df %>% 
      filter(model %in% input$modelFilter) %>% 
      filter(class %in% input$classFilter ) %>% 
      group_by(manufacturer) %>% 
      summarise(count = n())
    
  )

  output$mpg_tbl <- renderTable(
    filtData()
  )


# Run the application 
shinyApp(ui = ui, server = server)