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
相关产品推荐
相关产品推荐

