添加用于过滤目的的复选框功能

Question

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

在名为 phones 的输入中，有一个名为 Yes 的选项。当勾选 Yes 时，它会将其限制为 df 中的任何人，其 phone 的字段不是 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")
    )
  ))

server.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)
    }
  )
  
}

Answer 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)

添加用于过滤目的的复选框功能

Adding the Checkbox feature for filtering purposes

r

shiny

shiny-server

shiny-reactivity