时间戳

首页 > 解决方案 > r Shiny：使用复选框发出过滤数据

r - r Shiny：使用复选框发出过滤数据

问题描述

在我闪亮的应用程序中，我使用复选框来过滤我的数据。考虑我有一个带有集合和颜色的数据框的示例：集合 1 包含红色和黄色，集合 2 仅包含红色，集合 3 仅包含黄色。

当我现在按红色和黄色过滤我的数据时，它返回 set2（仅包含红色）、set 3（仅包含黄色）和包含两者的 set1。但是，我想要的输出是选择红色和黄色只会返回包含两种颜色的组（set1）。

我希望返回的组与我的复选框选择完全匹配。即仅检查红色将返回仅包含红色的组，仅检查黄色将返回仅包含黄色的组，检查红色和黄色将返回包含红色和黄色的组。

此示例的代码（这是我的应用程序的简化版本）如下：

我的服务器：

library(dplyr)
library(shiny)
shinyServer(function(input, output) {

  data <- structure(list(Set = c("Set1", "Set1", "Set1", "Set2", "Set2", 
                             "Set2", "Set3", "Set3", "Set3", "Set4"), Colour = c("red", "red", 
                                                                                 "yellow", "red", "red", "red", "yellow", "yellow", "yellow", 
                                                                                 "blue")), class = "data.frame", row.names = c(NA, -10L))

  output$choose_colour <- renderUI({

    colour.names <- as.vector( unique(data$Colour ))

    checkboxGroupInput("colours", "Choose Colours to Include", 
                       choices  = colour.names)
  })

  model.data <- reactive({

    filtered_data <- data %>% group_by(Set) %>% filter(all(Colour%in% input$colours))
    filtered_data

  })

  output$filteredData <- renderDataTable({
    filtered_data <- model.data()
    filtered_data
  })

})

我的用户界面：

ui <- fluidPage(


 mainPanel(
  uiOutput('choose_colour'),
  
 
  dataTableOutput('filteredData')
  
)
)

标签： rshiny

解决方案

我改变了顺序并为所有人更改了任何

library(dplyr)
library(shiny)
library(purrr)
server <- shinyServer(function(input, output) {
  
  data <- structure(list(Set = c("Set1", "Set1", "Set1", "Set2", "Set2", 
                                 "Set2", "Set3", "Set3", "Set3", "Set4"), Colour = c("red", "red", 
                                                                                     "yellow", "red", "red", "red", "yellow", "yellow", "yellow", 
                                                                                     "blue")), class = "data.frame", row.names = c(NA, -10L))
  
  output$choose_colour <- renderUI({
    
    colour.names <- as.vector( unique(data$Colour ))
    
    checkboxGroupInput("colours", "Choose Colours to Include", 
                       choices  = colour.names)
  })
  
  model.data <- reactive({
    
    filtered_data <- data %>% group_by(Set) %>% filter(all(Colour %in% input$colours) & all(input$colours %in%Colour))
    filtered_data
    
  })
  
  output$filteredData <- renderDataTable({
    filtered_data <- model.data()
    filtered_data
  })
  
})

ui <- fluidPage(
  
  
  mainPanel(
    uiOutput('choose_colour'),
    
    
    dataTableOutput('filteredData')
    
  )
)

shinyApp(ui,server)

推荐阅读