微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

根据选择输入值过滤 Shiny Dashboad 中的数据表

如何解决根据选择输入值过滤 Shiny Dashboad 中的数据表

以下是完整的可重现代码。我想根据 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

从 ui 调用分支输入 ,

这是一个应该对您有所帮助的通用示例。

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)

enter image description here

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。