如何解决R Shiny 如何为 Dataframe 创建从属过滤器
我需要创建一个应用程序，在其中过滤数据框中的多个字段。当第一个字段被过滤（使用日期范围）时，用户必须在数据显示在表格中之前过滤几个选择器输入。我不确定这是否是创建相关过滤器的最佳方式。我似乎找不到足够的资源。我尝试了以下方法。但是，我不确定为什么我不断收到此警告::
警告：错误：filter() 输入“..1”有问题 X 输入 '..1' 的大小必须是 100 或 1，而不是大小 0
get_data <- function(size){
longs <- seq(from=40,to =90,by = 0.01)
lats <- seq(from = 5,to= 50,by = 0.01)
LONGITUDE <- sample(longs,size,rep = TRUE)
LATITUDE <- sample(lats,rep = TRUE)
df <- data.frame(cbind(LONGITUDE,LATITUDE))
df$LOCATION <- sample(c("Location_A","Location_B","Location_C"),replace = T,prob = c(0.4,0.4,0.2))
df$EQUIPMENT <- sample(c("Equipment_A","Equipment_B","Equipment_C","Equipment_D"),replace = TRUE)
startTime <- as.POSIXct("2016-01-01")
endTime <- as.POSIXct("2019-01-31")
df$DATE <- as.Date(sample(seq(startTime,endTime,1),size))
df$WEEKDAY <- weekdays(as.Date(df$DATE))
return(df)
}
df <-get_data(100)
ui <- navbarPage(
id = "navBar",title = "Data Exploration",theme = shinytheme("cerulean"),shinyjs::useShinyjs(),selected = "Data",tabPanel("Data",fluidPage(
sidebarPanel(
div(id = "form",uIoUtput('timestamp'),uIoUtput('location'),uIoUtput('days_of_week'),uIoUtput('equipment_type'),hr(),HTML("<h3>Reset your filter settings here:</h3>"),actionButton("resetAll","Reset Entries"),hr()),mainPanel(
DT::DTOutput("datatable"))))
)
)#end the ui
server <- function(session,input,output){
filter_data <- reactive({
df %>%
filter(DATE >= input$timestamp[1] & DATE <= input$timestamp[2]) %>%
filter(LOCATION %in% input$location) %>%
filter(WEEKDAY %in% input$days_of_week) %>%
filter(EQUIPMENT %in% input$equipment_type)
})
output$timestamp <- renderUI({
daterangeInput('timestamp',label = 'Date range input:',start = min(df$DATE),end = max(df$DATE))
})
output$location <- renderUI({
location <- reactive({
df %>%
filter(DATE >= input$timestamp[1] & DATE <= input$timestamp[2]) %>%
pull(LOCATION) %>%
as.character() %>% unique()
})
pickerInput('location',"Select Location:",choices = location(),selected = NULL,options = list(`actions-Box` = TRUE),multiple = T)
})
output$days_of_week <- renderUI({
days_of_week <- reactive({
df %>%
filter(DATE >= input$timestamp[1] & DATE <= input$timestamp[2]) %>%
filter(LOCATION %in% input$location) %>%
pull(WEEKDAY) %>%
as.character() %>% unique()
})
pickerInput('days_of_week','Choose Weekdays:',choices=days_of_week(),multiple = T)
})
output$equipment_type <- renderUI({
equipment <- reactive({
df %>%
filter(DATE >= input$timestamp[1] & DATE <= input$timestamp[2]) %>%
filter(LOCATION%in% input$location) %>%
filter(WEEKDAY %in% input$days_of_week) %>%
pull(EQUIPMENT) %>%
as.character() %>% unique()
})
pickerInput('equipment_type',"Choose Equipment:",choices = equipment(),multiple = T)
})
output$datatable <- DT::renderDT({
filter_data()
})
#Allow the user to reset all their inputs
observeEvent(input$resetAll,{
reset("form")
})
}
shinyApp(ui,server)
解决方法
我认为您的警告是由于 input$timestamp 在您创建 dateRangeInput 之前第一次在您的反应式表达式中为 NULL。
您可以将 input 移动到 ui，然后在日期更改时使用 updatePickerInput 以相应地更改您的其他输入。
您可能想要包含两个单独的 reaction 表达式。一个用于根据日期范围过滤数据，这将用于更新其他选择器。第二个将包括基于选择器选择的位置、设备和工作日的其他过滤器。
看看这是否提供了更接近您正在寻找的东西。我在顶部包含了似乎是相关的包。我还稍微调整了 ui 中的括号。
library(shinythemes)
library(shinyWidgets)
library(shinyjs)
library(shiny)
library(dplyr)
get_data <- function(size){
longs <- seq(from=40,to =90,by = 0.01)
lats <- seq(from = 5,to= 50,by = 0.01)
LONGITUDE <- sample(longs,size,rep = TRUE)
LATITUDE <- sample(lats,rep = TRUE)
df <- data.frame(cbind(LONGITUDE,LATITUDE))
df$LOCATION <- sample(c("Location_A","Location_B","Location_C"),replace = T,prob = c(0.4,0.4,0.2))
df$EQUIPMENT <- sample(c("Equipment_A","Equipment_B","Equipment_C","Equipment_D"),replace = TRUE)
startTime <- as.POSIXct("2016-01-01")
endTime <- as.POSIXct("2019-01-31")
df$DATE <- as.Date(sample(seq(startTime,endTime,1),size))
df$WEEKDAY <- weekdays(as.Date(df$DATE))
return(df)
}
df <-get_data(100)
ui <- navbarPage(
id = "navBar",title = "Data Exploration",theme = shinytheme("cerulean"),shinyjs::useShinyjs(),selected = "Data",tabPanel("Data",fluidPage(
sidebarPanel(
div(id = "form",dateRangeInput('timestamp',label = 'Date range input:',start = min(df$DATE),end = max(df$DATE)),pickerInput('location',"Select Location:",choices = unique(df$LOCATION),options = list(`actions-box` = TRUE),multiple = T),pickerInput('days_of_week','Choose Weekdays:',choices = unique(df$WEEKDAY),pickerInput('equipment_type',"Choose Equipment:",choices = unique(df$EQUIPMENT),hr(),HTML("<h3>Reset your filter settings here:</h3>"),actionButton("resetAll","Reset Entries"),hr())
),mainPanel(
DT::DTOutput("datatable")))
)
)#end the ui
server <- function(session,input,output){
filter_by_dates <- reactive({
filter(df,DATE >= input$timestamp[1] & DATE <= input$timestamp[2])
})
filter_by_all <- reactive({
fd <- filter_by_dates()
if (!is.null(input$location)) {
fd <- filter(fd,LOCATION %in% input$location)
}
if (!is.null(input$days_of_week)) {
fd <- filter(fd,WEEKDAY %in% input$days_of_week)
}
if (!is.null(input$equipment_type)) {
fd <- filter(fd,EQUIPMENT %in% input$equipment_type)
}
return(fd)
})
observeEvent(input$timestamp,{
updatePickerInput(session,'location',choices = unique(filter_by_dates()$LOCATION),selected = input$location)
updatePickerInput(session,'days_of_week',choices = unique(filter_by_dates()$WEEKDAY),selected = input$days_of_week)
updatePickerInput(session,'equipment_type',choices = unique(filter_by_dates()$EQUIPMENT),selected = input$equipment_type)
})
output$datatable <- DT::renderDT({
filter_by_all()
})
#Allow the user to reset all their inputs
observeEvent(input$resetAll,{
reset("form")
})
}
shinyApp(ui,server)
编辑 (1/28/21)：根据评论，似乎有兴趣根据所做的选择更新所有输入选项。
如果将 observeEvent 替换为 observe，并在三个 filter_by_all() 中使用 filter_by_date() 代替 updatePickerInput，则所有非日期输入选项每当对任何输入进行任何更改时都会更新：
observe({
input$timestamp
updatePickerInput(session,choices = unique(filter_by_all()$LOCATION),choices = unique(filter_by_all()$WEEKDAY),choices = unique(filter_by_all()$EQUIPMENT),selected = input$equipment_type)
})
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。