问题描述
以下是完整的可重现代码。我想根据 selectInput 值过滤值。如果用户选择 north Branch,则数据表应显示仅包含 north Branch 的列和行。我如何在 ShinyDashoard 中做到这一点?
谢谢。
# DF
branch <- c("north","South","north","north")
cars <- c("Toyota","Nissan","BMW","Ford","Toyota","Nissan")
insured <- c("Yes","Yes","No","No")
price <- c(21000,23400,26800,21000,21000)
salesDF <- data.frame(branch,cars,insured,price)
carBranch <- unique(salesDF$branch)
library(shiny)
library(DT)
library(shinydashboard)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Car Sales"),# Sidebar with the selectInput Slider
sidebarLayout(
Box(width = 4,selectInput(inputId = "Branch",label = "Select Branch",choices = carBranch,selected = carBranch)),# Show the DataTable
mainPanel(
Box(title = "Car Sales",width = 7,height=NULL,solidHeader = T,status = "warning",DTOutput("carBranch"))
)
)
)
# Define server logic required to draw a histogram
server <- function(input,output) {
output$carBranch <- renderDT(
salesDF,options = list(searching=F)
)
}
# Run the application
shinyApp(ui = ui,server = server)
解决方法
您必须在 server
组件中添加一个过滤器,其中选择来自 ui
,如下所示:
server <- function(input,output) {
output$carBranch <- renderDT(
salesDF[salesDF$branch==input$Branch,],options = list(searching=F)
)
}
可以使用 input$Branch
这是一个应该对您有所帮助的通用示例。
require(shiny)
require(ggplot2)
ui <- fluidPage(
titlePanel("Car Weight"),br(),uiOutput(outputId = "cylinders"),sidebarLayout(
mainPanel(
tableOutput("table"),uiOutput(outputId = "dataFilter"),actionButton(inputId = "update1",label = "Apply Filters"),width = 9
),sidebarPanel(
actionButton(inputId = "update2",uiOutput(outputId = "modelFilter"),actionButton(inputId = "update3",width = 3
)
)
)
server <- function(input,output) {
# Read data. Real code will pull from database.
df <- mtcars
df$model <- row.names(df)
df <- df[order(df$model),c(12,1,2,3,4,5,6,7,8,9,10,11)]
# Get cylinders
output$cylinders <- renderUI({
selectInput(
inputId = "cyl",label = "Select Cylinders",choices = c("",as.character(unique(df$cyl)))
)})
# Check if data frame has been updated.
values <- reactiveValues(update = 0)
# Subset data by cyl.
df2 <-
reactive({
values$update <- 0
df2 <- droplevels(df[df$cyl == input$cyl,])})
# Filter data.
df3 <-
eventReactive({
input$update1
input$update2
input$update3
df2()
},{
if (values$update > 0) {
req(input$modelFilter)
modelFilterDf <-
data.frame(model = input$modelFilter)
df3a <-
merge(df2(),modelFilterDf,by = "model")
df3a <- df3a[df3a$wt >= input$dataFilter[1] &
df3a$wt <= input$dataFilter[2],]
} else {
df3a <- df2()
}
values$update <- values$update + 1
df3a
},ignoreNULL = FALSE,ignoreInit = TRUE)
# Plot table.
output$table <- renderTable(df3())
# Filter by data value.
output$dataFilter <-
renderUI({
req(df2()$wt[1])
sliderInput(
inputId = "dataFilter",label = "Filter by Weight (1000 lbs)",min = floor(min(df2()$wt,na.rm = TRUE)),max = ceiling(max(df2()$wt,value = c(floor(min(df2()$wt,ceiling(max(df2()$wt,na.rm = TRUE))),step = round(max(df2()$wt,na.rm = TRUE) - min(df2()$wt,na.rm = TRUE)) / 100,round = round(log((
max(df2()$wt,na.rm = TRUE)
) / 100))
)
})
# Filter by lot / wafer.
output$modelFilter <- renderUI({
req(input$cyl)
checkboxGroupInput(
inputId = "modelFilter",label = "Filter by Model",choices = as.character(unique(df2()$model)),selected = as.character(unique(df2()$model))
)
})
}
# Run shiny.
shinyApp(ui = ui,server = server)