R Shiny中Highcharter的JS事件在UI输入更新后失效求助

我是Stack Overflow的长期浏览者，这是我的第一篇帖子。我在R Shiny中渲染Highchart地图时，尝试在Highcharter的绘图选项中为click事件调用JavaScript代码，实现点击地图上的州将其标红的功能。该JS代码在应用首次启动时有效，但当用户切换UI输入更新地图后，代码不再生效。

可复现代码 #

##PACKAGES
library(shiny)
library(shinyWidgets)
library(shinyjs)
library(dplyr)
library(tidyverse)
library(albersusa)
library(highcharter)
library(usdata)

states <- data.frame(
  name  = rep(state.abb,4),
  metric = c(rep("YES",100),rep("NO",100)),
  value  = sample(100:5000,200)
)

ui <- fluidPage(
  
  tags$script(src = "https://code.highcharts.com/mapdata/countries/us/us-all.js"),
  
  fluidRow(
    radioButtons(inputId = "toggle",label="toggle it", 
                 choices = c("YES","NO")),
    column(width=5,highchartOutput("map1"))
    )
  )

server <- function(input, output, session) {
  
  #create rate change
  df1_num<- reactive({
    states %>%
    filter(metric == input$toggle) %>%
    group_by(name) %>%
    mutate(
      first = dplyr::first(value),
      last = dplyr::last(value)
    ) %>%
    distinct(metric,name,first,last) %>%
    mutate(
      #increase/decrease rate change
      rate  = round(((last-first)/first)*100,1),
    )
  })
  
  output$map1 <- renderHighchart({
    #US map of percent change in population trends
    hcmap("countries/us/us-all",
          data   = df1_num(),
          joinBy = c("hc-a2","name"),
          value  = "rate",
          borderColor = "#8d8d8d",
          nullColor = "#D3D3D3",
          download_map_data = FALSE
    ) %>%
      hc_plotOptions(series = list(
        point = list(
          events = list(
            click = JS("function() {
                       let currentY = this.name
                       charts = Highcharts.charts;
                       charts.forEach(function(chart, index) {
                       chart.series.forEach(function(series, seriesIndex) {
                       series.points.forEach(function(point, pointsIndex) {
                       if (point.name == currentY) {
                               point.setState('hover');
                               point.update({color:'red'})
                       }
                       })
                       });
                       });
        }")
          )
        )
      )
      )
  })

}

shinyApp(ui = ui, server = server)

解决方案 #

问题根源在于：每次切换UI输入时，renderHighchart会生成全新的图表实例，原JS代码遍历Highcharts.charts时会包含已被Shiny销毁的旧图表实例，导致新图表的点击逻辑失效；同时直接通过JS修改的点样式会在图表重绘时丢失。

更可靠的做法是结合Shiny的响应式状态管理，保存选中的州名，在每次渲染地图时主动给选中的州设置样式，同时通过点击事件更新响应式状态触发重绘：

修改后的完整代码

##PACKAGES
library(shiny)
library(shinyWidgets)
library(shinyjs)
library(dplyr)
library(tidyverse)
library(albersusa)
library(highcharter)
library(usdata)

states <- data.frame(
  name  = rep(state.abb,4),
  metric = c(rep("YES",100),rep("NO",100)),
  value  = sample(100:5000,200)
)

ui <- fluidPage(
  tags$script(src = "https://code.highcharts.com/mapdata/countries/us/us-all.js"),
  fluidRow(
    radioButtons(inputId = "toggle",label="toggle it", 
                 choices = c("YES","NO")),
    column(width=5,highchartOutput("map1"))
  )
)

server <- function(input, output, session) {
  # 保存选中的州名
  selected_state <- reactiveVal(NULL)
  
  #create rate change
  df1_num<- reactive({
    states %>%
      filter(metric == input$toggle) %>%
      group_by(name) %>%
      mutate(
        first = dplyr::first(value),
        last = dplyr::last(value)
      ) %>%
      distinct(metric,name,first,last) %>%
      mutate(
        #increase/decrease rate change
        rate  = round(((last-first)/first)*100,1),
      )
  })
  
  output$map1 <- renderHighchart({
    #US map of percent change in population trends
    hc <- hcmap("countries/us/us-all",
          data   = df1_num(),
          joinBy = c("hc-a2","name"),
          value  = "rate",
          borderColor = "#8d8d8d",
          nullColor = "#D3D3D3",
          download_map_data = FALSE
    ) %>%
      hc_plotOptions(series = list(
        point = list(
          events = list(
            # 点击时通知Shiny更新选中状态
            click = JS("function() {
              Shiny.setInputValue('selected_state', this.name);
            }")
          )
        )
      ))
    
    # 如果有选中的州，修改对应点的颜色
    if (!is.null(selected_state())) {
      hc <- hc %>%
        hc_chart(events = list(
          load = JS(sprintf("function() {
            var chart = this;
            chart.series[0].points.forEach(function(point) {
              if (point.name === '%s') {
                point.update({color: 'red'});
              }
            });
          }", selected_state()))
        ))
    }
    
    hc
  })
  
  # 监听Shiny输入更新选中状态
  observeEvent(input$selected_state, {
    selected_state(input$selected_state)
  })
}

shinyApp(ui = ui, server = server)

关键改动说明

1. 新增selected_state <- reactiveVal(NULL)存储选中的州名，确保状态在图表重绘时不丢失
2. 将原JS点击事件改为通过Shiny.setInputValue通知Shiny更新选中状态，避免直接操作DOM导致的兼容性问题
3. 在图表加载完成后，根据selected_state()的值主动为对应州设置红色，确保每次重绘后样式都能恢复
4. 用observeEvent监听Shiny输入，更新响应式状态触发图表重绘

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