【发布时间】:2022-01-07 09:55:24
【问题描述】:
我正在构建一个闪亮的应用程序,我正在尝试在其中实现一个复选框类型的过滤器。
在名为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")
)
))
服务器.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