为什么我在 R Shiny 中的 observeEvent() 调用在其中包含反应式表达式后不执行任何操作？

问题描述

我正在构建一个 Shiny 应用程序，用户可以在其中过滤掉某些项目。我希望项目名称仅出现在特定日期范围内时才出现在下拉列表中。

我已经能够填充 selectize 菜单，并且能够使用户可以选择所有项目或删除所有项目（从 answer 到我之前问过的一个问题）。但是，现在我正在尝试使这些名称对日期具有反应性，我之前问题中的 observeEvent 代码崩溃了。我试图将它包装在一个反应​​式表达式中，但没有任何反应。

如何使我的项目可按日期过滤，同时仍保持全选并删除所有功能？

library(shiny)
library(plotly)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets) 
library(dplyr)
library(htmltools)
library(lubridate)



ui = fluidPage(
    tabsetPanel(
        tabPanel("View 1",fluid = TRUE,sidebarLayout(
                     sidebarPanel(
                         h4("Select Your Desired Filters"),div(id = "inputs",daterangeInput(
                                 inputId = "date_filter",label = "Filter by Month and Year",start = today(),end = (today() + 90),min = "2021-04",max = NULL,format = "yyyy-mm",startview = "month",weekstart = 0,language = "en",separator = " to ",width = NULL,autoclose = TRUE
                             ),br()),h5("Include/Exclude Specific Projects"),selectizeInput(inputId = "filter_by_project",label = "Filter by Project",choices = sort(unique(test$project)),multiple = TRUE,selected = sort(unique(test$project))),actionButton(inputId = "remove_all",label = "Unselect All Projects",style = "color: #FFFFFF; background-color: #CA001B; border_color: #CA001B"),actionButton(inputId = "add_all",label = "Select All Projects",style = "color: #FFFFFF; background-color: #CA001B; border_color: #CA001B")
                     ),mainPanel(
                     )
                 )
        )
    )
)
server = function(input,output,session) {
    
#Here's the dataset
    test <- tibble(project = c("Justin","Corey","Sibley"),date = ymd(c("2021-04-20","2021-04-01","2021-05-05")),april_2021 = c(10,100,101),may_2021 = c(1,4,7))
    
#I want users to be able to filter the list of projects by date,which should update the selectize options
    test <- reactive({
        test %>%
            dplyr::filter(date >= input$date_filter[1],date <= input$date_filter[2])
    })
    
    
    observeEvent(input$remove_all,{reactive({
        updateSelectizeInput(session,"filter_by_project",choices=sort(unique(test()$project)),selected=NULL,options = list(placeholder="Please Select at Least One Project")
        )
    })
    })
    observeEvent(input$add_all,selected=sort(unique(test()$project)) )
    })
    })
    
}
shinyApp(ui = ui,server = server)

解决方法

你必须解决重大问题。首先是为您的输入 data.frame 和您的反应元素使用相同的名称。您将它们都称为 test，这会导致混淆您是尝试使用 data.frame 还是反应式对象。您应该使用不同的名称。第二个问题是您不需要为 reactive() 调用使用 observeEvents()。你只需要把你想运行的代码放在一个块中。

解决这些问题，您的服务器功能应该看起来更像这样

server = function(input,output,session) {
  
  #Here's the dataset
  testdata <- tibble(project = c("Justin","Corey","Sibley"),date = ymd(c("2021-04-20","2021-04-01","2021-05-05")),april_2021 = c(10,100,101),may_2021 = c(1,4,7))
  
  #I want users to be able to filter the list of projects by date,which should update the selectize options
  test <- reactive({
    testdata %>%
      dplyr::filter(date >= input$date_filter[1],date <= input$date_filter[2])
  })
  
  
  observeEvent(input$remove_all,{
    updateSelectizeInput(session,"filter_by_project",choices=sort(unique(test()$project)),selected=NULL,options = list(placeholder="Please Select at Least One Project")
    )
  })
  observeEvent(input$add_all,selected=sort(unique(test()$project)) )
  })
  
}