ShinyApp 中的动态过滤

Question

我刚刚开始学习 ShinyApp 并正在尝试创建一个 table 其值可以动态过滤。

我想要的结果

<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

我的代码创建了一个 table 但不基于 select 输入 selection 进行过滤。还有一种方法可以添加操作按钮，因此 table 仅在点击操作按钮时反映新的 select 输入参数引起的变化？

任何帮助将不胜感激！

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)

ShinyApp 中的动态过滤

Dynamic filtering in ShinyApp

r

shiny

shinydashboard

reactive