ShinyApp 中的动态过滤

Question

我刚刚开始学习 ShinyApp，正在尝试创建一个可以动态过滤值的表。

我想要的结果

<filter>GlassSupplier Supplier1
WindowType        AverageBreakageRate
Aluminum                  3.63
Wood                      7.22  

我得到的结果。

<filter>GlassSupplier Supplier1
WindowType        AverageBreakageRate
Aluminum                  2.815
Vinyl                     6.165
Wood                      7.22  

enter image description here

我的代码创建了一个表，但没有根据选择输入选择进行过滤。还有一种方法可以添加一个操作按钮，因此只有在点击操作按钮时，表格才会反映由于新的选择输入参数而导致的变化？

任何帮助将不胜感激！

library(shiny)
library(dplyr)
library(readxl)


ui <- fluidPage(
  titlePanel("title panel"),
  sidebarLayout(position = "left",
                sidebarPanel("sidebar panel",
                             selectInput(inputId = "table",
                                         label = "Choose a Supplier",
                                         "Names"),
                ),
                mainPanel("main panel",
                          tableOutput("myTable")
                )))

server <- function(input, output,session) 
{
  GlassSupplier <- c('Supplier 1','Supplier 2','Supplier 1','Supplier 4','Supplier 2')
  WindowType <- c('Wood','Vinyl','Aluminum','Aluminum','Vinyl')
  BreakageRate <- c(7.22,6.33,3.63,2,6)
  df<- data.frame(GlassSupplier,WindowType,BreakageRate)
   data <- reactive({
    req(input$table)
    dframe <- df %>%  group_by(WindowType) %>% summarise(BrkRate = mean(BreakageRate))
  })
  
  #Update SelectInput Dynamically
  observe({
    updateSelectInput(session, "table", choices = df$GlassSupplier)
  })
  
  output$myTable = renderTable({
    data()
  })
}
shinyApp(ui,server)

Answer 1

您只需要filter。要使actionButton 工作，只需将reactive() 更改为eventReactive() 对象。试试这个

library(shiny)
library(dplyr)
library(readxl)

ui <- fluidPage(
  titlePanel("title panel"),
  sidebarLayout(position = "left",
                sidebarPanel("sidebar panel",
                             selectInput(inputId = "table",
                                         label = "Choose a Supplier",
                                         "Names"),
                             actionButton(inputId = "btn",label="Update")
                ),
                mainPanel("main panel",
                          tableOutput("myTable")
                )))

server <- function(input, output,session)
{
  GlassSupplier <- c('Supplier 1','Supplier 2','Supplier 1','Supplier 4','Supplier 2')
  WindowType <- c('Wood','Vinyl','Aluminum','Aluminum','Vinyl')
  BreakageRate <- c(7.22,6.33,3.63,2,6)
  df<- data.frame(GlassSupplier,WindowType,BreakageRate)
  data <- eventReactive(input$btn, {
    req(input$table)
    df %>% dplyr::filter(GlassSupplier %in% input$table) %>%
      group_by(WindowType) %>%
      dplyr::summarise(BrkRate = mean(BreakageRate))
  })

  #Update SelectInput Dynamically
  observe({
    updateSelectInput(session, "table", choices = df$GlassSupplier)
  })

  output$myTable = renderTable({
    data()
  })
}
shinyApp(ui,server)