Shiny框架下Highcharts柱状图点击取值及数据框过滤异常问题

这个报错"Result must have length 10, not 0"的核心原因是初始加载时用户还未点击柱子，input$canvasClicked[2]为NULL，执行过滤后得到空数据框，后续代码无法处理空数据导致长度不匹配。同时初始的系列名称设置也依赖未初始化的输入，进一步引发问题。

下面是修正后的完整代码，以及关键改动的说明：

修正后的server.R #

library("shiny")
library("highcharter")
library("dplyr")
library("purrr")

shinyServer(function(input, output, session) {
  
  # 预定义基础柱状图数据
  df <- tibble(
    name = c("Animals", "Fruits", "Cars"),
    y = c(5, 2, 4),
    drilldown = tolower(name)
  )
  ds <- list.parse3(df)
  names(ds) <- NULL
  
  # 预定义明细数据（修正了Volkswage的拼写错误）
  df_full <- tibble(
    name = c("Cats","Dogs","Cows","Sheep","Pigs","Apple","Oranges","Toyota","Opel","Volkswagen"),
    name1 = c("Animals","Animals","Animals","Animals","Animals","Fruits","Fruits","Cars","Cars","Cars"),
    value = c(4,2,4, 3, 1, 2, 1,4, 2, 2)
  )
  
  # 处理选中的类别，设置初始默认值
  selected_category <- reactive({
    if (is.null(input$canvasClicked)) {
      # 初始默认选中第一个类别，避免空过滤
      "Animals"
    } else {
      input$canvasClicked[2]
    }
  })
  
  output$hcontainer <- renderHighchart({
    # 定义柱子点击事件，传递选中的类别到Shiny input
    canvasClickFunction <- JS("function(event) {
      Shiny.onInputChange('canvasClicked', [this.name, event.point.category]);
    }")
    
    # 根据选中类别过滤明细数据
    dfanny <- df_full %>% 
      filter(name1 == selected_category())
    
    # 转换数据为Highcharts需要的格式
    second_el_to_numeric <- function(ls){
      map(ls, function(x){
        x[[2]] <- as.numeric(x[[2]])
        x
      })
    }
    dsan <- second_el_to_numeric(list.parse2(dfanny %>% select(name, value)))
    
    # 构建Highcharts图表
    highchart() %>%
      hc_chart(type = "column") %>%
      hc_title(text = "Basic drilldown") %>%
      hc_xAxis(type = "category") %>%
      hc_legend(enabled = FALSE) %>%
      hc_plotOptions(
        series = list(
          borderWidth = 0,
          dataLabels = list(enabled = TRUE),
          events = list(click = canvasClickFunction)
        )
      ) %>%
      hc_add_series(
        name = selected_category(),
        colorByPoint = TRUE,
        data = ds
      ) %>%
      hc_drilldown(
        allowPointDrilldown = TRUE,
        series = list(
          list(id = tolower(selected_category()), data = dsan)
        )
      )
  })
})

修正后的ui.R #

fluidPage(
  h1("Highcharter EXAMPLE"),
  fluidRow(
    highchartOutput("hcontainer", height = "500px")
  )
)

关键改动说明 #

1. 添加初始默认值：通过reactive对象selected_category处理初始状态，当用户还未点击柱子时，默认选中"Animals"，确保过滤后始终有有效数据，避免空数据框导致的长度报错。
2. 拆分数据定义：将基础数据和明细数据移到renderHighchart外部，避免每次渲染重复创建数据，提升性能。
3. 修正拼写错误：原明细数据中的"Volkswage"改为正确的"Volkswagen"，避免数据匹配问题。
4. 响应式依赖：renderHighchart依赖selected_category()，当用户点击柱子触发input$canvasClicked变化时，图表会自动重新渲染，更新过滤后的明细数据和drilldown内容。
5. 简化事件处理：移除了未使用的legendClickFunction，让代码更简洁。

现在运行修正后的代码，初始加载时会显示"Animals"对应的drilldown数据，点击不同柱子时会自动过滤数据并更新图表，不会再出现长度不匹配的报错。

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