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