R Shiny 中选择器的相互依赖过滤

Question

在我看来，代码中的反应式表达式有问题。 我正在使用selectizeGroupUI ，它工作正常，选择器相互依赖。 但是，当我想返回 go 并更改日期范围时，其他选择器 go 返回到它们的默认值并且为空。

我发现了其他一些讨论相同问题的主题，但我不确定如何将解决方案应用于我的问题。

我的代码在 shiny：

library(shiny)
library(shinyWidgets)
library(plotly)
library(dplyr)
library(magrittr)
library(DT)
library(lubridate)
library(tidyr)

ui <- fluidPage(
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h3("Filter data with selectize group"),
      panel(dateRangeInput("date_range", label = "Date range:",
                           start = min(df_new$DATE),
                           end = max(df_new$DATE),
                           min = min(df_new$DATE),
                           max = max(df_new$DATE),
                           format = "yyyy-mm-dd",
                           startview = "year",
                           separator = " to "),
            selectizeGroupUI(
              id = "my-filters",
              params = list(
                CATEGORY = list(inputId = "CATEGORY", title = "CATEGORY:"),
                SOURCE = list(inputId = "SOURCE", title = "SOURCE:")
              )
            ),
            status = "primary"
      ),
      plotlyOutput("plot"),
      DT::dataTableOutput(outputId = "table")
      
    )
  )
)

server <- function(input, output, session) {
  
  dates_filter <- reactive({
    filter(df_new, DATE >= input$date_range[1] & DATE <= input$date_range[2])
      })
  
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = dates_filter,
    vars = c("CATEGORY", "SOURCE")
  )
  
  dat <- reactive({
    req(res_mod())
    res_mod() %>%
      group_by(YEAR,DATE, MONTH, WEEK, WEEKDAYS) %>%
      summarise(Revenue_now = sum(REVENUE_2018),
                Revenue_pre = sum(REVENUE_2017)) %>%
      group_by(YEAR) %>%
      mutate(Revenue_now_cum = cumsum(Revenue_now),
             Revenue_pre_cum = cumsum(Revenue_pre))
  })
  
  output$table <- DT::renderDataTable({
    req(dat())
    dat()
  })
  
  output$plot <- renderPlotly({
    
    plot_ly(
      dat(),
      x = ~ DATE,
      y = ~ as.numeric(Revenue_now_cum),
      type = 'scatter',
      mode = 'lines+markers',
      name = "Selected year"
      
    ) %>%
      add_trace(y = ~ as.numeric(Revenue_pre_cum),
                mode = 'lines+markers',
                name = "Previous year"
      ) %>% layout(xaxis = list(type="category")) 
    
  })
}
shinyApp(ui, server)

我的资料

range_dates<-seq(as.Date('2017/01/01'), as.Date('2018/11/17'), by = "day")
DATE = rep(range_dates, 10)
CATEGORY = rep(sample(c("A","B","C"),10,T), each = length(range_dates))
SOURCE = rep(sample(c("aa","bb","cc"),10,T), each = length(range_dates))
REVENUE = as.numeric(sample(c(100:20000), length(range_dates) * 10, replace = T))
YEAR = year(DATE)
MONTH = months(DATE)
WEEKDAYS = weekdays(DATE)
WEEK = isoweek(DATE)
df <- data.frame(DATE, YEAR, MONTH, WEEK, WEEKDAYS, CATEGORY, SOURCE, REVENUE)

df_new<-df %>%
  group_by(YEAR) %>%
  mutate(row = row_number()) %>%
  tidyr::pivot_wider(names_from = YEAR, values_from = REVENUE, names_glue = "{.value}_{YEAR}") %>%
  select(-row)

df_new$YEAR = year(df_new$DATE)
year(df_new$DATE)<-2018

Answer 1

不确定，如果我了解您的所有要求，但为什么不简单地让您的selectizeGroupUI独立于您的input$date_range呢？

server <- function(input, output, session) {
   dates_filter <- reactive({
      filter(df_new, DATE >= input$date_range[1] & DATE <= input$date_range[2])
   })
   
   res_mod <- callModule(
      module = selectizeGroupServer,
      id = "my-filters",
      data = df_new,
      vars = c("CATEGORY", "SOURCE")
   )
   
   dat <- reactive({
      req(res_mod())
      req(dates_filter())
      res_mod() %>%
         group_by(YEAR,DATE, MONTH, WEEK, WEEKDAYS) %>%
         summarise(Revenue_now = sum(REVENUE_2018),
                   Revenue_pre = sum(REVENUE_2017)) %>%
         group_by(YEAR) %>%
         mutate(Revenue_now_cum = cumsum(Revenue_now),
                Revenue_pre_cum = cumsum(Revenue_pre))
   })
   
   output$table <- DT::renderDataTable({
      req(dat())
   })
   
   output$plot <- renderPlotly({
      plot_ly(
         dat(),
         x = ~ DATE,
         y = ~ as.numeric(Revenue_now_cum),
         type = 'scatter',
         mode = 'lines+markers',
         name = "Selected year"
         
      ) %>%
         add_trace(y = ~ as.numeric(Revenue_pre_cum),
                   mode = 'lines+markers',
                   name = "Previous year"
         ) %>% layout(xaxis = list(type="category")) 
      
   })
}

在您依赖input$date_range的那一刻，您的selectizeGroupUI将根据设计进行更新。 如果您选择A作为类别，然后将日期更改为过滤范围，而没有CATEGORY == 'A' ，那么预期的行为会是什么？

使长话短说：

1. 如果您的过滤器元素应仅显示选定日期范围内存在的值，则您应该采取依赖关系，但您必须接受这样一个事实，即每次更改都会重置它（您可以解决这个问题，但更有可能你会引入讨厌的竞争条件）。
2. 如果过滤器的选择不应受到日期范围的影响，只需删除依赖项即可。