💾 Archived View for republic.circumlunar.space › users › johngodlee › posts › 2023-10-05-fp_scrape.g… captured on 2024-07-09 at 00:55:29. Gemini links have been rewritten to link to archived content
⬅️ Previous capture (2023-12-28)
-=-=-=-=-=-=-
DATE: 2023-10-05
AUTHOR: John L. Godlee
I was making a presentation about vegetation monitoring networks and wanted a map showing the spatial distribution of vegetation monitoring plots across the tropics. ForestPlots.net[1] is a meta-network which holds a database of plot-based tree demographic data. They have a web map[2] with useful metadata, but this map doesn't look great and I didn't want to just include a screenshot.
2: https://forestplots.net/en/map
Looking at the source for the webpage, I saw that the map is embedded, with this URL:
https://georgeflex.maps.arcgis.com/apps/Embed/index.html?webmap=df5f3c6ca21a44c5ba7c39d9355ff9dd&extent=-108.9111,-61.228,76.7139,43.5167&zoom=true&previewImage=false&scale=true&disable_scroll=true&theme=light
The ID of the map is an API endpoint that can be used to load the data underlying the map directly:
https://www.arcgis.com/sharing/rest/content/items/df5f3c6ca21a44c5ba7c39d9355ff9dd/data
From there, I can save the JSON file and process it further in R.
First I load some packages and import the data:
# Packages library(rjson) library(dplyr) library(sf) library(rnaturalearth) library(ggplot2) # Import data json_file <- "./fp_arcgis_fmt.json" dat <- fromJSON(paste(readLines(json_file), collapse = ""))
Then I need to extract the map features from the JSON file. It took some trial and error to understand the structure of the JSON:
# Extract feature collections from JSON file f <- lapply(dat$operationalLayers[2:length(dat$operationalLayers)], function(x) { x$featureCollection$layers[[1]]$featureSet$features }) # Combine the feature collections into one list fu <- unlist(f, recursive = FALSE) # Extract metadata and plot locations fl <- lapply(fu, function(x) { list( lon = as.numeric(x$geometry$x), lat = as.numeric(x$geometry$y), plot_id = as.character(x$attributes$PlotCode), country = as.character(x$attributes$Country), plot_type = as.character(x$attributes$plottype), network = as.character(x$attributes$Network), prinv = as.character(x$attributes$PI_map)) }) # Replace NULL entries with NA flc <- lapply(fl, function(x) { lapply(x, function(y) { if (is.null(y) | length(y) == 0) { NA_character_ } else { y } }) }) # Make dataframe with metadata and plot locations fdf <- bind_rows(lapply(flc, as.data.frame))
Then to create the map I need to convert the dataframe into an sf object and transform the projection from web Mercator (3857) to WGS84 (4326), get the world map object, and recode the network names to make the legend easier to read:
# Make into sf dataframe fsf <- st_as_sf(fdf, coords = c("lon", "lat"), crs = 3857) %>% st_transform(4326) # Get world map world <- ne_countries(returnclass = "sf") # Recode network names fsf$network <- case_when( fsf$network %in% c("AfriTRON", "AfriTRON / TROBIT") ~ "AfriTRON", fsf$network == "." ~ NA_character_, fsf$network %in% c("COL-TREE", "COL-TREE / RAINFOR", "RAINFOR", "RAINFOR / COL-TREE") ~ "RAINFOR", fsf$network %in% c("FATE", "FATE / RAINFOR", "FATE/CNPQ") ~ "FATE", fsf$network %in% c("GEM", "GEM / TROBIT", "GEM/AfriTRON", "SAFE GEM") ~ "GEM", fsf$network == "TEAM / MonANPeru" ~ "TEAM", TRUE ~ fsf$network)
Then finally I can create the map
# Create map fp_map <- ggplot() + geom_sf(data = world, fill = NA, colour = "black", size = 0.4) + geom_sf(data = fsf, aes(colour = network)) + scale_colour_discrete(name = "Network") + theme_bw() + theme(legend.position = "bottom") + labs(x = NULL, y = NULL) + coord_sf(expand = FALSE, xlim = c(-95, 166), ylim = c(-40, 20)) ggsave(fp_map, width = 11, height = 5, file = "fp_map.png")