---
title: "Ingest Turtle Distributions from SWOT Global Distributions and NMFS Distinct Population Segments (DPS)"
format:
html:
code-fold: true
code-tools: true
editor_options:
chunk_output_type: console
---
## Overview
The problem is that sea turtle distributions were too broad in the original Aquamaps and IUCN range maps. Furthermore, some species have differential protection status across their range according to NOAA Fisheries. The solution is to use the more refined distributions from the SWOT Global Distributions and NMFS Distinct Population Segments (DPS) datasets.
- **SWOT** global distributions define the species' range polygons.
- **NMFS DPS** boundaries identify Endangered sub-populations for species with mixed EN/TN status.
- For species with DPS data (CC, CM, LO): EN DPS areas → Endangered (value=100), remainder → Threatened (value=50).
- For purely Endangered species (DC, EI, LK): entire SWOT range → Endangered (value=100).
```{r}
#| label: setup
librarian::shelf(
arcgislayers,
arcgisutils,
DBI,
dplyr,
DT,
duckdb,
ggplot2,
glue,
here,
janitor,
litedown,
mapgl,
mapview,
msens,
purrr,
RColorBrewer,
readr,
rlang,
sf,
stringr,
terra,
tibble,
tidyr,
quiet = T
)
options(readr.show_col_types = F)
terraOptions(progress = 0)
source(here("libs/paths.R"))
# helper function to convert ArcGIS FeatureService to sf
fs_to_sf <- function(url, where = "LISTSTATUS IN ('Endangered')") {
fs <- arcgislayers::arc_open(url)
lyr <- arcgislayers::get_layer(fs, 0)
sf <- arcgislayers::arc_select(
lyr,
where = where
) |>
tibble::tibble() |>
sf::st_as_sf() |>
janitor::clean_names()
return(sf)
}
# paths
spp_csv <- here("data/nmfs_species-directory.csv")
dir_dps <- "~/My Drive/projects/msens/data/raw/fisheries.noaa.gov/turtle-DPS_endangered"
ds_key <- "rng_turtle_swot_dps"
dir_swot <- glue("{dir_raw}/swot_seamap.env.duke.edu/swot_distribution")
dir_out <- glue("{dir_derived}/turtle_swot_dps")
dir.create(dir_out, showWarnings = F, recursive = T)
cell_tif <- glue("{dir_derived}/r_bio-oracle_planarea.tif")
# variables
dps <- list(
lo = "https://services2.arcgis.com/C8EMgrsFcRFL6LrL/arcgis/rest/services/SeaTurtleOliveRidley_PacificMexicoPopulation/FeatureServer",
cc = "https://services2.arcgis.com/C8EMgrsFcRFL6LrL/arcgis/rest/services/SeaTurtleLoggerhead_AllDPS_20250609/FeatureServer",
cm = "https://services2.arcgis.com/C8EMgrsFcRFL6LrL/arcgis/rest/services/SeaTurtleGreen_AllDPS_20250609/FeatureServer"
)
swot_spp <- tribble(
~code , ~sci_name , ~common_name , ~shp_name , ~has_dps , ~esa_pure ,
"CC" , "Caretta caretta" , "Loggerhead" , "Global_Distribution_CC" , TRUE , NA ,
"CM" , "Chelonia mydas" , "Green" , "Global_Distribution_CM" , TRUE , NA ,
"DC" , "Dermochelys coriacea" , "Leatherback" , "Global_Distribution_DC" , FALSE , "EN" ,
"EI" , "Eretmochelys imbricata" , "Hawksbill" , "Global_Distribution_EI" , FALSE , "EN" ,
"LK" , "Lepidochelys kempii" , "Kemp's Ridley" , "Global_Distribution_LK" , FALSE , "EN" ,
"LO" , "Lepidochelys olivacea" , "Olive Ridley" , "Global_Distribution_LO" , TRUE , NA
)
# database
con_sdm <- dbConnect(duckdb(dbdir = sdm_db, read_only = F))
```
## NMFS Species Directory
- [Species Directory | NOAA Fisheries](https://www.fisheries.noaa.gov/species-directory)\
CSV: [`nmfs_species-directory.csv`](https://github.com/MarineSensitivity/workflows/blob/main/data/nmfs_species-directory.csv)\
generated by MarineSensitivity/workflows:ingest_fisheries.noaa.gov_critical-habitat.qmd
```{r}
#| label: tbl-spp_nmfs
#| tbl-cap: "NOAA Fisheries Species Directory for Sea Turtles"
d_spp <- read_csv(spp_csv) |>
mutate(
category = strsplit(category, ";\\s*"),
is_en = str_detect(protected_status, "ESA Endangered"),
is_tn = str_detect(protected_status, "ESA Threatened"),
is_en_or_tn = (is_en | is_tn),
is_en_and_tn = (is_en & is_tn)
) |>
unnest(category) |>
filter(category == "Sea Turtles")
d_spp |>
rowwise() |>
mutate(
name = litedown::mark(
text = glue("[{common_name}]({species_url}) (_{scientific_name}_)")
),
across(where(is.logical), ~ ifelse(.x, "✅", "❌"))
) |>
relocate(name) |>
select(
-c(common_name, scientific_name, species_url, also_known_as, category)
) |>
datatable(escape = F)
```
In summary:
- **All** turtles are either ESA Endangered _**or**_ Threatened: `is_en_or_tn` = ✅
- **Some** turtles are both ESA Endangered _**and**_ Threatened: `is_en_and_tn` = ✅\
By extracting the Distinct Population Segments that are Endangered, we can then assign the rest of the global population to Threatened.
## Fetch NOAA Fisheries Distinct Population Segments (DPS) from ArcGIS Feature Services
```{r}
#| label: fig-fetch_dps
#| fig-cap: "Fetch NMFS Distinct Population Segments (DPS) from ArcGIS Feature Services"
for (sp in names(dps)) {
url <- dps[[sp]]
gpkg <- glue("{dir_dps}/{sp}_endangered.gpkg")
if (file.exists(gpkg)) {
message(glue(
"{sp}: SKIP fetching DPS since already exists: {basename(gpkg)}"
))
next
}
fs_to_sf(url) |>
write_sf(gpkg, delete_dsn = TRUE)
message(glue("{sp}: FETCHED DPS and saved to: {basename(gpkg)}"))
}
# read all gpkg files and bind into one sf object
sf_dps <- list.files(dir_dps, pattern = "\\.gpkg$", full.names = TRUE) |>
purrr::map_dfr(read_sf)
mapview::mapView(sf_dps, zcol = "comname")
```
## Load SWOT Global Distributions
```{r}
#| label: load_swot
sf_swot <- swot_spp |>
pmap_dfr(\(code, sci_name, common_name, shp_name, ...) {
st_read(glue("{dir_swot}/{shp_name}.shp"), quiet = T) |>
st_make_valid() |>
mutate(
code = code,
sci_name = sci_name,
common_name = common_name
) |>
select(code, sci_name, common_name, geometry)
})
message(glue(
"Loaded {nrow(sf_swot)} SWOT features for ",
"{length(unique(sf_swot$sci_name))} species"
))
```
## Combine SWOT + DPS
For species with DPS data (CC, CM, LO): EN DPS areas are clipped from the SWOT range as Endangered, the remainder becomes Threatened. For purely Endangered species (DC, EI, LK): the entire SWOT range is Endangered.
```{r}
#| label: combine_swot_dps
sf_combined <- pmap_dfr(
swot_spp,
\(code, sci_name, common_name, shp_name, has_dps, esa_pure) {
swot_geom <- sf_swot |> filter(code == !!code)
if (has_dps) {
# read EN DPS, union into single geometry
gpkg_en <- glue("{dir_dps}/{tolower(code)}_endangered.gpkg")
sf_en <- read_sf(gpkg_en) |> st_make_valid()
en_union <- st_union(sf_en) |> st_make_valid()
# union swot_geom to single geometry before st_difference
swot_union <- st_union(swot_geom) |> st_make_valid()
# erase EN areas from SWOT global → TN remainder
tn_geom <- st_difference(swot_union, en_union) |>
st_as_sf() |>
st_make_valid() |>
mutate(code = code, sci_name = sci_name, common_name = common_name)
en_geom <- st_intersection(swot_union, en_union) |>
st_as_sf() |>
st_make_valid() |>
mutate(code = code, sci_name = sci_name, common_name = common_name)
bind_rows(
tn_geom |>
mutate(
esa_code = "TN",
value = msens::compute_er_score("NMFS:TN")
),
en_geom |>
mutate(
esa_code = "EN",
value = msens::compute_er_score("NMFS:EN")
)
) |>
select(code, sci_name, common_name, esa_code, value, geometry = x)
} else {
# purely EN species — entire SWOT range
swot_geom |>
mutate(
esa_code = esa_pure,
value = msens::compute_er_score(glue("NMFS:{esa_pure}"))
)
}
}
) |>
select(code, sci_name, common_name, esa_code, value, geometry)
message(glue(
"Combined: {nrow(sf_combined)} features, ",
"{length(unique(sf_combined$sci_name))} species"
))
```
## Save Geopackage
```{r}
#| label: save_gpkg
gpkg_out <- glue("{dir_out}/turtle_swot_dps.gpkg")
write_sf(sf_combined, gpkg_out, delete_dsn = TRUE)
message(glue("Saved: {gpkg_out}"))
```
## Rasterize
```{r}
#| label: rasterize
r_cell <- rast(cell_tif, lyrs = "cell_id")
r_cell_r <- rotate(r_cell)
ext(r_cell_r) <- round(ext(r_cell_r), 3)
for (i in 1:nrow(swot_spp)) {
sp <- swot_spp[i, ]
p_sp <- sf_combined |>
filter(code == sp$code) |>
(\(x) {
geom_types <- st_geometry_type(x)
if (any(geom_types == "GEOMETRYCOLLECTION")) {
x <- st_collection_extract(x, "POLYGON")
}
# drop any degenerate non-polygon geometries (e.g. LINESTRING slivers)
x[st_geometry_type(x) %in% c("POLYGON", "MULTIPOLYGON"), ]
})() |>
st_cast("MULTIPOLYGON") |>
vect()
r_tif <- glue("{dir_out}/{str_replace_all(sp$sci_name, ' ', '_')}.tif")
r_sp <- rasterize(
p_sp,
r_cell_r,
field = "value",
fun = "max",
touches = T
) |>
rotate() |>
crop(r_cell) |>
mask(r_cell)
names(r_sp) <- sp$sci_name
writeRaster(r_sp, r_tif, overwrite = T)
n_cells <- length(values(r_sp, na.rm = T))
message(glue(
"{sp$code} {sp$sci_name}: {format(n_cells, big.mark=',')} cells → {basename(r_tif)}"
))
}
```
## Insert into sdm.duckdb
### Add `dataset`
```{r}
#| label: insert_dataset
row_dataset <- tibble(
ds_key = !!ds_key,
name_short = "SWOT Global + NMFS DPS turtle ranges",
name_original = "SWOT Global Distributions with NMFS DPS ESA overlay",
description = "SWOT sea turtle global distributions overlaid with NMFS Endangered Distinct Population Segments. EN DPS areas coded as Endangered (value=100), remainder as Threatened (value=50).",
citation = "Wallace BP et al. (2023) Marine turtle regional management units 2.0. Endangered Species Research 52:209-223. DOI:10.3354/esr01243",
source_broad = "SWOT/NMFS",
source_detail = "https://www.seaturtlestatus.org/online-map-data; https://noaa.maps.arcgis.com/home/search.html?restrict=true&sortField=relevance&sortOrder=desc&searchTerm=turtle+DPS#content",
regions = "Global",
response_type = "binary",
taxa_groups = "turtles",
year_pub = 2023,
date_obs_beg = NA,
date_obs_end = NA,
date_env_beg = NA,
date_env_end = NA,
link_info = "https://www.seaturtlestatus.org/online-map-data",
link_download = NA,
link_metadata = NA,
links_other = NA,
spatial_res_deg = 0.05,
temporal_res = "static",
name_display = "SWOT+DPS Turtle Range",
value_info = "EN:100, TN:50",
is_mask = TRUE,
sort_order = 8L
)
# check for missing fields (auto-default fields like date_created are ok to skip)
flds_db <- dbListFields(con_sdm, "dataset")
flds_auto <- c("date_created", "global_mask_priority")
flds_miss <- setdiff(flds_db, c(names(row_dataset), flds_auto))
if (length(flds_miss) > 0) {
stop(glue(
"Missing fields in row_dataset: {paste(flds_miss, collapse = ', ')}"
))
}
if (dbExistsTable(con_sdm, "dataset")) {
dbExecute(con_sdm, glue("DELETE FROM dataset WHERE ds_key = '{ds_key}'"))
}
dbWriteTable(con_sdm, "dataset", row_dataset, append = TRUE)
# set global_mask_priority (column may not exist yet; created by merge_models.qmd)
tryCatch(
{
dbExecute(
con_sdm,
glue(
"ALTER TABLE dataset ADD COLUMN IF NOT EXISTS global_mask_priority DECIMAL"
)
)
dbExecute(
con_sdm,
glue(
"UPDATE dataset SET global_mask_priority = 1.0 WHERE ds_key = '{ds_key}'"
)
)
message("Set global_mask_priority = 1.0")
},
error = function(e) {
message(glue("Note: could not set global_mask_priority: {e$message}"))
}
)
message("Inserted dataset row")
```
### Add `species`, `model`, `model_cell`
```{r}
#| label: insert_spp_model_cell
# attach spp.duckdb for WoRMS lookups
dbExecute(
con_sdm,
glue("ATTACH OR REPLACE DATABASE '{spp_db}' AS spp (READ_ONLY);")
)
for (i in 1:nrow(swot_spp)) {
sp <- swot_spp[i, ]
sp_key <- glue("{ds_key}:{sp$code}")
r_sp <- rast(glue("{dir_out}/{str_replace_all(sp$sci_name, ' ', '_')}.tif"))
ext(r_sp) <- round(ext(r_sp), 3)
message(glue(
"Processing {i}/{nrow(swot_spp)} {sp_key}: {sp$common_name} ({sp$sci_name})"
))
# idempotent delete ----
mdl_seqs <- tbl(con_sdm, "model") |>
filter(ds_key == !!ds_key, taxa == !!sp_key) |>
pull(mdl_seq)
if (length(mdl_seqs) > 0) {
dbExecute(
con_sdm,
glue("DELETE FROM model WHERE ds_key = '{ds_key}' AND taxa = '{sp_key}'")
)
dbExecute(
con_sdm,
glue(
"DELETE FROM species WHERE ds_key = '{ds_key}' AND taxa = '{sp_key}'"
)
)
dbExecute(
con_sdm,
glue(
"DELETE FROM model_cell WHERE mdl_seq IN ({paste(mdl_seqs, collapse = ',')})"
)
)
}
# append: model ----
dbWriteTable(
con_sdm,
"model",
tibble(
ds_key = ds_key,
taxa = sp_key,
time_period = "2025",
region = "Global",
mdl_type = "binary",
description = glue("SWOT+DPS range for {sp$sci_name}")
),
append = T
)
mdl_seq <- dbGetQuery(
con_sdm,
glue(
"SELECT mdl_seq FROM model
WHERE ds_key = '{ds_key}' AND taxa = '{sp_key}'
ORDER BY mdl_seq DESC LIMIT 1"
)
)$mdl_seq
# WoRMS lookup ----
worms_id <- tbl(con_sdm, "spp.worms") |>
filter(scientificName == !!sp$sci_name, taxonomicStatus == "accepted") |>
pull(acceptedNameUsageID) |>
first()
# append: species ----
d_species <- tibble(
ds_key = ds_key,
taxa = sp_key,
sp_key = sp_key,
worms_id = worms_id,
gbif_id = NA_integer_,
itis_id = NA_integer_,
iucn_id = NA_integer_,
scientific_name_dataset = sp$sci_name,
common_name_dataset = sp$common_name,
scientific_name_accepted = sp$sci_name,
common_name_accepted = sp$common_name,
redlist_code = NA_character_,
redlist_year = NA_integer_,
sp_cat = "turtle"
)
dbWriteTable(con_sdm, "species", d_species, append = T)
# append: model_cell ----
d_mdl_cell <- as.data.frame(r_sp, cells = T, na.rm = T) |>
tibble() |>
select(cell_id = cell, value = 2) |>
mutate(mdl_seq = mdl_seq) |>
arrange(cell_id)
dbWriteTable(con_sdm, "model_cell", d_mdl_cell, append = T)
message(glue(
" → mdl_seq={mdl_seq}, {format(nrow(d_mdl_cell), big.mark=',')} cells"
))
}
dbDisconnect(con_sdm, shutdown = TRUE)
```
### Add `taxon_model` entries
```{r}
#| label: insert_taxon_model
con_sdm <- dbConnect(duckdb(dbdir = sdm_db, read_only = F))
# idempotent delete
dbExecute(
con_sdm,
glue(
"DELETE FROM taxon_model WHERE ds_key = '{ds_key}'"
)
)
for (i in 1:nrow(swot_spp)) {
sp <- swot_spp[i, ]
sp_key <- glue("{ds_key}:{sp$code}")
# look up taxon_id by scientific_name
tid <- tbl(con_sdm, "taxon") |>
filter(scientific_name == !!sp$sci_name) |>
pull(taxon_id)
if (length(tid) == 0) {
message(glue("SKIP {sp$sci_name}: not found in taxon table"))
next
}
# look up mdl_seq
mdl_seq <- dbGetQuery(
con_sdm,
glue(
"SELECT mdl_seq FROM model
WHERE ds_key = '{ds_key}' AND taxa = '{sp_key}'
ORDER BY mdl_seq DESC LIMIT 1"
)
)$mdl_seq
d_tm <- tibble(taxon_id = tid, ds_key = ds_key, mdl_seq = mdl_seq)
dbWriteTable(con_sdm, "taxon_model", d_tm, append = TRUE)
message(glue(
"Added taxon_model: {sp$sci_name} taxon_id={tid}, mdl_seq={mdl_seq}"
))
}
# update n_ds count
dbExecute(
con_sdm,
"UPDATE taxon
SET n_ds = tm.n_ds
FROM (
SELECT taxon_id, COUNT(*) AS n_ds
FROM taxon_model
GROUP BY taxon_id
) tm
WHERE taxon.taxon_id = tm.taxon_id"
)
dbDisconnect(con_sdm, shutdown = TRUE)
```
## Compare IUCN vs SWOT+DPS
```{r}
#| label: compare_setup
# shared color palette and fixed range (matches apps/mapsp)
n_cols <- 11
cols_spectral <- rev(brewer.pal(n_cols, "Spectral"))
FIXED_RANGE <- c(1, 100)
# reconnect to database (read-only for comparison)
con_sdm <- dbConnect(duckdb(dbdir = sdm_db, read_only = TRUE))
r_cell <- rast(cell_tif, lyrs = "cell_id")
# helper: convert model_cell rows to a trimmed raster (0-360 coords)
get_rast <- function(mdl_seq) {
d <- tbl(con_sdm, "model_cell") |>
filter(mdl_seq == !!mdl_seq) |>
select(cell_id, value) |>
collect()
r <- init(r_cell[[1]], NA)
r[d$cell_id] <- d$value
names(r) <- "value"
terra::trim(r)
}
# helper: add raster with fixed color range
add_fixed_range_raster <- function(
map,
data,
id,
fixed_range = FIXED_RANGE,
colors = cols_spectral,
...
) {
dr <- terra::minmax(data) |> as.numeric()
dr[1] <- max(dr[1], fixed_range[1])
dr[2] <- min(dr[2], fixed_range[2])
n_clrs <- diff(fixed_range) + 1
clrs <- colorRampPalette(colors)(n_clrs)
clrs_dr <- clrs[seq.int(dr[1], dr[2])]
map |>
add_image_source(
id = paste0(id, "_src"),
data = terra::clamp(
data,
lower = fixed_range[1],
upper = fixed_range[2],
values = TRUE
),
colors = clrs_dr
) |>
add_raster_layer(
id = id,
source = paste0(id, "_src"),
...
)
}
# helper: convert 0-360 extent bbox to -180/180 for fit_bounds
bbox_0360_to_180 <- function(r) {
e <- as.vector(ext(r))
c(
ifelse(e[1] > 180, e[1] - 360, e[1]),
e[3],
ifelse(e[2] > 180, e[2] - 360, e[2]),
e[4]
)
}
# N America bbox: Alaska + CONUS (xmin, ymin, xmax, ymax)
BBOX_NAMER <- c(-180, 10, -50, 72)
# helper: build a mapgl raster map (rasters in 0-360 coords)
map_rast <- function(r, title = "value") {
maplibre(
style = maptiler_style("bright", variant = "dark")
) |>
fit_bounds(BBOX_NAMER, animate = FALSE) |>
add_fixed_range_raster(
data = r,
id = "r_lyr",
raster_opacity = 0.7,
raster_resampling = "nearest"
) |>
mapgl::add_legend(
legend_title = title,
values = FIXED_RANGE,
colors = cols_spectral,
position = "bottom-right"
) |>
add_fullscreen_control() |>
add_navigation_control() |>
add_scale_control()
}
# get IUCN model sequences for turtles
d_iucn_mdls <- tbl(con_sdm, "species") |>
filter(ds_key == "rng_iucn", sp_cat == "turtle") |>
select(scientific_name_accepted, sp_key) |>
left_join(
tbl(con_sdm, "model") |> select(taxa, mdl_seq),
by = c("sp_key" = "taxa")
) |>
collect()
# get SWOT+DPS model sequences
d_swot_mdls <- tbl(con_sdm, "species") |>
filter(ds_key == !!ds_key) |>
select(scientific_name_accepted, sp_key) |>
left_join(
tbl(con_sdm, "model") |> select(taxa, mdl_seq),
by = c("sp_key" = "taxa")
) |>
collect()
```
::: {.panel-tabset}
### Loggerhead
```{r}
#| label: compare_cc
sp_sci <- "Caretta caretta"
sp_lbl <- "Loggerhead"
mdl_iucn <- d_iucn_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
mdl_swot <- d_swot_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
if (length(mdl_iucn) > 0 && length(mdl_swot) > 0) {
r_iucn <- get_rast(mdl_iucn)
r_swot <- get_rast(mdl_swot)
m1 <- map_rast(r_iucn, glue("{sp_lbl} IUCN"))
m2 <- map_rast(r_swot, glue("{sp_lbl} SWOT+DPS"))
mapgl::compare(m1, m2) |> suppressMessages()
} else {
message(glue("Missing IUCN or SWOT+DPS model for {sp_sci}"))
}
```
### Green
```{r}
#| label: compare_cm
sp_sci <- "Chelonia mydas"
sp_lbl <- "Green"
mdl_iucn <- d_iucn_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
mdl_swot <- d_swot_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
if (length(mdl_iucn) > 0 && length(mdl_swot) > 0) {
r_iucn <- get_rast(mdl_iucn)
r_swot <- get_rast(mdl_swot)
m1 <- map_rast(r_iucn, glue("{sp_lbl} IUCN"))
m2 <- map_rast(r_swot, glue("{sp_lbl} SWOT+DPS"))
mapgl::compare(m1, m2) |> suppressMessages()
} else {
message(glue("Missing IUCN or SWOT+DPS model for {sp_sci}"))
}
```
### Leatherback
```{r}
#| label: compare_dc
sp_sci <- "Dermochelys coriacea"
sp_lbl <- "Leatherback"
mdl_iucn <- d_iucn_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
mdl_swot <- d_swot_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
if (length(mdl_iucn) > 0 && length(mdl_swot) > 0) {
r_iucn <- get_rast(mdl_iucn)
r_swot <- get_rast(mdl_swot)
m1 <- map_rast(r_iucn, glue("{sp_lbl} IUCN"))
m2 <- map_rast(r_swot, glue("{sp_lbl} SWOT+DPS"))
mapgl::compare(m1, m2) |> suppressMessages()
} else {
message(glue("Missing IUCN or SWOT+DPS model for {sp_sci}"))
}
```
### Hawksbill
```{r}
#| label: compare_ei
sp_sci <- "Eretmochelys imbricata"
sp_lbl <- "Hawksbill"
mdl_iucn <- d_iucn_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
mdl_swot <- d_swot_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
if (length(mdl_iucn) > 0 && length(mdl_swot) > 0) {
r_iucn <- get_rast(mdl_iucn)
r_swot <- get_rast(mdl_swot)
m1 <- map_rast(r_iucn, glue("{sp_lbl} IUCN"))
m2 <- map_rast(r_swot, glue("{sp_lbl} SWOT+DPS"))
mapgl::compare(m1, m2) |> suppressMessages()
} else {
message(glue("Missing IUCN or SWOT+DPS model for {sp_sci}"))
}
```
### Kemp's Ridley
```{r}
#| label: compare_lk
sp_sci <- "Lepidochelys kempii"
sp_lbl <- "Kemp's Ridley"
mdl_iucn <- d_iucn_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
mdl_swot <- d_swot_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
if (length(mdl_iucn) > 0 && length(mdl_swot) > 0) {
r_iucn <- get_rast(mdl_iucn)
r_swot <- get_rast(mdl_swot)
m1 <- map_rast(r_iucn, glue("{sp_lbl} IUCN"))
m2 <- map_rast(r_swot, glue("{sp_lbl} SWOT+DPS"))
mapgl::compare(m1, m2) |> suppressMessages()
} else {
message(glue("Missing IUCN or SWOT+DPS model for {sp_sci}"))
}
```
### Olive Ridley
```{r}
#| label: compare_lo
sp_sci <- "Lepidochelys olivacea"
sp_lbl <- "Olive Ridley"
mdl_iucn <- d_iucn_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
mdl_swot <- d_swot_mdls |>
filter(scientific_name_accepted == sp_sci) |>
pull(mdl_seq)
if (length(mdl_iucn) > 0 && length(mdl_swot) > 0) {
r_iucn <- get_rast(mdl_iucn)
r_swot <- get_rast(mdl_swot)
m1 <- map_rast(r_iucn, glue("{sp_lbl} IUCN"))
m2 <- map_rast(r_swot, glue("{sp_lbl} SWOT+DPS"))
mapgl::compare(m1, m2) |> suppressMessages()
} else {
message(glue("Missing IUCN or SWOT+DPS model for {sp_sci}"))
}
```
:::
```{r}
#| label: cleanup
dbDisconnect(con_sdm, shutdown = TRUE)
```