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 is a meta-network which holds a database of plot-based tree demographic data. They have a web map with useful metadata, but this map doesn’t look great and I didn’t want to just include a screenshot.
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")