You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

Leaflet极地投影实现:解决高纬度点空间分辨率问题

问题描述

我用以下R代码生成带兴趣点标记的地图:

library(leaflet)
library(readxl)
library(dplyr)

data_a <- structure(list(Nr = c(1, 2, 3, 4, 5, 6), Name = c("MD95-2006", 
"IODP 302", "IODP 302", "IODP 302", "IODP 302", "IODP 302"), 
    Lat = c(57.083333, 87.89, 87.9036, 87.92118, 87.93333, 87.86658
    ), Long = c(-8.05, 137.65, 138.46065, 139.365501, 139.535, 
    136.17735), `18O` = c(0.69, NA, NA, NA, NA, NA), Info = c(NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_), Source = c("MD95-2006 planktic foraminifera ?13C and ?18O", 
"https://www.ecord.org/expedition302/", "https://www.ecord.org/expedition302/", 
"https://www.ecord.org/expedition302/", "https://www.ecord.org/expedition302/", 
"https://www.ecord.org/expedition302/")), row.names = c(NA, 
-6L), class = c("tbl_df", "tbl", "data.frame"))


data_b <- structure(list(Nr = c(1, 2, 3, 4, 5, 6), Name = c("Simstich", 
"Schiebel", "Schiebel", "Stangeew", "Stangeew", "Stangeew"), 
    Lat = c(75.003333, 62.50275, 67.225033, 56.2747, 53.4347, 
    52.874), Long = c(-7.313333, -13.99235, 2.920317, -48.6992, 
    -50.0673, -51.5128), `18O` = c(NA, NA, NA, NA, NA, NA), Info = c("data for different depths", 
NA, NA, NA, NA, NA), Source = c("https://doi.pangaea.de/10.1594/PANGAEA.82001?format=html#download", 
"https://doi.pangaea.de/10.1594/PANGAEA.75647?format=html#download", 
"https://doi.pangaea.de/10.1594/PANGAEA.75719", "https://doi.pangaea.de/10.1594/PANGAEA.706908", 
"https://doi.pangaea.de/10.1594/PANGAEA.706908", "https://doi.pangaea.de/10.1594/PANGAEA.706908"
    )), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"
))

data <- bind_rows(list(data_a,data_b), .id="data_source")

icons <- awesomeIcons(
  icon = 'ios-close',
  iconColor = 'black',
  library = 'ion',
  markerColor = ifelse(data$data_source == 1, "green","red")
)

map <- leaflet(data) %>%
  addTiles() %>%
  addAwesomeMarkers(lng = ~Long, lat = ~Lat, icon = icons) 

print(map)

生成的地图中东北方向的点空间分辨率较差,我想实现极地投影,但在leaflet官方文档里没找到相关方法,请问该怎么实现?

解决方案

Leaflet支持自定义投影,针对北极区域,推荐使用EPSG:3413(北极立体投影),需通过定义自定义CRS并搭配适配的底图实现,修改后的代码如下:

library(leaflet)
library(dplyr)

# 保留原数据处理逻辑
data_a <- structure(list(Nr = c(1, 2, 3, 4, 5, 6), Name = c("MD95-2006", 
"IODP 302", "IODP 302", "IODP 302", "IODP 302", "IODP 302"), 
    Lat = c(57.083333, 87.89, 87.9036, 87.92118, 87.93333, 87.86658
    ), Long = c(-8.05, 137.65, 138.46065, 139.365501, 139.535, 
    136.17735), `18O` = c(0.69, NA, NA, NA, NA, NA), Info = c(NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_), Source = c("MD95-2006 planktic foraminifera ?13C and ?18O", 
"https://www.ecord.org/expedition302/", "https://www.ecord.org/expedition302/", 
"https://www.ecord.org/expedition302/", "https://www.ecord.org/expedition302/", 
"https://www.ecord.org/expedition302/")), row.names = c(NA, 
-6L), class = c("tbl_df", "tbl", "data.frame"))


data_b <- structure(list(Nr = c(1, 2, 3, 4, 5, 6), Name = c("Simstich", 
"Schiebel", "Schiebel", "Stangeew", "Stangeew", "Stangeew"), 
    Lat = c(75.003333, 62.50275, 67.225033, 56.2747, 53.4347, 
    52.874), Long = c(-7.313333, -13.99235, 2.920317, -48.6992, 
    -50.0673, -51.5128), `18O` = c(NA, NA, NA, NA, NA, NA), Info = c("data for different depths", 
NA, NA, NA, NA, NA), Source = c("https://doi.pangaea.de/10.1594/PANGAEA.82001?format=html#download", 
"https://doi.pangaea.de/10.1594/PANGAEA.75647?format=html#download", 
"https://doi.pangaea.de/10.1594/PANGAEA.75719", "https://doi.pangaea.de/10.1594/PANGAEA.706908", 
"https://doi.pangaea.de/10.1594/PANGAEA.706908", "https://doi.pangaea.de/10.1594/PANGAEA.706908"
    )), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"
))

data <- bind_rows(list(data_a,data_b), .id="data_source")

# 定义北极立体投影CRS
arctic_crs <- leafletCRS(
  crsClass = "L.Proj.CRS",
  code = "EPSG:3413",
  proj4def = "+proj=stere +lat_0=90 +lat_ts=70 +lon_0=-45 +k=1 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs",
  resolutions = c(8192, 4096, 2048, 1024, 512, 256, 128)
)

# 适配极地投影的底图瓦片
arctic_tiles <- "https://tiles.arcticconnect.ca/osm/{z}/{x}/{y}.png"

icons <- awesomeIcons(
  icon = 'ios-close',
  iconColor = 'black',
  library = 'ion',
  markerColor = ifelse(data$data_source == 1, "green","red")
)

# 创建极地投影地图
map <- leaflet(data, options = leafletOptions(crs = arctic_crs)) %>%
  addTiles(urlTemplate = arctic_tiles) %>%
  addAwesomeMarkers(lng = ~Long, lat = ~Lat, icon = icons) %>%
  setView(lng = 139, lat = 88, zoom = 3)  # 聚焦北极区域

print(map)

关键说明:

  • 自定义CRS:使用leafletCRS()定义EPSG:3413参数,该投影专为北极区域设计,可提升高纬度点的空间分辨率。
  • 适配底图:必须使用支持该投影的瓦片服务,否则底图会错位,代码中使用的是适配北极投影的OSM瓦片。
  • 视图聚焦:通过setView()直接定位北极区域,确保高纬度点显示清晰。

若需南极投影,只需将CRS替换为EPSG:3031,proj4参数改为"+proj=stere +lat_0=-90 +lat_ts=-71 +lon_0=0 +k=1 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs",并更换为南极适配的底图即可。

内容的提问来源于stack exchange,提问作者Weiss

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.06 01:27:04