Adding the Checkbox feature for filtering purposes

I'm building a Shiny app in which I'm trying to implement a checkbox type filter.

In the input called phones There is one option titled Yes. When Yes is ticked off, it will limit it to anyone in df whose field for phone IS NOT NA. When it's not checked off, it will include all fields under phone regardless if its NA or not.

The error I get:

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

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.