如何使用Highcharter绘制带动画效果的地图线

你尝试用highcharter复现带动画的地图线功能，但代码中未生成线条，同时需要实现动画效果。以下是关键修复点和完整可运行代码：

关键修复点 #

• 适配Robinson投影坐标：直接使用经纬度坐标无法在Robinson投影的地图上正确显示线条，需要利用Highcharts的投影转换方法处理坐标。
• 添加动画CSS样式：线条的流动动画依赖自定义CSS实现，需在UI中嵌入对应样式。
• 调整mapline系列配置：优化数据结构，确保mapline系列能正确识别路径数据。

完整修复代码 #

library(shiny)
library(shinythemes)
library(highcharter)
library(dplyr)
library(jsonlite)

# Load the world map data
geojson <- download_map_data("custom/world-robinson-highres")

# Prepare coffee data
data <- data.frame(
  `hc-key` = c("ye", "br", "fr", "gb", "id", "nl", "gu", "re", "in"),
  color = c("#ffa500", "#c0ffd5", "#c0ffd5", "#c0ffd5", "#c0ffd5", "#c0ffd5", "#c0ffd5", "#c0ffd5", "#c0ffd5"),
  info = c(
    "Yemen is where coffee took off.",
    "Coffee came from La Reunion.",
    "Coffee came from Java.",
    "Coffee came from Java.",
    "Coffee came from Yemen.",
    "Coffee came from Java.",
    "Coffee came from France.",
    "Coffee came from Yemen.",
    "Coffee came from Yemen."
  )
)

# Prepare line data（经纬度坐标）
lines_latlon <- list(
  list(from = c(48.516388, 15.552727), to = c(110.004444, -7.491667), color = "#666"), # Yemen to Java
  list(from = c(48.516388, 15.552727), to = c(55.5325, -21.114444), color = "#666"), # Yemen to La Reunion
  list(from = c(55.5325, -21.114444), to = c(-43.2, -22.9), color = "#666"), # La Reunion to Brazil
  list(from = c(48.516388, 15.552727), to = c(78, 21), color = "#666"), # Yemen to India
  list(from = c(110.004444, -7.491667), to = c(4.9, 52.366667), color = "#666"), # Java to Amsterdam
  list(from = c(-3, 55), to = c(-61.030556, 14.681944), color = "#666"), # UK to Antilles
  list(from = c(2.352222, 48.856613), to = c(-53, 4), color = "#666") # Paris to Guyane
)

# Prepare points data
points_data <- list(
  list(name = "Yemen", geometry = list(type = "Point", coordinates = c(48.516388, 15.552727)), custom = list(arrival = 1414)),
  list(name = "Java", geometry = list(type = "Point", coordinates = c(110.004444, -7.491667)), custom = list(arrival = 1696)),
  list(name = "La Reunion", geometry = list(type = "Point", coordinates = c(55.5325, -21.114444)), custom = list(arrival = 1708)),
  list(name = "Brazil", geometry = list(type = "Point", coordinates = c(-43.2, -22.9)), custom = list(arrival = 1770)),
  list(name = "India", geometry = list(type = "Point", coordinates = c(78, 21)), custom = list(arrival = 1670)),
  list(name = "Amsterdam", geometry = list(type = "Point", coordinates = c(4.9, 52.366667)), custom = list(arrival = 1696)),
  list(name = "Antilles", geometry = list(type = "Point", coordinates = c(-61.030556, 14.681944)), custom = list(arrival = 1714)),
  list(name = "Guyane", geometry = list(type = "Point", coordinates = c(-53, 4)), custom = list(arrival = 1714))
)

ui <- fluidPage(
  theme = shinytheme("paper"),
  tags$script(src = "https://code.highcharts.com/mapdata/custom/world-robinson-highres.js"),
  # 添加动画所需的CSS样式
  tags$style(HTML("
    .animated-line {
      stroke-dasharray: 10;
      animation: dash 20s linear infinite;
    }
    @keyframes dash {
      to {
        stroke-dashoffset: -1000;
      }
    }
  ")),
  fluidRow(
    tags$hr(),
    column(
      12,
      selectInput("sel", NULL, c("Preloaded map" = "preload", "Sending map" = "send")),
      actionButton("action", "Generate map")
    ),
    tags$hr(),
    column(12, highchartOutput("hcmap"))
  )
)

server <- function(input, output) {
  
  output$hcmap <- renderHighchart({
    
    input$action  # React to the button click
    
    # Determine map data source
    mapdata <- if (input$sel == "preload") {
      JS("Highcharts.maps['custom/world-robinson-highres']")
    } else {
      geojson
    }
    
    # 创建地图并获取投影实例
    hc <- highchart(type = "map") %>% 
      hc_add_series(
        mapData = mapdata, 
        data = data, 
        joinBy = c("hc-key"),
        borderWidth = 0,
        name = "Coffee Origins",
        color = data$color,
        tooltip = list(useHTML = TRUE, headerFormat = "<b>{point.key}</b>:<br/>", pointFormat = "{point.info}")
      ) %>%
      hc_add_series(
        type = "mappoint",
        data = points_data,
        color = "#333",
        dataLabels = list(
          format = "<b>{point.name}</b><br/><span style='font-weight: normal; opacity: 0.5'>{point.custom.arrival}</span>",
          align = "left",
          verticalAlign = "middle"
        ),
        enableMouseTracking = FALSE
      ) %>% 
      hc_title(text = "The history of the coffee bean ☕") %>% 
      hc_legend(enabled = FALSE) %>% 
      hc_chart(zoomType = "xy")
    
    # 转换经纬度为投影坐标并添加mapline系列
    hc <- hc %>% hc_add_series(
      type = "mapline",
      data = lapply(lines_latlon, function(line) {
        # 利用Highcharts的投影转换方法将经纬度转为地图坐标
        from_proj <- JS(sprintf("Highcharts.maps['custom/world-robinson-highres'].options.projection.fromLatLonToPoint(%s, %s)", line$from[2], line$from[1]))
        to_proj <- JS(sprintf("Highcharts.maps['custom/world-robinson-highres'].options.projection.fromLatLonToPoint(%s, %s)", line$to[2], line$to[1]))
        list(
          path = sprintf("M %f %f L %f %f", from_proj[1], from_proj[2], to_proj[1], to_proj[2]),
          className = "animated-line",
          color = line$color,
          lineWidth = 2
        )
      }),
      enableMouseTracking = FALSE
    )
    
    hc
  })
}

shinyApp(ui, server)

说明 #

• 新增的CSS样式实现了线条的流动动画效果，通过stroke-dasharray和@keyframes定义动画逻辑。
• 使用地图自带的投影方法fromLatLonToPoint将经纬度坐标转换为Robinson投影下的像素坐标，确保线条在地图上正确显示。
• 调整了mapline的数据结构，使用path属性直接定义线条路径，适配highcharter的渲染要求。

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