shiny - 侧边栏中的过滤选项

Question

在下面的示例代码（ui.R）中，我们可以在侧边栏中添加过滤选项。例如，如果您单击边栏中的仪表板，则过滤选项应低于该选项

用户界面

library(shinydashboard)


ui = sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Widgets", icon = icon("th"), tabName = "widgets",
             badgeLabel = "new", badgeColor = "green")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "dashboard",
            h2("Dashboard tab content")
    ),

    tabItem(tabName = "widgets",
            h2("Widgets tab content")
    )
  )
)

# Put them together into a dashboardPage
dashboardPage(
  dashboardHeader(title = "Simple tabs"),
  sidebar,
  body
)

标签： shiny

Answer 1

你可以做的事情有很多。请参阅下面的两个示例脚本，以了解有关在 Shiny 世界中使用过滤器的可能性的一些想法。

使用组合框过滤：

library(shiny)
library(dplyr)

data(tips, package = "reshape2")
filter_vars <- c("sex", "smoker", "day", "time")

ui <- fluidPage(
  lapply(filter_vars, function(var) {
    selectInput(var, var, unique(tips[[var]]), multiple = TRUE)
  }),
  tableOutput("table")
)

server <- function(input, output, session) {
  my_filter <- function(data, var) {
    if (length(input[[var]]) == 0) return(data)
    data %>% subset(data[[var]] %in% input[[var]])
  }  

  subsettedData <- reactive({
    tips %>% my_filter("sex") %>% my_filter("smoker") %>% 
      my_filter("day") %>% my_filter("time")
  })

  observeEvent(subsettedData(), {
    lapply(filter_vars, function(var) {
      selections <- unique(subsettedData()[[var]])
      if (length(input[[var]]) == 0)
        updateSelectInput(session, var, choices = selections)
    })
  })   

  output$table <- renderTable({ subsettedData() })
}

shinyApp(ui, server)

键入时过滤：

library(shinydashboard)
library(DT)

df <- mtcars

header <- dashboardHeader(
  title = "Test"
)

sidebar <- dashboardSidebar(
)

body <- dashboardBody(
  box(title = "Test", width = 7, status = "warning", DT::dataTableOutput("df"))
)

# UI
ui <- dashboardPage(header, sidebar, body)

# Server
server <- function(input, output, session) {

  output$df = DT::renderDataTable(df, rownames = FALSE,
                                  options = list(
                                    autoWidth = TRUE,
                                    columnDefs = list(list(width = '10px', targets = c(1,3)))))
}

# Shiny dashboard
shiny::shinyApp(ui, server)