如何用R从Leaflet生成的交互式地图提取多边形数据？

我想要爬取https://fogocruzado.org.br/mapadosgruposarmados这个交互式地图里的多边形数据，该地图展示了不同年份武装团体控制的区域，目标是自动化提取所有年份数据并保存为多个shapefile。官方虽提到有API，但这类特定数据无法通过API获取。我尝试了以下代码，但结果毫无意义：

# Load the HTML file
html_file = read_html(html_path)

# Extract path data from the HTML
path_data = html_file %>%
  html_nodes("path.leaflet-interactive") %>%
  html_attr("d")

# Function to clean and extract coordinates from path data
clean_coordinates <- function(path) {
  # Remove "M", "L", "z" commands (move, line, close)
  path <- gsub("[MLz]", "", path)  # Remove M, L, and z commands
  path <- gsub("[^0-9,.-]", " ", path)  # Remove any non-numeric characters except comma and period
  coords <- strsplit(path, " ")  # Split by spaces to separate coordinates
  coords <- as.numeric(unlist(coords))  # Flatten list and convert to numeric
  
  # Ensure coordinates are in pairs (lat, lon)
  coords_matrix <- matrix(coords, ncol = 2, byrow = TRUE)
  
  # Ensure the coordinates are in [lon, lat] order for GeoJSON
  coords_matrix <- coords_matrix[, c(2, 1)]  # Switch lat, lon order
  
  # Optionally, adjust the coordinates if they are too far off (e.g., by shifting or scaling)
  # coords_matrix <- coords_matrix - min(coords_matrix, na.rm = TRUE)  # Adjust if needed
  
  return(coords_matrix)
}

# Apply the function to clean the coordinates
coordinates_list <- lapply(path_data, clean_coordinates)

# Create GeoJSON features
geojson <- list(
  type = "FeatureCollection",
  features = lapply(coordinates_list, function(coord) {
    list(
      type = "Feature",
      geometry = list(
        type = "Polygon",  # or "LineString" based on the data
        coordinates = list(coord)  # Directly use the coordinates list
      )
    )
  })
)

# Convert the result to JSON
geojson_json <- toJSON(geojson, pretty = TRUE)

问题原因与解决办法 #

你当前的方法无效，是因为HTML里path元素的d属性存储的是前端渲染后的像素坐标，不是真实的经纬度。Leaflet会把地理坐标转成墨卡托投影的像素坐标再绘制，直接解析这些像素值自然得不到有用的地理数据。

方案1：抓包获取原始数据源（推荐） #

1. 打开浏览器开发者工具（按F12），切换到「网络」标签页；
2. 刷新地图页面，切换年份，观察XHR/fetch请求，找到加载多边形数据的接口（通常返回GeoJSON格式）；
3. 用R直接请求该接口，获取原始经纬度数据，再转存为shapefile：

library(httr)
library(jsonlite)
library(sf)

# 替换为抓包得到的真实接口地址
api_url <- "此处替换为抓包获取的数据源URL"
resp <- GET(api_url)
geo_data <- fromJSON(content(resp, "text"))

# 转换为sf空间对象并保存
sf_obj <- st_as_sf(geo_data)
st_write(sf_obj, "武装团体控制区域_年份.shp")

4. 自动化遍历所有年份：如果接口URL包含年份参数（比如?year=2020），用循环批量处理：

target_years <- 2015:2024 # 替换为实际年份范围
base_url <- "基础接口地址?year="

for(year in target_years) {
  curr_url <- paste0(base_url, year)
  resp <- GET(curr_url)
  geo_data <- fromJSON(content(resp, "text"))
  sf_obj <- st_as_sf(geo_data)
  st_write(sf_obj, paste0("武装团体控制区域_", year, ".shp"))
}

方案2：用RSelenium模拟浏览器获取数据 #

如果找不到数据源接口，可通过模拟浏览器操作，直接从地图图层提取GeoJSON数据：

library(RSelenium)
library(sf)

# 启动Chrome浏览器驱动
driver <- rsDriver(browser = "chrome")
remDr <- driver[["client"]]
remDr$navigate("https://fogocruzado.org.br/mapadosgruposarmados")

# 模拟切换年份（需根据页面实际元素调整选择器）
year_dropdown <- remDr$findElement(using = "css", value = "选择器")
year_dropdown$sendKeysToElement(list("2020"))

# 从地图图层提取GeoJSON数据（需调整图层名称）
geo_json <- remDr$executeScript("return map.getLayer('目标图层ID').toGeoJSON();")
sf_obj <- st_as_sf(geo_json)
st_write(sf_obj, "武装团体控制区域_2020.shp")

# 关闭浏览器和驱动
remDr$close()
driver$server$stop()

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