如何仅使用一个跨多个选项卡同步的日期范围输入？

Question

我正在构建一个应用程序，用户可以在其中过滤数据的日期。在第一个选项卡上，它显示员工的视图，在第二个选项卡上，它显示项目的视图（对于此示例，数字相同）。

侧边栏在最终应用中看起来不同，但它们都有相同的日期过滤器选项，我想跨标签同步。但是，目前该应用仅响应第一个选项卡上的日期过滤器，忽略第二个日期范围输入，并且不同步他们所说的内容（例如，我可能 select Aug-2021 至 Oct-2021第一个输入，但第二个日期范围输入仍然显示默认值（即使两个选项卡上的 table 看起来都是正确的）。

我为两个 daterangeinputs 提供了相同的 inputId，但这没有帮助。任何帮助将不胜感激！

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


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 = "Apr-2021",
                                 max = NULL,
                                 format = "M-yyyy",
                                 startview = "month",
                                 weekstart = 0,
                                 language = "en",
                                 separator = " to ",
                                 width = NULL,
                                 autoclose = TRUE
                             ),
                             br()),
                     ),
                     mainPanel(
                         DT::dataTableOutput("mytable")
                         
                     )
                 )
        ),
        tabPanel("View 2", 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 = "Apr-2021",
                                 max = NULL,
                                 format = "M-yyyy",
                                 startview = "month",
                                 weekstart = 0,
                                 language = "en",
                                 separator = " to ",
                                 width = NULL,
                                 autoclose = TRUE
                             ),
                             br()),
                     ),
                     mainPanel(
                         DT::dataTableOutput("my_other_table")
                         
                     )
                 )
                 )
    )
)
server = function(input, output, session) {
    
    #Here's the dataset
    testdata <- tibble(employee = c("Justin", "Corey","Sibley"),
                       project = c("big", "medium", "small"),
                       apr_2021 = c(10, 100, 101),
                       may_2021 = c(1, 4, 7),
                       jun_2021 = c(4, 5, 6),
                       jul_2021 = c(11, 11, 45),
                       aug_2021 = c(4, 5, 7),
                       sep_2021 = c(2, 1, 0),
                       oct_2021 = c(4, 5, 8),
                       nov_2021 = c(4, 1, 1))
    
    select_values <- reactive({

        from_date <- tibble(date = as.character(input$date_filter[1]))
        
        
        from_date <- from_date %>%
            mutate(date = str_remove_all(date, "-..$")) %>%
            separate(date, into = c("year", "month"), sep = "-") %>%
            mutate(month = case_when(
                month == "01" ~ "jan",
                month == "02" ~ "feb",
                month == "03" ~ "mar",
                month == "04" ~ "apr",
                month == "05" ~ "may",
                month == "06" ~ "jun",
                month == "07" ~ "jul",
                month == "08" ~ "aug",
                month == "09" ~ "sep",
                month == "10" ~ "oct",
                month == "11" ~ "nov",
                month == "12" ~ "dec",
                TRUE~ "ERROR"
            )) %>%
            unite("month_year", c(month, year), sep = "_")
        
        from_date <- parse_character(from_date$month_year)
        
        
        
        to_date <- tibble(date = as.character(input$date_filter[2]))
        
        to_date <- to_date %>%
            mutate(date = str_remove_all(date, "-..$")) %>%
            separate(date, into = c("year", "month"), sep = "-") %>%
            mutate(month = case_when(
                month == "01" ~ "jan",
                month == "02" ~ "feb",
                month == "03" ~ "mar",
                month == "04" ~ "apr",
                month == "05" ~ "may",
                month == "06" ~ "jun",
                month == "07" ~ "jul",
                month == "08" ~ "aug",
                month == "09" ~ "sep",
                month == "10" ~ "oct",
                month == "11" ~ "nov",
                month == "12" ~ "dec",
                TRUE~ "ERROR"
            )) %>%
            unite("month_year", c(month, year), sep = "_")  
        
        to_date <- parse_character(to_date$month_year)
        
        testdata %>%
            dplyr::select(employee, project, from_date:to_date)
    })

    
    output$mytable = DT::renderDataTable({
        datatable(select_values() %>%
                      dplyr::select(-project))
    })
    
    output$my_other_table = DT::renderDataTable({
        datatable(select_values() %>%
                      dplyr::select(-employee))
    })

    
}
shinyApp(ui = ui, server = server)

Answer 1

是的，您应该使用唯一 ID。如果您在第二个选项卡中使用 date_filter2 作为 ID，您可以使用 updateDateRangeInput 如下所示在您更新第一个选项卡中的日期时更新它。

observeEvent(input$date_filter, {
  updateDateRangeInput(session, "date_filter2",
                       label = "Filter by Month and Year",
                       start = input$date_filter[1],
                       end = input$date_filter[2]
  )
})

如何仅使用一个跨多个选项卡同步的日期范围输入？

How to use just one daterangeinput that syncs across multiple tabs?

r

tabpanel

shiny

shinydashboard

shiny-reactivity