如何在Shiny应用的Highchart地图上绘制自定义50*50km方格栅格

前提准备 #

首先确认你的筛选后数据data1()已关联栅格核心字段：经度(lon)、纬度(lat)，以及要展示的栅格数值(value)，缺失的话先把质心坐标表和主表df_Main按唯一标识关联。

代码优化步骤 #

1. 简化国家底图映射逻辑 #

先删除原有大量if else判断，提前定义国家与底图地址的映射向量，放在server函数之前即可：

# 国家与Highchart底图地址映射，补全剩余国家即可
country_map_urls <- c(
  "Algeria" = "https://code.highcharts.com/mapdata/countries/dz/dz-all.js",
  "Bahrain" = "https://code.highcharts.com/mapdata/countries/bh/bh-all.js",
  "Comoros" = "https://code.highcharts.com/mapdata/countries/km/km-all.js",
  "Djibouti" = "https://code.highcharts.com/mapdata/countries/dj/dj-all.js",
  "Egypt" = "https://code.highcharts.com/mapdata/countries/eg/eg-all.js",
  "Iraq" = "https://code.highcharts.com/mapdata/countries/iq/iq-all.js",
  "Jordan" = "https://code.highcharts.com/mapdata/countries/jo/jo-all.js",
  "Kuwait" = "https://code.highcharts.com/mapdata/countries/kw/kw-all.js",
  "Lebanon" = "https://code.highcharts.com/mapdata/countries/lb/lb-all.js",
  "Libya" = "https://code.highcharts.com/mapdata/countries/ly/ly-all.js",
  "Mauritania" = "https://code.highcharts.com/mapdata/countries/mr/mr-all.js",
  "Morocco" = "https://code.highcharts.com/mapdata/countries/ma/ma-all.js",
  "Oman" = "https://code.highcharts.com/mapdata/countries/om/om-all.js",
  "Qatar" = "https://code.highcharts.com/mapdata/countries/qa/qa-all.js",
  "Saudi Arabia" = "https://code.highcharts.com/mapdata/countries/sa/sa-all.js",
  "Somalia" = "https://code.highcharts.com/mapdata/countries/so/so-all.js"
)

2. 重写地图渲染逻辑叠加栅格 #

替换原有output$Map的代码，用hc_add_series叠加栅格层即可，提供两种常用实现方案：

方案A：栅格展示为数值映射大小的气泡（最简便）

output$Map <- renderHighchart({
  req(data1()) # 确保筛选数据加载完成
  # 调用对应国家底图
  hcmap(country_map_urls[input$Country]) %>% 
    hc_title(text = input$Country) %>%
    # 叠加栅格气泡层
    hc_add_series(
      data = data1(),
      type = "mapbubble",
      hcaes(lon = 你的经度字段名, lat = 你的纬度字段名, z = 你的栅格数值字段名),
      name = "栅格监测值",
      minSize = 4,
      maxSize = 18,
      tooltip = list(
        pointFormat = "经度：{point.lon}<br>纬度：{point.lat}<br>数值：{point.你的栅格数值字段名}"
      )
    ) %>%
    # 配置数值颜色轴
    hc_colorAxis(
      min = min(data1()$你的栅格数值字段名, na.rm = TRUE),
      max = max(data1()$你的栅格数值字段名, na.rm = TRUE),
      stops = color_stops(colors = viridisLite::viridis(10))
    )
})

方案B：展示为标准50*50km正方形栅格

如果需要严格展示方形栅格，先通过sf包把质心转换为栅格多边形再叠加：

1. 先安装加载依赖包：install.packages(c("sf","geojsonsf"))
2. 新增响应式栅格多边形数据，放在data1响应式函数之后：

grid_poly <- reactive({
  req(data1())
  # 50km对应经纬度跨度（赤道附近约为0.45度，高纬度区域可按实际投影调整）
  grid_step <- 0.45
  data1() %>%
    rowwise() %>%
    mutate(
      geometry = list(
        st_polygon(list(rbind(
          c(lon - grid_step/2, lat - grid_step/2),
          c(lon + grid_step/2, lat - grid_step/2),
          c(lon + grid_step/2, lat + grid_step/2),
          c(lon - grid_step/2, lat + grid_step/2),
          c(lon - grid_step/2, lat - grid_step/2)
        )))
      )
    ) %>%
    st_sf(crs = 4326) %>%
    geojsonsf::sf_geojson()
})

3. 修改叠加层配置：

output$Map <- renderHighchart({
  req(grid_poly())
  hcmap(country_map_urls[input$Country]) %>% 
    hc_title(text = input$Country) %>%
    hc_add_series(
      data = grid_poly(),
      type = "map",
      name = "栅格监测值",
      tooltip = list(
        pointFormat = "数值：{point.你的栅格数值字段名}"
      )
    ) %>%
    hc_colorAxis(
      min = min(data1()$你的栅格数值字段名, na.rm = TRUE),
      max = max(data1()$你的栅格数值字段名, na.rm = TRUE)
    )
})

注意事项 #

• 代码中所有你的xx字段名替换为你实际数据表中的对应字段
• 若栅格不显示，先检查data1()中坐标字段是否存在空值，坐标是否为WGS84坐标系（EPSG:4326）

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