【问题标题】:Adding the Checkbox feature for filtering purposes添加复选框功能以进行过滤
【发布时间】:2022-01-07 09:55:24
【问题描述】:

我正在构建一个闪亮的应用程序,我正在尝试在其中实现一个复选框类型的过滤器。

在名为phones 的输入中,有一个名为Yes 的选项。当Yes 被勾选时,它将限制为dfphone 字段不为NA 的任何人。当它没有被勾选时,它将包括phone下的所有字段,不管它是否NA。

我得到的错误:

Warning: Error in : Problem with `filter()` input `..1`. ℹ Input `..1` is `&...`. x `input$phones == "Yes" ~ !is.na(temp_data$phone)`, `TRUE ~ !is.na(temp_data$phone) & is.na(temp_data$phone)` must be length 0 or one, not 10000

global.R:

library(civis)
library(dbplyr)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(DT)

df <- read.csv('https://raw.githubusercontent.com/datacfb123/testdata/main/sampleset_df.csv')

ui.R

ui <- fluidPage(
  titlePanel("Sample"),
  sidebarLayout(
    sidebarPanel(
      selectizeInput("data1", "Select State", choices = c("All", unique(df$state))),
      selectizeInput("data2", "Select County", choices = NULL),
      selectizeInput("data3", "Select City", choices = NULL),
      selectizeInput("data4", "Select Demo", choices = c("All", unique(df$demo))),
      selectizeInput("data5", "Select Status", choices = c("All", unique(df$status))),
      sliderInput("age", label = h3("Select Age Range"), 18, 
                  35, value = c(18, 20), round = TRUE, step = 1),
      sliderInput("score1", label = h3("Select Score1 Range"), min = 0,
                  max = 100, value = c(20,80)),
      sliderInput("score2", label = h3("Select Score2 Range"), min = 0,
                  max = 100, value = c(20,80)),
      prettyCheckboxGroup("phones", h3("Only Include Valid Phone Numbers?"), selected = "Yes", choices = list("Yes")),
      downloadButton("download", "Download Data")
    ),
    mainPanel(
      DTOutput("table")
    )
  ))

服务器.R:

    server <- function(input, output, session){
  
  observeEvent(input$data1, {
    if (input$data1 != "All") {
      updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county[df$state == input$data1])))
    } else {
      updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county)))
    }
  }, priority = 2)
  
  observeEvent(c(input$data1, input$data2), {
    if (input$data2 != "All") {
      updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$county == input$data2])))
    } else {
      if (input$data1 != "All") {
        updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$state == input$data1])))
      } else {
        updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city)))
      }
    }
  }, priority = 1)
  
  filtered_data <- reactive({
    temp_data <- df
    if (input$data1 != "All") {
      temp_data <- temp_data[temp_data$state == input$data1, ]
    }
    if (input$data2 != "All") {
      temp_data <- temp_data[temp_data$county == input$data2, ]
    }
    if (input$data3 != "All") {
      temp_data <- temp_data[temp_data$city == input$data3, ]
    }
    if (input$data4 != "All") {
      temp_data <- temp_data[temp_data$demo == input$data4, ]
    }
    if (input$data5 != "All") {
      temp_data <- temp_data[temp_data$status == input$data5, ]
    }
    
    temp_data %>% filter(temp_data$age >= input$age[1] &
                       temp_data$age <= input$age[2] &
                       temp_data$score1 >= input$score1[1] &
                       temp_data$score1 <= input$score1[2] &
                       temp_data$score2 >= input$score2[1] &
                       temp_data$score2 <= input$score2[2] &
                       case_when(input$phones == 'Yes' ~ !is.na(temp_data$phone), 
                                 # For a default value, use TRUE ~
                                 TRUE ~ !is.na(temp_data$phone) & is.na(temp_data$phone)))
    
  })
  
  output$table <- renderDT(
    filtered_data() %>% select(unique_id, first_name, last_name, phone)
  )
  
  output$download <- downloadHandler(
    filename = function() {
      paste("universe", "_", date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(filtered_data() %>% select(unique_id, first_name, last_name, phone) %>% distinct_all(), file, row.names = FALSE)
    }
  )
  
}

【问题讨论】:

    标签: r shiny shiny-server shiny-reactivity


    【解决方案1】:

    而不是case_when,使用if () else () 可能更合适。此外,当您的prettyCheckboxGroup 未选中时,值为NULL,您需要处理它。试试这个

    library(dbplyr)
    library(dplyr)
    library(shiny)
    library(shinyWidgets)
    library(DT)
    
    df <- read.csv('https://raw.githubusercontent.com/datacfb123/testdata/main/sampleset_df.csv')
    
    ui <- fluidPage(
      titlePanel("Sample"),
      sidebarLayout(
        sidebarPanel(
          selectizeInput("data1", "Select State", choices = c("All", unique(df$state))),
          selectizeInput("data2", "Select County", choices = NULL),
          selectizeInput("data3", "Select City", choices = NULL),
          selectizeInput("data4", "Select Demo", choices = c("All", unique(df$demo))),
          selectizeInput("data5", "Select Status", choices = c("All", unique(df$status))),
          sliderInput("age", label = h3("Select Age Range"), 18, 
                      35, value = c(18, 20), round = TRUE, step = 1),
          sliderInput("score1", label = h3("Select Score1 Range"), min = 0,
                      max = 100, value = c(20,80)),
          sliderInput("score2", label = h3("Select Score2 Range"), min = 0,
                      max = 100, value = c(20,80)),
          prettyCheckboxGroup("phones", h3("Only Include Valid Phone Numbers?"), selected = "Yes", choices = list("Yes")),
          downloadButton("download", "Download Data")
        ),
        mainPanel(
          DTOutput("table")
        )
      )
    )
    
    server <- function(input, output, session){
      #observe({print(input$phones)})
      observeEvent(input$data1, {
        if (input$data1 != "All") {
          updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county[df$state == input$data1])))
        } else {
          updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county)))
        }
      }, priority = 2)
      
      observeEvent(c(input$data1, input$data2), {
        if (input$data2 != "All") {
          updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$county == input$data2])))
        } else {
          if (input$data1 != "All") {
            updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$state == input$data1])))
          } else {
            updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city)))
          }
        }
      }, priority = 1)
      
      filtered_data <- reactive({
        temp_data <- df
        if (input$data1 != "All") {
          temp_data <- temp_data[temp_data$state == input$data1, ]
        }
        if (input$data2 != "All") {
          temp_data <- temp_data[temp_data$county == input$data2, ]
        }
        if (input$data3 != "All") {
          temp_data <- temp_data[temp_data$city == input$data3, ]
        }
        if (input$data4 != "All") {
          temp_data <- temp_data[temp_data$demo == input$data4, ]
        }
        if (input$data5 != "All") {
          temp_data <- temp_data[temp_data$status == input$data5, ]
        }
        
        df2 <- temp_data %>% dplyr::filter(temp_data$age >= input$age[1] &
                               temp_data$age <= input$age[2] &
                               temp_data$score1 >= input$score1[1] &
                               temp_data$score1 <= input$score1[2] &
                               temp_data$score2 >= input$score2[1] &
                               temp_data$score2 <= input$score2[2]) #&
                               # case_when(input$phones == 'Yes' ~ !is.na(temp_data$phone), 
                               #           # For a default value, use TRUE ~
                               #           TRUE ~ !is.na(temp_data$phone) & is.na(temp_data$phone))
                               #) 
        
        df3 <- if (is.null(input$phones)) df2 else df2 %>%  dplyr::filter(!is.na(phone))
        df3 %>% dplyr::select(unique_id, first_name, last_name, phone)
      })
      
      output$table <- renderDT(
        filtered_data() 
      )
      
      output$download <- downloadHandler(
        filename = function() {
          paste("universe", "_", date(), ".csv", sep="")
        },
        content = function(file) {
          write.csv(filtered_data() %>% distinct_all(), file, row.names = FALSE)
        }
      )
      
    }
    
    shinyApp(ui, server)
    

    【讨论】:

    猜你喜欢
    • 2013-02-21
    • 2017-10-11
    • 2021-11-07
    • 2016-09-26
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-07-06
    相关资源
    最近更新 更多