基于Plotly点击事件筛选DataFrame的Shiny应用实现

我帮你排查了代码里的几个问题，现在可以实现点击直方图柱子展示对应Name的功能了，先看修正后的完整代码：

library(plotly)
library(shiny)
library(DT)

# 初始化数据
Name <- c("John","Bob","Jack")
Number <- c(3,3,5)
NN <- data.frame(Name, Number)

ui <- fluidPage(
  mainPanel(
    plotlyOutput("heat"),
    br(), # 加个换行让布局更美观
    DT::dataTableOutput('tbl4')
  )
)

server <- function(input, output, session) {
  output$heat <- renderPlotly({
    # 指定xbins确保每个Number值对应独立柱子，避免自动分组偏差
    p <- plot_ly(x = NN$Number, type = "histogram", xbins = list(start = min(NN$Number), end = max(NN$Number), size = 1))
    p
  })
  
  output$tbl4 <- renderDataTable({
    s <- event_data("plotly_click")
    
    if (is.null(s)) {
      # 初始状态返回带提示的空表格
      data.frame(提示 = "点击直方图中的柱子查看对应名称")
    } else {
      # 匹配对应的Number值，返回保留数据框结构的Name列
      selected_data <- NN[NN$Number == as.numeric(s$x), "Name", drop = FALSE]
      # 兜底处理：理论不会触发，但避免极端情况报错
      if(nrow(selected_data) == 0){
        data.frame(提示 = "未找到对应数据")
      } else {
        selected_data
      }
    }
  })
}

shinyApp(ui, server)

关键修改点说明： #

• 修正event_data取值逻辑：plotly_click返回的对象中，点击柱子的x轴值存在s$x字段，之前的s[2]写法无法拿到正确的分组值，这是功能失效的核心原因。
• 保证输出格式合规：DT的renderDataTable要求输入为数据框，所以用drop = FALSE保留Name列的数据框结构，避免变成向量导致显示异常。
• 优化初始状态与容错：初始时返回带提示的空数据框（而非字符串），同时增加无匹配数据的兜底提示，让应用更健壮。
• 锁定直方图分组规则：通过xbins参数强制每个Number值对应一个柱子，避免Plotly自动合并相邻数值，确保点击匹配的准确性。

现在运行代码，点击数值为3的柱子会显示John和Bob的表格，点击5的柱子会显示Jack，完全符合你的需求。

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