Plotly Rangeslider无法显示完整数据集，同步DateRangeInput求助

我尝试创建一个Shiny应用展示时间序列数据，包含多个选择器和DateRangeInput组件。需求是拖动Plotly图表底部的rangeslider时，同步更新DateRangeInput组件。但当前实现中，用于更新DateRangeInput的observeEvent代码导致rangeslider无法显示数据集的完整范围，仅展示选中的窗口；注释掉该代码后，rangeslider能正常显示完整数据范围及选中区间。请问如何修改代码，在同步更新DateRangeInput的同时，让rangeslider正常显示完整数据集？

核心问题在于updateDateRangeInput会触发数据过滤逻辑，导致图表数据被裁剪，进而让rangeslider的范围缩小为过滤后的区间。要解决这个问题，需要分离数据筛选逻辑与图表视图范围控制：

• 仅让station和pollutant选择器过滤原始数据，DateRangeInput和rangeslider仅控制图表的显示范围，不修改底层数据集
• 用plotlyProxy实现视图范围的动态调整，避免重新渲染整个图表

library(shiny)
library(plotly)
library(dplyr)

xls_plot <- structure(list(mid_date = structure(c(20106,
20106, 20113, 20113, 20120, 20120, 20127, 20127, 20134, 20134,
20141, 20141, 20148, 20148, 20155, 20155, 20162, 20162, 20169,
20169, 20176, 20176, 20183, 20183, 20190, 20190, 20197, 20197,
20204, 20204, 20211, 20211, 20218, 20218, 20225, 20225, 20232,
20232, 20239, 20239, 20246, 20246, 20253, 20253, 20260, 20260,
20267, 20267, 20274, 20274, 20281, 20281, 20288, 20288, 20295,
20295, 20302, 20302, 20309, 20309, 20316, 20316, 20323, 20323,
20330, 20330, 20337, 20337, 20344, 20344, 20351, 20351, 20358,
20358, 20365, 20365, 20372, 20372, 20379, 20379, 20386, 20386,
20393, 20393, 20400, 20400, 20407, 20407, 20414, 20414, 20421,
20421, 20428, 20428, 20435, 20435), class = "Date"), concentration = c(1.39, 1.45, 0.69, 0.87, 1.29,
1.35, 1.48, 1.46, 1.3, 1.37, 0.1, 0.1, 1.53, 1.39, 1.58, 1.76,
0.82, 0.84, 1.28, 1.05, 1.13, 1.11, 0.99, 0.96, 0.37, 0.42, 0.42,
0.35, 0.41, 0.56, 0.51, 0.42, 0.33, 0.51, 0.39, 0.34, 0.22, 0.25,
0.22, 0.28, 0.25, 0.27, 0.44, 0.52, 0.15, 0.24, 0.17, 0.12, 0.13,
0.13, 0.15, 0.31, 0.11, 0.1, 0.18, 0.1, 0.1, 0.1, 0.23, 0.24,
0.27, 1.06, 0.15, 0.1, 0.13, 1.06, 0.16, 0.11, 0.18, 0.27, 0.27,
0.33, 0.49, 0.49, 0.1, 0.37, 0.38, 0.44, 0.36, 0.36, 0.23, 0.22,
0.32, 0.25, 0.36, 0.42, 0.48, 0.59, 0.1, 0.42, 0.1, 0.33, 1.08,
0.26, 0.49, 0.45)), row.names = c(NA, -96L), class = c("tbl_df",
"tbl", "data.frame")) %>%
  mutate(pollutant = "B", station = "51R001") %>%
  group_by(station, pollutant) %>%
  mutate(index = factor(dplyr::cur_group_id()))


stations <- unique(xls_plot$station)
pollutants <- unique(xls_plot$pollutant)
start_date <- min(xls_plot$mid_date)
end_date <- max(xls_plot$mid_date)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput(
        inputId = "stations",
        label = "Station",
        choices = c("", stations),
        multiple = TRUE
      ),
      selectizeInput(
        inputId = "pollutants",
        label = "Polluant",
        choices = c("", pollutants),
        multiple = FALSE
      ),
      dateRangeInput(
        inputId = "dates",
        label = "Dates",
        start = start_date,
        end = end_date,
        min = NULL,
        max = NULL,
        format = "dd/mm/yyyy",
        startview = "month",
        weekstart = 1,
        language = "fr",
        separator = " à ",
        width = NULL,
        autoclose = TRUE
      ),
      width = 2),
    mainPanel(
      plotlyOutput(outputId = "plot"),
      width = 10)
  )
)

server <- function(input, output, session) {
  # 仅根据站点和污染物筛选数据，不做日期过滤
  filtered_data <- reactive({
    req(input$stations, input$pollutants)
    if (identical(input$stations, "") || identical(input$pollutants, "")) {
      return(NULL)
    }
    xls_plot %>%
      filter(station %in% input$stations) %>%
      filter(pollutant %in% input$pollutants)
  })
  
  # 获取筛选后数据的完整日期范围
  full_date_range <- reactive({
    req(filtered_data())
    c(min(filtered_data()$mid_date), max(filtered_data()$mid_date))
  })
  
  # 获取筛选后数据的完整浓度范围
  full_y_range <- reactive({
    req(filtered_data())
    range(filtered_data()$concentration, na.rm = TRUE)
  })

  output$plot <- renderPlotly({
    req(filtered_data())
    
    plot_ly(filtered_data(), x = ~mid_date, y = ~concentration, showlegend = FALSE) %>%
      add_bars(color = ~index) %>%
      rangeslider() %>%
      layout(
        barmode = "stack",
        title = "COV",
        xaxis = list(
          title = "Date",
          rangeslider = list(type = "date"),
          range = full_date_range()  # 初始显示完整日期范围
        ),
        yaxis = list(title = "Concentration [µg/m³]", showline = TRUE, range = full_y_range()),
        legend = list(itemclick = FALSE, itemdoubleclick = FALSE)
      )
  })

  # 监听rangeslider拖拽事件，同步更新DateRangeInput
  observeEvent(event_data("plotly_relayout"), {
    d <- event_data("plotly_relayout")
    xmin <- d[["xaxis.range[0]"]] %||% d[["xaxis.range"]][1]
    xmax <- d[["xaxis.range[1]"]] %||% d[["xaxis.range"]][2]
    
    if (is.null(xmin) || is.null(xmax)) return()
    
    # 转换为Date类型并更新日期选择器
    xmin_date <- as.Date(xmin)
    xmax_date <- as.Date(xmax)
    updateDateRangeInput(session, "dates", start = xmin_date, end = xmax_date)
    
    # 计算当前显示区间的最优y轴范围
    req(filtered_data())
    idx <- filtered_data()$mid_date >= xmin_date & filtered_data()$mid_date <= xmax_date
    yrng <- extendrange(filtered_data()$concentration[idx])
    yrng[1] <- 0
    
    # 更新y轴范围
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("relayout", list(yaxis = list(range = yrng)))
  })

  # 监听DateRangeInput变化，同步更新图表显示范围
  observeEvent(input$dates, {
    req(input$dates, filtered_data())
    start <- input$dates[1]
    end <- input$dates[2]
    
    # 直接更新图表x轴范围，不修改底层数据
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("relayout", list(xaxis = list(range = c(start, end))))
    
    # 计算对应y轴范围
    idx <- filtered_data()$mid_date >= start & filtered_data()$mid_date <= end
    yrng <- extendrange(filtered_data()$concentration[idx])
    yrng[1] <- 0
    
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("relayout", list(yaxis = list(range = yrng)))
  }, ignoreInit = TRUE)

  # 监听双击事件，重置为完整数据范围
  observeEvent(event_data("plotly_doubleclick"), {
    req(full_date_range(), full_y_range())
    updateDateRangeInput(session, "dates", start = full_date_range()[1], end = full_date_range()[2])
    
    plotlyProxy("plot", session) %>%
      plotlyProxyInvoke("relayout", list(
        xaxis = list(range = full_date_range()),
        yaxis = list(range = full_y_range())
      ))
  })
}

app <- shinyApp(ui, server)

• 分离数据筛选与视图控制：filtered_data仅根据station和pollutant筛选数据，不再受DateRangeInput影响，确保图表始终基于完整的筛选后数据渲染，rangeslider自然能显示完整数据集范围
• 双向同步逻辑优化：
  • 拖拽rangeslider时，提取图表的x轴范围更新DateRangeInput，同时计算对应y轴范围并调整
  • 修改DateRangeInput时，通过plotlyProxy直接更新图表的x轴范围，避免重新渲染整个图表
• 使用plotlyProxy提升性能：所有视图范围的调整都通过plotlyProxyInvoke实现，既保证响应速度，又避免数据被意外过滤

内容的提问来源于stack exchange，提问作者Alessandro