Plotly Drilldown问题：重复点击同一图表对象无法再次下钻

问题根源在于event_data("plotly_click")默认会在读取事件后清除记录，且返回上一级后再次点击同一元素时，事件跟踪机制可能无法识别为新操作。以下提供两种可行的修复方案：

方案一：使用Plotly自动生成的点击输入对象（推荐） #

直接替换原代码中基于event_data的监听逻辑，改用Shiny为Plotly输出自动生成的input$bars_click输入对象。该对象会捕获每一次点击操作，无论是否重复点击同一元素，避免了event_data的事件清除限制。

修改后的完整Server代码：

server <- function(input, output, session) {
  # 跟踪下钻状态的响应式变量
  drills <- reactiveValues(category = NULL,
                           sub_category = NULL,
                           id = NULL)
  
  # 根据下钻状态过滤数据
  sales_data <- reactive({
    if (!length(drills$category)) {
      return(mutate(sales, value = category))
    }
    sales <- filter(sales, category %in% drills$category)
    if (!length(drills$sub_category)) {
      return(mutate(sales, value = sub_category))
    }
    sales <- filter(sales, sub_category %in% drills$sub_category)
    mutate(sales, value = id)
  })
  
  # 渲染柱状图
  output$bars <- renderPlotly({
    d <- count(sales_data(), value, wt = sales)
    
    p <- plot_ly(d,
                 x = ~ value,
                 y = ~ n,
                 source = "bars") %>%
      layout(yaxis = list(title = "Total Sales"),
             xaxis = list(title = ""))
    
    if (!length(drills$sub_category)) {
      add_bars(p, color = ~ value)
    } else if (!length(drills$id)) {
      add_bars(p) %>%
        layout(hovermode = "x",
               xaxis = list(showticklabels = FALSE))
    } else {
      add_bars(p) %>%
        filter(value %in% drills$id) %>%
        add_bars(color = I("black")) %>%
        layout(
          hovermode = "x",
          xaxis = list(showticklabels = FALSE),
          showlegend = FALSE,
          barmode = "overlay"
        )
    }
  })
  
  # 监听柱状图点击事件（使用input$bars_click替代event_data）
  observeEvent(input$bars_click, {
    x <- input$bars_click$x
    if (is.null(x)) return()
    
    if (!length(drills$category)) {
      drills$category <- x
    } else if (!length(drills$sub_category)) {
      drills$sub_category <- x
    } else {
      drills$id <- x
    }
  })
  
  # 渲染返回按钮
  output$back <- renderUI({
    if (!is.null(drills$category) && is.null(drills$sub_category)) {
      actionButton("clear", "Back", icon("chevron-left"))
    }
  })
  
  output$back1 <- renderUI({
    if (!is.null(drills$sub_category)) {
      actionButton("clear1", "Back", icon("chevron-left"))
    }
  })
  
  # 返回按钮逻辑
  observeEvent(input$clear,
               drills$category <- NULL)
  observeEvent(input$clear1,
               drills$sub_category <- NULL)
  
})

方案二：保留event_data并添加点击状态跟踪 #

通过维护一个记录最后一次点击值的响应式变量，在返回上一级时重置该变量，确保再次点击同一元素时被识别为新事件。此方案更贴近原代码逻辑：

修改后的完整Server代码：

server <- function(input, output, session) {
  # 跟踪下钻状态的响应式变量
  drills <- reactiveValues(category = NULL,
                           sub_category = NULL,
                           id = NULL)
  # 记录最后一次点击的x值，用于区分重复点击
  last_click_x <- reactiveVal(NULL)
  
  # 根据下钻状态过滤数据
  sales_data <- reactive({
    if (!length(drills$category)) {
      return(mutate(sales, value = category))
    }
    sales <- filter(sales, category %in% drills$category)
    if (!length(drills$sub_category)) {
      return(mutate(sales, value = sub_category))
    }
    sales <- filter(sales, sub_category %in% drills$sub_category)
    mutate(sales, value = id)
  })
  
  # 渲染柱状图
  output$bars <- renderPlotly({
    d <- count(sales_data(), value, wt = sales)
    
    p <- plot_ly(d,
                 x = ~ value,
                 y = ~ n,
                 source = "bars") %>%
      layout(yaxis = list(title = "Total Sales"),
             xaxis = list(title = ""))
    
    if (!length(drills$sub_category)) {
      add_bars(p, color = ~ value)
    } else if (!length(drills$id)) {
      add_bars(p) %>%
        layout(hovermode = "x",
               xaxis = list(showticklabels = FALSE))
    } else {
      add_bars(p) %>%
        filter(value %in% drills$id) %>%
        add_bars(color = I("black")) %>%
        layout(
          hovermode = "x",
          xaxis = list(showticklabels = FALSE),
          showlegend = FALSE,
          barmode = "overlay"
        )
    }
  })
  
  # 监听柱状图点击事件，禁止自动清除事件数据
  observeEvent(event_data("plotly_click", source = "bars", clear = FALSE), {
    click_data <- event_data("plotly_click", source = "bars")
    x <- click_data$x
    if (is.null(x)) return()
    
    # 仅当点击值变化或当前层级已重置时执行下钻
    if (x == last_click_x() && !is.null(drills$category)) {
      return()
    }
    
    last_click_x(x)
    
    if (!length(drills$category)) {
      drills$category <- x
    } else if (!length(drills$sub_category)) {
      drills$sub_category <- x
    } else {
      drills$id <- x
    }
  })
  
  # 渲染返回按钮
  output$back <- renderUI({
    if (!is.null(drills$category) && is.null(drills$sub_category)) {
      actionButton("clear", "Back", icon("chevron-left"))
    }
  })
  
  output$back1 <- renderUI({
    if (!is.null(drills$sub_category)) {
      actionButton("clear1", "Back", icon("chevron-left"))
    }
  })
  
  # 返回按钮逻辑，同时重置点击记录
  observeEvent(input$clear, {
    drills$category <- NULL
    last_click_x(NULL)
  })
  observeEvent(input$clear1, {
    drills$sub_category <- NULL
    last_click_x(NULL)
  })
  
})

方案对比 #

• 方案一更简洁，直接利用Shiny原生的Plotly点击输入，避免了event_data的事件清除机制限制，可靠性更高。
• 方案二更贴近原代码结构，通过手动跟踪点击状态解决问题，适合需要保留原逻辑框架的场景。

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