Adding the Checkbox feature for filtering purposes-CodePudding

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

CodePudding user response：

Instead of case_when, it may be more appropriate to use if () else (). Also, when your prettyCheckboxGroup is unchecked, the value is NULL, and you need to handle that. Try this

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)