AKsf source code
Source:SOURCE-CODE.md
Read the package functions, data preparation, examples, tests, website build, and workflow code used by this checkout. Open a code panel to read or copy it. The listings are displayed without running them. See the guides for optional dependencies and instructions for running the examples.
_pkgdown.yml
Show/hide YAML code
url: https://jimianelli.github.io/AKsf/
destination: _site
template:
bootstrap: 5
home:
title: Alaska fisheries maps for R and GMT
navbar:
structure:
left: [intro, reference, articles, guides, news]
right: [search, github]
components:
guides:
text: Guides
menu:
- text: AFSC integrations
href: AFSC-INTEGRATION.html
- text: Source code
href: SOURCE-CODE.html
- text: Website publishing
href: GITHUB-PAGES.html
reference:
- title: Spatial data and provenance
contents:
- starts_with("get_")
- alaska_coast
- adfg_groundfish_registration_areas
- adfg_groundfish_statistical_areas
- fmp_areas
- nmfs_reporting_areas
- title: Map layers and style
contents:
- starts_with("plot_")
- coord_aksf
- proj_aksf
- theme_aksf
- title: GMT interoperability
contents:
- write_gmt
- title: Package
contents:
- AKsf-package
articles:
- title: Mapping articles
navbar: ~
contents:
- AKsf
- GMT
- Spatial-closures
- pollock-maps.github/workflows/pkgdown.yaml
Show/hide YAML code
name: Package website
on:
workflow_dispatch:
push:
branches: [main]
permissions:
contents: read
pages: write
id-token: write
concurrency:
group: github-pages
cancel-in-progress: true
jobs:
build:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
- uses: r-lib/actions/setup-pandoc@v2
- uses: r-lib/actions/setup-r@v2
with:
use-public-rspm: true
- uses: r-lib/actions/setup-r-dependencies@v2
with:
extra-packages: any::pkgdown, local::.
needs: website
- name: Test code disclosures
run: Rscript -e "testthat::test_file('pkgdown/test-code-disclosures.R', stop_on_failure=TRUE)"
- name: Build website
run: Rscript pkgdown/build.R
- uses: actions/upload-pages-artifact@v3
with:
path: _site
deploy:
if: github.event_name == 'workflow_dispatch'
needs: build
runs-on: ubuntu-latest
environment:
name: github-pages
url: ${{ steps.deployment.outputs.page_url }}
steps:
- uses: actions/deploy-pages@v4
id: deployment.github/workflows/R-CMD-check.yaml
Show/hide YAML code
name: R-CMD-check
on:
push:
pull_request:
permissions:
contents: read
jobs:
R-CMD-check:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [ubuntu-latest, macos-latest, windows-latest]
steps:
- uses: actions/checkout@v4
- uses: r-lib/actions/setup-r@v2
with:
use-public-rspm: true
- uses: r-lib/actions/setup-r-dependencies@v2
with:
extra-packages: any::rcmdcheck
needs: check
- uses: r-lib/actions/check-r-package@v2
with:
error-on: '"warning"'data-raw/build-data.R
Show/hide R code
# Run from the repository root after: python3 data-raw/download.py
# Dependencies: sf, jsonlite. No data are downloaded by this script.
library(sf)
stopifnot(file.exists("DESCRIPTION"), read.dcf("DESCRIPTION")[1, "Package"] == "AKsf")
cache <- "data-raw/cache"
file.copy(c("DATA_SOURCES.md", "LICENSE-DATA.md"), "inst", overwrite = TRUE)
dir.create("data", showWarnings = FALSE)
manifest <- jsonlite::fromJSON("inst/extdata/source-manifest.json")
read_source <- function(name) {
old_limit <- Sys.getenv("OGR_GEOJSON_MAX_OBJ_SIZE", unset = NA_character_)
on.exit(if (is.na(old_limit)) Sys.unsetenv("OGR_GEOJSON_MAX_OBJ_SIZE") else
Sys.setenv(OGR_GEOJSON_MAX_OBJ_SIZE = old_limit), add = TRUE)
Sys.setenv(OGR_GEOJSON_MAX_OBJ_SIZE = "256")
x <- st_read(file.path(cache, paste0(name, ".geojson")), quiet = TRUE)
expected <- manifest$feature_count[manifest$dataset == name]
stopifnot(nrow(x) == expected, !any(st_is_empty(x)))
# GEOS repairs in Alaska Albers avoid planar operations across the dateline.
x <- st_transform(x, 3338)
x <- st_make_valid(x)
stopifnot(all(st_is_valid(x)), !any(st_is_empty(x)))
x <- st_transform(x, 4326)
x$source_url <- manifest$source_url[manifest$dataset == name]
x$retrieved_utc <- manifest$retrieved_utc[manifest$dataset == name]
x
}
write_data <- function(name, x) {
assign(name, x)
save(list = name, file = file.path("data", paste0(name, ".rda")), compress = "xz", version = 2)
message(name, ": ", nrow(x), " features")
}
nmfs_reporting_areas <- read_source("nmfs_reporting_areas")
nmfs_reporting_areas$area_code <- as.character(nmfs_reporting_areas$REP_AREA)
nmfs_reporting_areas$area_name <- paste("NMFS", nmfs_reporting_areas$area_code)
nmfs_reporting_areas$authority <- "NOAA/NMFS"
nmfs_reporting_areas$area_type <- "reporting_area"
write_data("nmfs_reporting_areas", nmfs_reporting_areas)
adfg_groundfish_statistical_areas <- read_source("adfg_groundfish_statistical_areas")
adfg_groundfish_statistical_areas$area_code <- sprintf("%06d", adfg_groundfish_statistical_areas$STAT_AREA)
adfg_groundfish_statistical_areas$area_name <- adfg_groundfish_statistical_areas$REGISTRATION_AREA_NAME
adfg_groundfish_statistical_areas$authority <- "ADF&G"
adfg_groundfish_statistical_areas$area_type <- "groundfish_statistical_area"
stopifnot(!anyDuplicated(adfg_groundfish_statistical_areas$area_code))
write_data("adfg_groundfish_statistical_areas", adfg_groundfish_statistical_areas)
adfg_groundfish_registration_areas <- read_source("adfg_groundfish_registration_areas")
adfg_groundfish_registration_areas$area_code <- adfg_groundfish_registration_areas$REGISTRATION_AREA_CODE
adfg_groundfish_registration_areas$area_name <- adfg_groundfish_registration_areas$REGISTRATION_AREA_NAME
adfg_groundfish_registration_areas$authority <- "ADF&G"
adfg_groundfish_registration_areas$area_type <- "groundfish_registration_area"
write_data("adfg_groundfish_registration_areas", adfg_groundfish_registration_areas)
# The broad FMP reference polygons are explicit analytical derivatives.
# ADF&G FED polygons exclude STATE and INTL; do not dissolve all NMFS areas
# because those include state-water reporting areas and the Donut Hole.
stat <- st_transform(adfg_groundfish_statistical_areas, 3338)
federal <- stat[stat$WATERS_CODE == "FED", ]
reporting <- st_transform(nmfs_reporting_areas, 3338)
bsai_envelope <- st_union(st_geometry(reporting[reporting$SubArea %in% c("BS", "AI"), ]))
goa_envelope <- st_union(st_geometry(reporting[reporting$SubArea == "GOA", ]))
bsai <- st_intersection(st_union(st_geometry(federal[federal$FMP_AREA_CODE == "BSAI", ])), bsai_envelope)
goa <- st_intersection(st_union(st_geometry(federal[federal$FMP_AREA_CODE == "GOA", ])), goa_envelope)
# Densify meridians/parallels to <=0.01 degree before projection. A rectangle
# here is only a clipping mask applied to agency marine polygons, never a
# substitute for a shoreline or the EEZ boundary.
mask <- function(xmin, ymin, xmax, ymax) {
sx <- seq(xmin, xmax, length.out = ceiling((xmax - xmin)/0.01) + 1)
sy <- seq(ymin, ymax, length.out = ceiling((ymax - ymin)/0.01) + 1)
xy <- rbind(cbind(sx, ymin), cbind(xmax, sy[-1]),
cbind(rev(sx)[-1], ymax), cbind(xmin, rev(sy)[-1]))
st_transform(st_sfc(st_polygon(list(xy)), crs = 4326), 3338)
}
# Crab FMP section 3.1.2 uses Scotch Cap Light, not the groundfish 170 W line.
scotch_cap <- -(164 + 44/60 + 36/3600)
crab <- st_union(bsai, st_intersection(goa, mask(-180, 40, scotch_cap, 70)))
scallop <- st_union(bsai, goa)
arctic <- st_union(st_geometry(st_transform(read_source("arctic_management_area"), 3338)))
# Salmon FMP (October 2024), section 2.2. The NOAA ATB West polygon retains
# its source vintage and its PWS/Alaska Peninsula exclusions. It is not an
# independently redigitized legal boundary. Remove Cook Inlet explicitly.
cape_suckling <- -(143 + 53.6/60)
salmon_east <- st_intersection(goa, mask(cape_suckling, 40, -125, 65))
cook <- st_union(st_geometry(federal[federal$REGISTRATION_AREA_CODE == "H", ]))
cook <- st_intersection(cook, mask(-155, 59 + 46.15/60, -149, 64))
# Groundfish registration H also contains waters outside Cook Inlet. Select the
# connected federal-water polygon containing this interior Cook Inlet anchor.
cook_parts <- st_cast(cook, "POLYGON")
cook_anchor <- st_transform(st_sfc(st_point(c(-152.4, 60)), crs = 4326), 3338)
cook <- st_union(cook_parts[lengths(st_intersects(cook_parts, cook_anchor)) > 0])
stopifnot(length(cook) == 1, !st_is_empty(cook))
salmon_west <- st_union(st_geometry(st_transform(read_source("salmon_west_source"), 3338)))
salmon_west <- st_difference(salmon_west, cook)
geometries <- list(bsai, goa, crab, scallop, salmon_east, salmon_west, cook, arctic)
fmp_areas <- st_sf(
fmp_id = c("BSAI_GF", "GOA_GF", "BSAI_CRAB", "SCALLOP", rep("SALMON", 3), "ARCTIC"),
area_code = c("BSAI_GF", "GOA_GF", "BSAI_CRAB", "SCALLOP", "SALMON_EAST", "SALMON_WEST", "SALMON_COOK_INLET", "ARCTIC"),
area_name = c("Bering Sea and Aleutian Islands groundfish", "Gulf of Alaska groundfish",
"Bering Sea and Aleutian Islands king and Tanner crab", "Scallop federal management area",
"Salmon East Area", "Salmon West Area", "Salmon Cook Inlet EEZ Area", "Arctic Management Area"),
authority = "NPFMC / NOAA",
area_type = "fmp_reference_area",
geometry_basis = c(rep("adfg_federal_areas_clipped_to_noaa_reporting_envelope", 5),
"noaa_atb_west_source_minus_cook_inlet", "adfg_federal_areas_clipped_to_noaa_reporting_envelope", "noaa_atb_arctic_closure"),
source_url = c(rep(manifest$source_url[manifest$dataset == "adfg_groundfish_statistical_areas"], 5),
manifest$source_url[manifest$dataset == "salmon_west_source"],
manifest$source_url[manifest$dataset == "adfg_groundfish_statistical_areas"],
manifest$source_url[manifest$dataset == "arctic_management_area"]),
plan_library_url = "https://www.npfmc.org/library/fmps-feps/",
boundary_status = "cartographic_reference_not_regulatory",
geometry = st_sfc(lapply(geometries, function(x) st_cast(st_make_valid(x), "MULTIPOLYGON")[[1]]), crs = 3338)
)
stopifnot(all(st_is_valid(fmp_areas)), !any(st_is_empty(fmp_areas)))
fmp_areas$area_km2 <- as.numeric(st_area(fmp_areas))/1e6
write_data("fmp_areas", fmp_areas)
coast_path <- file.path(cache, "ne_10m_admin_1_states_provinces.zip")
coast_dir <- file.path(cache, "naturalearth")
unzip(coast_path, exdir = coast_dir)
land <- st_read(file.path(coast_dir, "ne_10m_admin_1_states_provinces.shp"), quiet = TRUE)
alaska_coast <- land[land$name == "Alaska" & land$admin == "United States of America", c("name", "admin")]
stopifnot(nrow(alaska_coast) == 1L)
alaska_coast <- st_transform(st_make_valid(st_transform(alaska_coast, 3338)), 4326)
alaska_coast$source_url <- manifest$source_url[manifest$dataset == "alaska_coast"]
write_data("alaska_coast", alaska_coast)
qa <- data.frame(dataset = c("nmfs_reporting_areas", "adfg_groundfish_statistical_areas",
"adfg_groundfish_registration_areas", "fmp_areas", "alaska_coast"))
qa$features <- vapply(qa$dataset, function(n) nrow(get(n)), integer(1))
qa$all_valid_albers <- vapply(qa$dataset, function(n) all(st_is_valid(st_transform(get(n), 3338))), logical(1))
qa$empty_features <- vapply(qa$dataset, function(n) sum(st_is_empty(get(n))), integer(1))
write.csv(qa, "inst/extdata/geometry-qa.csv", row.names = FALSE)
writeLines(trimws(capture.output(sessionInfo()), which = "right"), "inst/extdata/build-session.txt")data-raw/download-closure-example.py
Show/hide Python code
"""Refresh only the two-feature, historical NOAA vignette example."""
from pathlib import Path
from urllib.request import urlopen
from urllib.parse import urlencode
from datetime import datetime, timezone
import hashlib
import json
out = Path(__file__).resolve().parents[1] / 'inst/extdata/closure-example'
out.mkdir(parents=True, exist_ok=True)
service = 'https://alaskafisheries.noaa.gov/arcgis/rest/services/Base_Map/MapServer/5'
where = "HTM IN ('GOA_Slope_HCA.htm','GOA_Coral_HPA.htm')"
def fetch(params, query=True):
url = service + ('/query' if query else '') + '?' + urlencode(params)
with urlopen(url, timeout=90) as response:
raw = response.read()
obj = json.loads(raw)
if 'error' in obj:
raise RuntimeError(obj['error'])
return url, raw, obj
_, _, ids = fetch(dict(where=where, returnIdsOnly='true', f='json'))
expected = sorted(ids['objectIds'])
assert expected, 'No matching example features'
url, raw, obj = fetch(dict(objectIds=','.join(map(str, expected)),
outFields='*', outSR=4326, returnGeometry='true', f='geojson'))
assert not obj.get('exceededTransferLimit', False)
assert sorted(f['properties']['OBJECTID'] for f in obj['features']) == expected
(out / 'goa-habitat.geojson').write_bytes(raw)
_, metadata, _ = fetch(dict(f='pjson'), query=False)
(out / 'layer-metadata.json').write_bytes(metadata)
manifest = dict(source_url=service, query_url=url, where=where,
retrieved_utc=datetime.now(timezone.utc).isoformat(),
feature_count=len(expected), object_ids=expected,
sha256=hashlib.sha256(raw).hexdigest(),
source_dtd=sorted({f['properties']['dtd'] for f in obj['features']}),
status='Historical GIS teaching example, not current closure status',
geometry='Unmodified service response, requested WGS84 EPSG:4326')
(out / 'manifest.json').write_text(json.dumps(manifest, indent=2)+'\n')
print(json.dumps(manifest, indent=2))data-raw/download.py
Show/hide Python code
"""Download complete agency snapshots; run from the repository root.
Python standard library only. Existing cache is reused unless --refresh is set.
Object-ID batching avoids ArcGIS transfer-limit truncation.
"""
import concurrent.futures
import datetime
import hashlib
import json
from pathlib import Path
import sys
import time
import urllib.parse
import urllib.request
ROOT = Path(__file__).resolve().parents[1]
CACHE = ROOT / 'data-raw' / 'cache'
CACHE.mkdir(exist_ok=True)
SOURCES = {
'nmfs_reporting_areas': ('https://alaskafisheries.noaa.gov/arcgis/rest/services/Base_Map/MapServer/0', '1=1'),
'adfg_groundfish_statistical_areas': ('https://services.arcgis.com/VdkVOAHovLuozJG4/arcgis/rest/services/Groundfish_Statistical_Areas_2001/FeatureServer/0', '1=1'),
'adfg_groundfish_registration_areas': ('https://services.arcgis.com/VdkVOAHovLuozJG4/arcgis/rest/services/Commercial_Fisheries_Groundfish_Registration_Areas/FeatureServer/0', '1=1'),
'salmon_west_source': ('https://services2.arcgis.com/C8EMgrsFcRFL6LrL/arcgis/rest/services/NMFS_Management_Areas_ATB/FeatureServer/126', "SiteName = 'Salmon Management Area West' AND Action_Organization = 'NPFMC'"),
'arctic_management_area': ('https://services2.arcgis.com/C8EMgrsFcRFL6LrL/arcgis/rest/services/NMFS_Management_Areas_ATB/FeatureServer/126', "SiteName = 'Arctic Closure' AND Action_Organization = 'NPFMC'"),
}
def request(url, params):
url += '?' + urllib.parse.urlencode(params)
for attempt in range(4):
try:
with urllib.request.urlopen(url, timeout=180) as response:
obj = json.load(response)
if 'error' in obj:
raise RuntimeError(obj['error'])
return obj
except Exception:
if attempt == 3:
raise
time.sleep(2 ** attempt)
def download(item):
name, (url, where) = item
target = CACHE / (name + '.geojson')
record = CACHE / (name + '.provenance.json')
if target.exists() and record.exists() and '--refresh' not in sys.argv:
info = json.loads(record.read_text())
if hashlib.sha256(target.read_bytes()).hexdigest() != info['sha256']:
raise RuntimeError('Cached snapshot checksum mismatch: ' + name)
print('Using cache:', name, flush=True)
return info
meta = request(url, {'f': 'json'})
ids = request(url + '/query', {'where': where, 'returnIdsOnly': 'true', 'f': 'json'})
object_ids = sorted(ids['objectIds'])
if not object_ids:
raise RuntimeError('Empty source: ' + name)
features = []
for start in range(0, len(object_ids), 50):
part = request(url + '/query', {
'objectIds': ','.join(map(str, object_ids[start:start+50])),
'outFields': '*', 'returnGeometry': 'true', 'outSR': 4326, 'f': 'geojson',
})
if part.get('exceededTransferLimit'):
raise RuntimeError('Transfer limit reached: ' + name)
features.extend(part['features'])
oid = ids['objectIdFieldName']
received = [f['properties'][oid] for f in features]
if sorted(received) != object_ids:
raise RuntimeError('Missing/duplicate features: ' + name)
if any(f.get('geometry') is None for f in features):
raise RuntimeError('Missing geometry: ' + name)
payload = json.dumps({'type': 'FeatureCollection', 'features': features}, separators=(',', ':')).encode()
target.write_bytes(payload)
(CACHE / (name + '.metadata.json')).write_text(json.dumps(meta, indent=2))
info = dict(dataset=name, source_url=url, where=where, retrieved_utc=datetime.datetime.now(datetime.timezone.utc).isoformat(),
feature_count=len(features), output_crs='EPSG:4326', sha256=hashlib.sha256(payload).hexdigest(),
source_crs=meta.get('extent', {}).get('spatialReference'), source_editing_info=meta.get('editingInfo'))
record.write_text(json.dumps(info, indent=2))
print(name, len(features), 'features;', len(payload), 'bytes', flush=True)
return info
if __name__ == '__main__':
with concurrent.futures.ThreadPoolExecutor(max_workers=4) as pool:
records = list(pool.map(download, SOURCES.items()))
coast_url = 'https://naturalearth.s3.amazonaws.com/10m_cultural/ne_10m_admin_1_states_provinces.zip'
coast = CACHE / 'ne_10m_admin_1_states_provinces.zip'
coast_record = CACHE / 'coast10.provenance.json'
if not coast.exists() or '--refresh' in sys.argv:
urllib.request.urlretrieve(coast_url, coast)
coast_record.write_text(json.dumps(dict(dataset='alaska_coast', source_url=coast_url,
retrieved_utc=datetime.datetime.now(datetime.timezone.utc).isoformat(),
sha256=hashlib.sha256(coast.read_bytes()).hexdigest())))
coast_info = json.loads(coast_record.read_text())
if hashlib.sha256(coast.read_bytes()).hexdigest() != coast_info['sha256']:
raise RuntimeError('Cached coastline checksum mismatch')
records.append(coast_info)
metadata_dir = ROOT / 'inst/extdata/metadata'
metadata_dir.mkdir(exist_ok=True)
for name in SOURCES:
metadata = CACHE / (name + '.metadata.json')
(metadata_dir / metadata.name).write_bytes(metadata.read_bytes())
(ROOT / 'inst/extdata/source-manifest.json').write_text(json.dumps(records, indent=2) + '\n')data-raw/make-maps.R
Show/hide R code
# Run after installing the package. Simplification here is display-only.
library(AKsf)
library(ggplot2)
library(sf)
dir.create("docs", showWarnings = FALSE)
dir.create("man/figures", recursive = TRUE, showWarnings = FALSE)
land <- st_simplify(get_coast(), dTolerance = 300)
fmp <- st_simplify(get_fmp_areas(), dTolerance = 300)
labels <- c(BSAI_GF = "BSAI groundfish", GOA_GF = "Gulf of Alaska groundfish",
BSAI_CRAB = "BSAI king and Tanner crab", SCALLOP = "Scallop",
SALMON = "Salmon: East, West and Cook Inlet", ARCTIC = "Arctic")
fmp$plan <- factor(labels[fmp$fmp_id], levels = unname(labels))
colours <- c(BSAI_GF = "#237f97", GOA_GF = "#56a6ae", BSAI_CRAB = "#bb713e",
SCALLOP = "#796eb0", SALMON_EAST = "#44a191", SALMON_WEST = "#e2b558",
SALMON_COOK_INLET = "#c94855", ARCTIC = "#6d91ba")
p <- ggplot() +
geom_sf(data = fmp, aes(fill = area_code), colour = "#456373", linewidth = 0.15) +
geom_sf(data = land, fill = "#e8e9e3", colour = "#9babae", linewidth = 0.12) +
facet_wrap(~plan, ncol = 2) + coord_aksf() +
scale_fill_manual(values = colours, guide = "none") +
theme_aksf(base_size = 11) +
theme(strip.text = element_text(face = "bold", hjust = 0, size = 12),
panel.background = element_rect(fill = "#f6fafb", colour = NA),
panel.grid.major = element_line(colour = "#dee7eb", linewidth = 0.15),
plot.title = element_text(face = "bold", size = 23),
plot.subtitle = element_text(colour = "#49616a", size = 12),
plot.caption = element_text(hjust = 0, colour = "#49616a", size = 9),
plot.margin = margin(18, 20, 18, 20)) +
labs(title = "AKsf | Alaska fisheries spatial features",
subtitle = "Six NPFMC fishery management plans, with fishery-specific reference coverage",
caption = "Sources: NOAA Fisheries, ADF&G, NPFMC definitions; Natural Earth land.\nDerived cartographic reference areas; not regulatory boundaries. Source vintages and methods: DATA_SOURCES.md.")
ggsave("man/figures/fmp-overview.png", p, width = 12, height = 11, dpi = 160, bg = "white")
salmon <- get_fmp_areas("SALMON")
cook <- salmon[salmon$area_code == "SALMON_COOK_INLET", ]
bb <- st_bbox(cook)
p2 <- ggplot() +
geom_sf(data = salmon, aes(fill = area_code), colour = "#456373", linewidth = 0.2) +
geom_sf(data = get_coast(), fill = "#e8e9e3", colour = "#9babae", linewidth = 0.2) +
coord_sf(crs = proj_aksf(), xlim = c(bb['xmin']-40000, bb['xmax']+40000),
ylim = c(bb['ymin']-50000, bb['ymax']+40000), expand = FALSE) +
scale_fill_manual(values = colours, breaks = c("SALMON_COOK_INLET", "SALMON_WEST"),
labels = c("Cook Inlet EEZ Area", "West Area"), name = NULL) +
theme_aksf() + labs(title = "Cook Inlet salmon management",
subtitle = "Separate EEZ area north of 59 degrees 46.15 minutes N",
caption = "AKsf reference geometry. Generalized Natural Earth land; use agency baselines for detailed coastal work.")
ggsave("docs/salmon-cook-inlet.png", p2, width = 8, height = 8, dpi = 160, bg = "white")docs/examples/navmaps-outline.R
Show/hide R code
# Reference outlines for GIS inspection, not navigational or regulatory guidance.
# Run after installing navmaps; choose a new output filename.
library(AKsf)
library(sf)
# One-metre display simplification removes near-duplicate vertices that can
# collapse when the exporter serializes coordinates. Keep original polygons for analysis.
x <- st_transform(st_simplify(get_fmp_areas("GOA_GF"),
dTolerance = 1, preserveTopology = TRUE), 4326)
x <- st_wrap_dateline(x, options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180"))
# Export rings explicitly as separate lines: do not turn holes into filled areas.
x <- st_cast(st_boundary(x), "LINESTRING")
x$name <- paste0("AKsf reference: ", x$area_code)
x$description <- "Cartographic reference only; not for navigation or legal boundary decisions."
x$color <- "ff0000ff" # KML uses alpha-blue-green-red.
navmaps::sf_to_kml_linestring(x, file = "aksf-goa-reference.kml",
name_col = "name", description_col = "description",
color_col = "color")
# Verify the file actually preserves every ring as a valid geographic line.
y <- st_read("aksf-goa-reference.kml", quiet = TRUE)
stopifnot(nrow(y) == nrow(x), all(st_is_valid(y)),
all(st_geometry_type(y) == "LINESTRING"), st_crs(y)$epsg == 4326)docs/examples/survey-temperature.R
Show/hide R code
# Run from the AKsf repository root. Use local upstream checkouts; no downloads.
# Rscript docs/examples/survey-temperature.R /path/to/coldpool /path/to/akgfmaps [output.png]
args <- commandArgs(trailingOnly = TRUE)
if (length(args) < 2L) stop("Supply coldpool and akgfmaps checkout directories.")
stopifnot(requireNamespace("terra", quietly = TRUE),
requireNamespace("AKsf", quietly = TRUE))
library(ggplot2)
env <- new.env()
load(file.path(args[1], "data", "ebs_bottom_temperature.rda"), envir = env)
bt <- terra::unwrap(env$ebs_bottom_temperature)
# Use a fixed year, not the latest layer, so updates cannot silently change it.
year <- 2025L
layer <- grep(paste0("(^|[^0-9])", year, "([^0-9]|$)"), names(bt))
if (length(layer) != 1L) stop("Expected one 2025 bottom-temperature layer.")
bt <- bt[[layer]]
# Read upstream survey geometry, retaining design-year metadata.
survey <- sf::st_read(file.path(args[2], "inst/extdata/afsc_bts_strata.gpkg"),
layer = "survey_area", quiet = TRUE)
survey <- survey[survey$SURVEY_DEFINITION_ID == 98 &
survey$DESIGN_YEAR <= year, ]
survey <- survey[survey$DESIGN_YEAR == max(survey$DESIGN_YEAR), ]
stopifnot(nrow(survey) > 0L)
# Preserve the native temperature grid. Transform vector overlays to its CRS.
crs <- terra::crs(bt)
survey <- sf::st_transform(survey, crs)
fmp <- AKsf::get_fmp_areas("BSAI_GF", proj = crs)
reporting <- AKsf::get_reporting_areas(proj = crs)
reporting <- reporting[reporting$SubArea == "BS", ]
pts <- as.data.frame(bt, xy = TRUE, na.rm = TRUE)
names(pts)[3] <- "temperature"
p <- ggplot() +
geom_tile(data = pts, aes(x, y, fill = temperature),
width = terra::res(bt)[1], height = terra::res(bt)[2]) +
geom_sf(data = reporting, fill = NA, colour = "grey50", linewidth = 0.2) +
geom_sf(data = fmp, aes(colour = "BSAI groundfish FMP reference"),
fill = NA, linewidth = 0.55) +
geom_sf(data = survey, aes(colour = "EBS survey design"),
fill = NA, linewidth = 0.6, linetype = 2) +
scale_fill_viridis_c(name = "Bottom temperature (°C)") +
scale_colour_manual(NULL, values = c("BSAI groundfish FMP reference" = "#a63603",
"EBS survey design" = "#111111")) +
coord_sf(crs = crs, default_crs = crs,
xlim = c(terra::xmin(bt), terra::xmax(bt)),
ylim = c(terra::ymin(bt), terra::ymax(bt)), expand = FALSE) +
AKsf::theme_aksf() +
theme(legend.position = "bottom", legend.box = "vertical") +
labs(title = "Eastern Bering Sea: temperature, survey, and management",
subtitle = paste("Temperature year", year, "• Survey design", unique(survey$DESIGN_YEAR)),
caption = "Temperature: AFSC coldpool • Survey: akgfmaps • Boundaries: AKsf reference geometry\nSurvey coverage is not FMP coverage; unsampled water is not zero temperature.")
out <- if (length(args) >= 3L) args[3] else "survey-temperature.png"
ggsave(out, p, width = 10, height = 8, dpi = 160)
writeLines(c(paste("Raster layer:", names(bt)),
paste("Survey design:", unique(survey$DESIGN_YEAR)),
capture.output(sessionInfo())), paste0(out, ".session.txt"))pkgdown/build.R
Show/hide R code
# Run from a Git checkout after installing the package and website dependencies.
build_aksf_site <- function() {
image_path <- "man/figures/afsc-survey-temperature.png"
staged <- c(
"AFSC-INTEGRATION.md",
"GITHUB-PAGES.md",
"SOURCE-CODE.md",
image_path
)
existing <- staged[file.exists(staged)]
if (length(existing)) {
stop(
"Refusing to replace existing website staging files: ",
paste(existing, collapse = ", ")
)
}
created <- character()
on.exit(unlink(created), add = TRUE)
stage <- function(path, lines) {
created <<- c(created, path)
writeLines(lines, path, useBytes = TRUE)
}
created <- c(created, image_path)
if (!file.copy("docs/survey-temperature.png", image_path)) {
stop("Could not stage the AFSC guide image.")
}
integration <- readLines("docs/AFSC-INTEGRATION.md", warn = FALSE)
integration <- gsub(
"(examples/",
"(docs/examples/",
integration,
fixed = TRUE
)
integration <- gsub(
"](survey-temperature.png)",
"](man/figures/afsc-survey-temperature.png)",
integration,
fixed = TRUE
)
stage("AFSC-INTEGRATION.md", integration)
stage("GITHUB-PAGES.md", readLines("docs/GITHUB-PAGES.md", warn = FALSE))
source_files <- system2(
"git",
c(
"ls-files",
"--",
"R",
"data-raw",
"docs/examples",
"pkgdown",
"tests",
".github/workflows",
"_pkgdown.yml",
"vignettes/code-folding.html"
),
stdout = TRUE,
stderr = TRUE
)
status <- attr(source_files, "status")
if (!is.null(status) && status != 0L) {
stop(
"Could not list tracked website source files: ",
paste(source_files, collapse = "\n")
)
}
source_files <- source_files[
(grepl("\\.(r|py|yaml|yml|css|js)$", source_files, ignore.case = TRUE) |
source_files == "vignettes/code-folding.html") &
!grepl("^data-raw/cache(/|$)", source_files)
]
source_files <- sort(unique(source_files))
if (!length(source_files) || !all(file.exists(source_files))) {
stop(
"Tracked source files are missing; build the website from a complete Git checkout."
)
}
languages <- c(
r = "r",
py = "python",
yaml = "yaml",
yml = "yaml",
css = "css",
js = "javascript",
html = "html"
)
source_blocks <- lapply(source_files, function(path) {
lines <- readLines(path, warn = FALSE)
ticks <- regmatches(
paste(lines, collapse = "\n"),
gregexpr("`+", paste(lines, collapse = "\n"))
)[[1]]
fence <- strrep("`", max(c(3L, nchar(ticks) + 1L)))
language <- languages[[tolower(tools::file_ext(path))]]
c(paste0("## ", path), "", paste0(fence, language), lines, fence, "")
})
stage(
"SOURCE-CODE.md",
c(
"# AKsf source code",
"",
"Read the package functions, data preparation, examples, tests, website build,",
"and workflow code used by this checkout. Open a code panel to read or copy it.",
"The listings are displayed without running them. See the guides for optional",
"dependencies and instructions for running the examples.",
"",
unlist(source_blocks, use.names = FALSE)
)
)
# Validate and initialise the destination before staging any site assets.
pkgdown::init_site()
# Home-page image checks run before reference assets are copied by pkgdown.
dir.create("_site/reference/figures", recursive = TRUE, showWarnings = FALSE)
if (!file.copy(image_path, "_site/reference/figures", overwrite = TRUE)) {
stop("Could not copy the AFSC guide image into the site.")
}
source("pkgdown/code-disclosures.R", local = TRUE)
pkgdown::build_site(new_process = FALSE)
# Keep maintained source guides, downloadable examples, and existing map assets.
file.copy("docs", "_site", recursive = TRUE, overwrite = TRUE)
file.copy(c("DATA_SOURCES.md", "LICENSE-DATA.md"), "_site", overwrite = TRUE)
# Retain the linked figure provenance record alongside the article images.
file.copy(
"vignettes/pollock-maps/figure-manifest.csv",
"_site/articles/pollock-maps/figure-manifest.csv",
overwrite = TRUE
)
add_code_disclosures("_site")
}
build_aksf_site()pkgdown/code-disclosures.R
Show/hide R code
# Build-time disclosures cover pkgdown articles, home pages, and reference pages.
# Native details/summary keeps the controls usable without JavaScript.
code_node_classes <- function(node) {
value <- xml2::xml_attr(node, "class")
if (is.na(value) || !nzchar(value)) {
return(character())
}
strsplit(tolower(value), "[[:space:]]+")[[1]]
}
code_node_is_output <- function(node) {
if (xml2::xml_type(node) != "element") {
return(FALSE)
}
# pkgdown can embed figures directly inside reference example pre/code.
# Rendered output elements must remain visible when their input is closed.
if (
xml2::xml_name(node) %in%
c(
"img",
"figure",
"svg",
"table",
"iframe",
"canvas",
"video",
"audio",
"object",
"embed",
"script"
)
) {
return(TRUE)
}
any(
code_node_classes(node) %in%
c(
"r-output",
"r-plt",
"img",
"r-msg",
"r-warning",
"r-error",
"code-output",
"cell-output",
"cell-output-stdout",
"html-widget",
"html-widget-output",
"knitr-figure",
"output",
"stdout"
)
)
}
code_has_output <- function(node) {
nodes <- c(list(node), as.list(xml2::xml_find_all(node, ".//*")))
any(vapply(nodes, code_node_is_output, logical(1)))
}
code_language <- function(pre) {
nodes <- c(list(pre), as.list(xml2::xml_find_all(pre, "./code")))
classes <- unique(unlist(lapply(nodes, code_node_classes)))
classes <- sub("^language-", "", classes)
languages <- c(
r = "R",
bash = "shell",
sh = "shell",
shell = "shell",
python = "Python",
py = "Python",
javascript = "JavaScript",
js = "JavaScript",
typescript = "TypeScript",
ts = "TypeScript",
yaml = "YAML",
yml = "YAML",
json = "JSON",
sql = "SQL",
html = "HTML",
css = "CSS",
xml = "XML",
tex = "LaTeX",
latex = "LaTeX",
c = "C",
cpp = "C++",
usage = "R"
)
found <- classes[classes %in% names(languages)]
if (length(found)) {
return(unname(languages[[found[[1]]]]))
}
""
}
code_pre_is_source <- function(pre) {
classes <- code_node_classes(pre)
parents <- xml2::xml_find_all(pre, "ancestor::*")
if (any(vapply(as.list(parents), code_node_is_output, logical(1)))) {
return(FALSE)
}
if (code_node_is_output(pre)) {
return(FALSE)
}
explicit <- "sourcecode" %in% classes || nzchar(code_language(pre))
code <- xml2::xml_find_all(pre, "./code")
if (!explicit && !length(code)) {
return(FALSE)
}
if (!explicit) {
lines <- trimws(strsplit(xml2::xml_text(pre), "\n", fixed = TRUE)[[1]])
lines <- lines[nzchar(lines)]
if (
length(lines) &&
all(grepl(
"^(##([[:space:]]|$)|#>|\\[[[:digit:]]+\\]|Warning:|Error:)",
lines
))
) {
return(FALSE)
}
}
nzchar(trimws(xml2::xml_text(pre)))
}
# Partition mixed reference examples while retaining their inline markup. Each
# original ID is kept on its first fragment, so links remain unique and valid.
split_code_output <- function(node) {
if (code_node_is_output(node)) {
return(list(list(output = TRUE, node = node)))
}
if (!code_has_output(node)) {
return(list(list(output = FALSE, node = node)))
}
contents <- xml2::xml_contents(node)
parts <- list()
for (i in seq_along(contents)) {
parts <- c(parts, split_code_output(contents[[i]]))
}
groups <- list()
for (part in parts) {
last <- length(groups)
if (last && identical(groups[[last]]$output, part$output)) {
groups[[last]]$nodes <- c(groups[[last]]$nodes, list(part$node))
} else {
groups[[last + 1L]] <- list(
output = part$output,
nodes = list(part$node)
)
}
}
result <- vector("list", length(groups))
for (i in seq_along(groups)) {
shell <- xml2::xml_root(xml2::xml_new_root(xml2::xml_name(node)))
attrs <- xml2::xml_attrs(node)
if (i > 1L) {
attrs <- attrs[names(attrs) != "id"]
}
xml2::xml_set_attrs(shell, attrs)
for (child in groups[[i]]$nodes) {
xml2::xml_add_child(shell, child, .copy = TRUE)
}
result[[i]] <- list(output = groups[[i]]$output, node = shell)
}
result
}
wrap_code_pre <- function(pre, wrap_container = TRUE) {
target <- pre
parent <- xml2::xml_parent(pre)
if (
wrap_container &&
xml2::xml_name(parent) == "div" &&
"sourcecode" %in% code_node_classes(parent) &&
length(xml2::xml_find_all(parent, ".//pre")) == 1L &&
!code_has_output(parent)
) {
# Keep a source block's anchor and existing copy control together, without
# pulling plots, widgets, prose, or separate output into the disclosure.
children <- xml2::xml_children(parent)
safe <- vapply(
as.list(children),
function(child) {
xml2::xml_name(child) %in%
c("pre", "button") ||
any(code_node_classes(child) %in% c("copy-button", "btn-copy"))
},
logical(1)
)
if (all(safe)) {
target <- parent
}
}
language <- code_language(pre)
label <- paste("Show/hide", language, "code")
label <- gsub(" ", " ", label, fixed = TRUE)
xml2::xml_add_parent(
target,
"details",
class = "code-disclosure"
)
details <- xml2::xml_parent(target)
xml2::xml_add_child(details, "summary", label, .where = 0L)
invisible(details)
}
fold_code_html <- function(doc) {
pres <- xml2::xml_find_all(doc, "//pre")
for (i in seq_along(pres)) {
pre <- pres[[i]]
if (
length(xml2::xml_find_all(pre, "ancestor::details")) ||
!code_pre_is_source(pre)
) {
next
}
if (!code_has_output(pre)) {
wrap_code_pre(pre)
next
}
# Output can share a code element with input. Split runs rather than hiding
# the whole sourceCode container, leaving every output span visible.
parts <- split_code_output(pre)
for (part in parts) {
inserted <- xml2::xml_add_sibling(
pre,
part$node,
.where = "before",
.copy = TRUE
)
if (part$output) {
classes <- xml2::xml_attr(inserted, "class")
if (is.na(classes)) {
classes <- ""
}
xml2::xml_set_attr(
inserted,
"class",
trimws(paste(classes, "code-output"))
)
} else if (nzchar(trimws(xml2::xml_text(inserted)))) {
wrap_code_pre(inserted, wrap_container = FALSE)
}
}
xml2::xml_remove(pre)
}
doc
}
add_code_disclosures <- function(site_dir) {
if (!dir.exists(site_dir)) {
stop("Site directory does not exist: ", site_dir, call. = FALSE)
}
files <- list.files(
site_dir,
pattern = "\\.html$",
recursive = TRUE,
full.names = TRUE,
ignore.case = TRUE
)
changed <- character()
for (path in files) {
doc <- xml2::read_html(
path,
options = c("RECOVER", "NOERROR", "NOWARNING", "NONET")
)
before <- as.character(doc)
doc <- fold_code_html(doc)
if (!identical(before, as.character(doc))) {
xml2::write_html(doc, path)
changed <- c(changed, path)
}
}
invisible(changed)
}pkgdown/extra.css
Show/hide CSS code
/* Native disclosures work with JavaScript disabled. Keep the browser marker and
expose a strong focus indicator, including in forced-colour modes. */
.code-disclosure {
margin-block: 1rem;
border: 1px solid GrayText;
border-radius: 0.35rem;
background: Canvas;
color: CanvasText;
}
.code-disclosure > summary {
padding: 0.6rem 0.8rem;
cursor: pointer;
font-weight: 600;
}
.code-disclosure > summary:focus {
outline: 3px solid Highlight;
outline-offset: 3px;
}
.code-disclosure > .sourceCode,
.code-disclosure > pre {
margin-block: 0;
}pkgdown/test-code-disclosures.R
Show/hide R code
disclosure_functions <- function() {
env <- new.env(parent = baseenv())
sys.source(testthat::test_path("code-disclosures.R"), envir = env)
env
}
testthat::test_that("mixed source and output retain visible output and anchors", {
f <- disclosure_functions()
doc <- xml2::read_html(paste0(
'<main><div class="sourceCode" id="chunk">',
'<button class="copy-button" aria-label="Copy code">Copy</button>',
'<pre class="sourceCode r" id="pre"><code id="code">',
'<span id="line-1">x <- 1</span>',
'<span class="r-output co" data-value="literal">#> <a> & 1</span>',
'<span id="line-2">x + 1</span>',
'</code></pre></div></main>'
))
output <- as.character(xml2::xml_find_first(
doc,
"//span[contains(@class, 'r-output')]"
))
text <- xml2::xml_text(xml2::xml_find_first(doc, "//main"))
doc <- f$fold_code_html(doc)
testthat::expect_length(xml2::xml_find_all(doc, "//details"), 2L)
testthat::expect_length(xml2::xml_find_all(doc, "//details/summary"), 2L)
testthat::expect_equal(
xml2::xml_name(xml2::xml_find_all(doc, "//details/*[1]")),
rep("summary", 2)
)
testthat::expect_equal(
xml2::xml_text(xml2::xml_find_all(doc, "//summary")),
rep("Show/hide R code", 2)
)
testthat::expect_length(xml2::xml_find_all(doc, "//details[@open]"), 0L)
testthat::expect_identical(
as.character(xml2::xml_find_first(
doc,
"//span[contains(@class, 'r-output')]"
)),
output
)
testthat::expect_length(
xml2::xml_find_all(
doc,
"//span[contains(@class, 'r-output')]/ancestor::details"
),
0L
)
testthat::expect_identical(
gsub(
"Show/hide R code",
"",
xml2::xml_text(
xml2::xml_find_first(doc, "//main")
),
fixed = TRUE
),
text
)
ids <- xml2::xml_attr(xml2::xml_find_all(doc, "//*[@id]"), "id")
testthat::expect_setequal(ids, c("chunk", "pre", "code", "line-1", "line-2"))
testthat::expect_equal(anyDuplicated(ids), 0L)
testthat::expect_length(xml2::xml_find_all(doc, "//summary//button"), 0L)
testthat::expect_length(xml2::xml_find_all(doc, "//button"), 1L)
})
testthat::test_that("separate printed output and plots remain outside code", {
f <- disclosure_functions()
doc <- xml2::read_html(paste0(
'<div class="sourceCode"><pre class="r"><code>plot(1)</code></pre>',
'<pre class="r-output">[1] 1</pre><img src="plot.png" alt="Plot"></div>',
'<pre><code>## [1] 2\n## printed output</code></pre>',
'<div class="cell-output"><pre class="r"><code>printed</code></pre></div>'
))
before <- as.character(xml2::xml_find_all(
doc,
"//pre[contains(@class, 'r-output')] | //img"
))
doc <- f$fold_code_html(doc)
testthat::expect_length(xml2::xml_find_all(doc, "//details"), 1L)
testthat::expect_length(
xml2::xml_find_all(
doc,
"//details//img | //details//pre[contains(@class, 'r-output')]"
),
0L
)
testthat::expect_length(
xml2::xml_find_all(
doc,
"//div[@class='cell-output']//details"
),
0L
)
testthat::expect_identical(
as.character(xml2::xml_find_all(
doc,
"//pre[contains(@class, 'r-output')] | //img"
)),
before
)
})
testthat::test_that("pkgdown reference plots remain visible in source order", {
f <- disclosure_functions()
doc <- xml2::read_html(paste0(
'<main><div class="sourceCode">',
'<pre class="sourceCode r"><code>',
'<span id="source-before">plot_coast()</span>',
'<span class="r-plt img"><img id="plot" src="plot_coast-1.png" ',
'alt="Alaska coastline" width="700" height="400"></span>',
'<span class="r-output co" id="printed">#> printed output</span>',
'<span id="source-after">next_plot()</span>',
'</code></pre></div></main>'
))
ordered_nodes <- "//*[@id='source-before' or @id='plot' or
@id='printed' or @id='source-after']"
before <- as.character(xml2::xml_find_all(doc, ordered_nodes))
image <- as.character(xml2::xml_find_first(doc, "//span[@class='r-plt img']"))
doc <- f$fold_code_html(doc)
testthat::expect_identical(
as.character(xml2::xml_find_all(doc, ordered_nodes)),
before
)
testthat::expect_identical(
as.character(xml2::xml_find_first(doc, "//span[@class='r-plt img']")),
image
)
testthat::expect_length(xml2::xml_find_all(doc, "//details//img"), 0L)
testthat::expect_length(
xml2::xml_find_all(
doc,
"//*[@id='printed']/ancestor::details"
),
0L
)
testthat::expect_length(
xml2::xml_find_all(
doc,
"//details//*[@id='source-before' or @id='source-after']"
),
2L
)
once <- as.character(doc)
testthat::expect_identical(as.character(f$fold_code_html(doc)), once)
})
testthat::test_that("embedded figures, tables, and widgets stay outside code", {
f <- disclosure_functions()
doc <- xml2::read_xml(paste0(
'<html><body><pre class="sourceCode r"><code>',
'<span id="before">make_outputs()</span>',
'<figure id="figure"><img src="figure.png" alt="Figure"/></figure>',
'<svg id="svg"><path d="M 0 0 L 1 1"/></svg>',
'<table id="table"><tbody><tr><td>result</td></tr></tbody></table>',
'<div id="widget" class="html-widget"><canvas id="canvas"/></div>',
'<script id="widget-data" type="application/json" data-for="widget">',
'{"value":1}</script>',
'<span id="after">next_step()</span>',
'</code></pre></body></html>'
))
ordered_nodes <- "//*[@id='before' or @id='figure' or @id='svg' or
@id='table' or @id='widget' or @id='widget-data' or @id='after']"
before <- as.character(xml2::xml_find_all(doc, ordered_nodes))
doc <- f$fold_code_html(doc)
testthat::expect_identical(
as.character(xml2::xml_find_all(doc, ordered_nodes)),
before
)
testthat::expect_length(
xml2::xml_find_all(
doc,
"//details//img | //details//svg | //details//table |
//details//canvas | //details//script"
),
0L
)
testthat::expect_length(xml2::xml_find_all(doc, "//details"), 2L)
ids <- xml2::xml_attr(xml2::xml_find_all(doc, "//*[@id]"), "id")
testthat::expect_equal(anyDuplicated(ids), 0L)
})
testthat::test_that("nested output markup and existing disclosures are safe", {
f <- disclosure_functions()
doc <- xml2::read_html(paste0(
'<details open id="existing"><summary>Existing</summary>',
'<pre class="r"><code>kept()</code></pre></details>',
'<pre class="r" id="mixed"><code><span id="outer">source()',
'<span class="r-output">#> output</span>next()</span></code></pre>'
))
original <- as.character(xml2::xml_find_first(doc, "//details"))
output <- as.character(xml2::xml_find_first(
doc,
"//span[@class='r-output']"
))
doc <- f$fold_code_html(doc)
testthat::expect_identical(
as.character(xml2::xml_find_first(doc, "//details[@id='existing']")),
original
)
testthat::expect_length(xml2::xml_find_all(doc, "//details//details"), 0L)
testthat::expect_identical(
as.character(xml2::xml_find_first(doc, "//span[@class='r-output']")),
output
)
testthat::expect_length(
xml2::xml_find_all(
doc,
"//span[@class='r-output']/ancestor::details"
),
0L
)
ids <- xml2::xml_attr(xml2::xml_find_all(doc, "//*[@id]"), "id")
testthat::expect_equal(anyDuplicated(ids), 0L)
once <- as.character(doc)
testthat::expect_identical(as.character(f$fold_code_html(doc)), once)
})
testthat::test_that("languages, escaped text, usage, and copy controls survive", {
f <- disclosure_functions()
doc <- xml2::read_html(paste0(
'<main><div class="sourceCode" id="shell">',
'<button class="btn-copy">Copy</button>',
'<pre class="sourceCode bash"><code>echo "<x> & y"</code></pre>',
'</div><pre><code class="language-python">x = "<value>"</code></pre>',
'<pre class="usage"><code>function_name(x = NULL)</code></pre>',
'<pre><code>plain <value> & text</code></pre></main>'
))
code <- xml2::xml_text(xml2::xml_find_all(doc, "//pre"))
doc <- f$fold_code_html(doc)
testthat::expect_length(xml2::xml_find_all(doc, "//details/summary"), 4L)
testthat::expect_equal(
xml2::xml_name(xml2::xml_find_all(doc, "//details/*[1]")),
rep("summary", 4)
)
testthat::expect_equal(
xml2::xml_text(xml2::xml_find_all(doc, "//summary")),
c(
"Show/hide shell code",
"Show/hide Python code",
"Show/hide R code",
"Show/hide code"
)
)
testthat::expect_identical(
xml2::xml_text(xml2::xml_find_all(doc, "//pre")),
code
)
testthat::expect_length(
xml2::xml_find_all(
doc,
"//details/div[@id='shell']/button"
),
1L
)
testthat::expect_length(xml2::xml_find_all(doc, "//summary//button"), 0L)
})
testthat::test_that("recursive site processing is idempotent and HTML only", {
f <- disclosure_functions()
site <- withr::local_tempdir()
dir.create(file.path(site, "articles"))
html <- '<!doctype html><html><body><pre class="r">x <- 1</pre></body></html>'
paths <- c(
file.path(site, "index.html"),
file.path(site, "articles", "a.HTML")
)
for (path in paths) {
writeLines(html, path, useBytes = TRUE)
}
raw <- file.path(site, "source.txt")
writeLines(html, raw, useBytes = TRUE)
testthat::expect_setequal(f$add_code_disclosures(site), paths)
once <- lapply(c(paths, raw), readBin, what = "raw", n = 100000L)
testthat::expect_identical(f$add_code_disclosures(site), character())
testthat::expect_identical(
lapply(c(paths, raw), readBin, what = "raw", n = 100000L),
once
)
testthat::expect_length(
xml2::xml_find_all(
xml2::read_html(paths[[1]]),
"//details[@class='code-disclosure']"
),
1L
)
testthat::expect_identical(readLines(raw), html)
})R/AKsf-package.R
Show/hide R code
#' AKsf: Alaska fisheries spatial features
#'
#' Bundled agency snapshots and documented NPFMC reference areas for scientific
#' maps. Start with [get_reporting_areas()], [get_fmp_areas()], and [coord_aksf()].
#' @importFrom sf st_geometry
#' @keywords internal
"_PACKAGE"R/data.R
Show/hide R code
#' NOAA Alaska reporting areas
#' @format An sf object in EPSG:4326. Native fields include REP_AREA (reporting
#' code), SubArea (BS, AI, GOA, Arctic, or Donut), and OBJECTID. Added fields:
#' area_code, area_name, authority, area_type, source_url, retrieved_utc.
#' Code 550 is international water. Some reporting areas include state waters.
#' @source NOAA Alaska Regional Office Base_Map service; see [get_sources()].
"nmfs_reporting_areas"
#' ADF&G groundfish statistical areas
#' @format An sf object in EPSG:4326 with the complete published agency schema.
#' STAT_AREA is the native numeric code; area_code is its six-character form.
#' Registration, district, subdistrict, section, and sector fields retain the
#' agency hierarchy. WATERS_CODE distinguishes FED, STATE, and INTL. Agency
#' date fields are Unix milliseconds; missing end dates denote no stated end.
#' Source Shape fields are retained metadata, not recomputed measurements.
#' @source ADF&G Groundfish_Statistical_Areas_2001 service; see [get_sources()].
"adfg_groundfish_statistical_areas"
#' ADF&G groundfish registration areas
#' @format An sf object in EPSG:4326. REGISTRATION_AREA_CODE and
#' REGISTRATION_AREA_NAME are the native identifiers. Standardized area_code
#' and area_name fields duplicate those values. Source geometry dates,
#' fishery/region codes, attribution, and provenance are retained.
#' @source ADF&G Commercial Fisheries Groundfish Registration Areas service.
"adfg_groundfish_registration_areas"
#' NPFMC fishery management plan reference polygons
#' @format An sf object in EPSG:3338 with eight rows representing six FMPs.
#' Salmon has three rows. Fields: fmp_id, area_code, area_name, authority,
#' area_type, geometry_basis, source_url, plan_library_url, boundary_status,
#' area_km2 (computed in Alaska Albers), and geometry.
#' @details Derived reference geometry is not a regulatory boundary product.
#' Polygons overlap across fisheries. See [get_fmp_catalog()] for limitations.
#' @source NPFMC plan definitions, ADF&G federal statistical polygons, and NOAA
#' Management Areas ATB. Full methods are in data-raw/build-data.R.
"fmp_areas"
#' Alaska generalized land polygons
#' @format An sf object in EPSG:4326 with name, admin, source_url and geometry.
#' @source Natural Earth 1:10 million admin-1 states/provinces, public domain.
#' @details Cartographic land representation, not a regulatory shoreline.
"alaska_coast"R/gmt.R
Show/hide R code
#' Export spatial features for Generic Mapping Tools
#'
#' Write GDAL's GMT/OGR ASCII vector format, retaining polygon holes,
#' feature attributes, and CRS metadata. GMT itself is not needed to export.
#' @param x A non-empty sf object with a known CRS and polygon geometry.
#' @param file A local output filename ending in `.gmt`.
#' @param overwrite Replace an existing file? Defaults to FALSE.
#' @return The output path, invisibly.
#' @details Output coordinates are WGS84 longitude/latitude (EPSG:4326).
#' Multipart features are split into polygon records with repeated attributes;
#' interior rings remain holes. Dateline crossings are split before export.
#' Use GMT 6 `gmt plot file.gmt -R... -J...` to draw the result. This is a
#' vector exchange helper, not a wrapper for GMT's plotting or grid modules.
#' @export
#' @examples
#' path <- tempfile(fileext = ".gmt")
#' write_gmt(get_reporting_areas("541"), path)
#' unlink(path)
write_gmt <- function(x, file, overwrite = FALSE) {
if (!inherits(x, "sf") || !nrow(x) || is.na(sf::st_crs(x))) {
stop("x must be a non-empty sf object with a known CRS.", call. = FALSE)
}
if (any(sf::st_is_empty(x)) ||
!all(sf::st_geometry_type(x) %in% c("POLYGON", "MULTIPOLYGON"))) {
stop("x must contain non-empty POLYGON or MULTIPOLYGON features.", call. = FALSE)
}
if (!is.character(file) || length(file) != 1L || is.na(file) ||
!grepl("[.]gmt$", file, ignore.case = TRUE) || startsWith(file, "/vsi")) {
stop("file must be a local filename ending in .gmt.", call. = FALSE)
}
if (!is.logical(overwrite) || length(overwrite) != 1L || is.na(overwrite)) {
stop("overwrite must be TRUE or FALSE.", call. = FALSE)
}
if (file.exists(file) && !overwrite) stop("File exists; use overwrite = TRUE.", call. = FALSE)
drivers <- sf::st_drivers()
driver <- intersect(c("OGR_GMT", "GMT"), drivers$name[drivers$write])
if (!length(driver)) stop("Your GDAL installation lacks a writable GMT driver.", call. = FALSE)
x <- sf::st_transform(x, 4326)
x <- sf::st_wrap_dateline(x, options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180"))
x <- suppressWarnings(sf::st_cast(x, "POLYGON"))
sf::st_write(x, dsn = file, driver = driver[1], delete_dsn = overwrite,
quiet = TRUE)
invisible(file)
}R/layers.R
Show/hide R code
#' Add an Alaska coastline layer
#' @param proj Output CRS.
#' @param ... Arguments passed to [ggplot2::geom_sf()], including fill and colour.
#' @return A ggplot2 layer.
#' @export
#' @examples
#' ggplot2::ggplot() + plot_coast(fill = "grey90") + coord_aksf() + theme_aksf()
plot_coast <- function(proj = proj_aksf(), ...) ggplot2::geom_sf(data = get_coast(proj), ...)
#' Add a NOAA reporting-area layer
#' @inheritParams get_reporting_areas
#' @param ... Arguments passed to [ggplot2::geom_sf()].
#' @return A ggplot2 layer.
#' @export
plot_reporting_areas <- function(area = NULL, proj = proj_aksf(), include_international = FALSE, ...) {
ggplot2::geom_sf(data = get_reporting_areas(area, proj, include_international), ...)
}
#' Add an ADF&G statistical-area layer
#' @inheritParams get_statistical_areas
#' @param ... Arguments passed to [ggplot2::geom_sf()].
#' @return A ggplot2 layer.
#' @export
plot_statistical_areas <- function(area = NULL, proj = proj_aksf(), ...) {
ggplot2::geom_sf(data = get_statistical_areas(area, proj), ...)
}
#' Add an ADF&G registration-area layer
#' @inheritParams get_registration_areas
#' @param ... Arguments passed to [ggplot2::geom_sf()].
#' @return A ggplot2 layer.
#' @export
plot_registration_areas <- function(area = NULL, proj = proj_aksf(), ...) {
ggplot2::geom_sf(data = get_registration_areas(area, proj), ...)
}
#' Add an NPFMC FMP reference-area layer
#' @inheritParams get_fmp_areas
#' @param ... Arguments passed to [ggplot2::geom_sf()].
#' @return A ggplot2 layer.
#' @export
plot_fmp_areas <- function(fmp = NULL, proj = proj_aksf(), ...) {
ggplot2::geom_sf(data = get_fmp_areas(fmp, proj), ...)
}R/spatial.R
Show/hide R code
#' Alaska mapping projection
#'
#' NAD83 / Alaska Albers (EPSG:3338), with metre units. This package default
#' is a cartographic choice, not a claim that every agency source uses this CRS.
#' @return An EPSG integer.
#' @export
proj_aksf <- function() 3338L
#' Coordinate system for Alaska maps
#' @param ... Arguments passed to [ggplot2::coord_sf()].
#' @return A ggplot2 coordinate object.
#' @export
coord_aksf <- function(...) ggplot2::coord_sf(crs = proj_aksf(), ...)
#' A quiet theme for scientific maps
#' @param base_size Base font size in points.
#' @param ... Arguments passed to [ggplot2::theme_minimal()].
#' @return A ggplot2 theme.
#' @export
theme_aksf <- function(base_size = 11, ...) {
ggplot2::theme_minimal(base_size = base_size, ...) +
ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = "grey85", linewidth = 0.2),
axis.title = ggplot2::element_blank(),
legend.position = "bottom")
}
# Internal loading avoids depending on whether users have attached the package.
.ak_data <- function(name) {
env <- new.env(parent = emptyenv())
utils::data(list = name, package = "AKsf", envir = env)
env[[name]]
}
.ak_filter <- function(x, values, column, argument) {
if (is.null(values)) return(x)
if (!is.character(values) || !length(values) || anyNA(values)) {
stop(argument, " must be a non-empty character vector, or NULL.", call. = FALSE)
}
missing <- setdiff(values, x[[column]])
if (length(missing)) stop("Unknown ", argument, ": ", paste(missing, collapse = ", "), call. = FALSE)
x[x[[column]] %in% values, , drop = FALSE]
}
.ak_transform <- function(x, proj) {
if (is.null(proj)) return(x)
sf::st_transform(x, proj)
}
#' Get NOAA/NMFS reporting areas
#' @param area Character reporting codes, such as `c("541", "542", "543")`.
#' NULL returns all available codes (subject to `include_international`).
#' @param proj Output CRS; NULL retains the bundled EPSG:4326 geometry.
#' @param include_international Include the international Donut Hole (550).
#' It is not part of the U.S. EEZ or a U.S. FMP management area.
#' @return An sf object. Native agency fields are retained alongside `area_code`,
#' `area_name`, `authority`, and `area_type`.
#' @export
#' @examples
#' get_reporting_areas(c("541", "542", "543"))
get_reporting_areas <- function(area = NULL, proj = proj_aksf(), include_international = FALSE) {
if (!is.logical(include_international) || length(include_international) != 1L || is.na(include_international)) {
stop("include_international must be TRUE or FALSE.", call. = FALSE)
}
x <- .ak_data("nmfs_reporting_areas")
if (!include_international) x <- x[x$area_code != "550", ]
.ak_transform(.ak_filter(x, area, "area_code", "area"), proj)
}
#' Get ADF&G groundfish statistical areas
#' @param area Character six-digit statistical area codes; NULL returns all.
#' @param proj Output CRS; NULL retains EPSG:4326 geometry.
#' @return An sf object preserving the agency fields, including the statistical
#' code, management hierarchy, waters code, and source dates. Convenience
#' field `area_code` is always a six-character identifier.
#' @details This is the published 2001-present groundfish GIS series, not a
#' historical reconstruction or a universal grid for all fisheries.
#' @export
get_statistical_areas <- function(area = NULL, proj = proj_aksf()) {
.ak_transform(.ak_filter(.ak_data("adfg_groundfish_statistical_areas"), area, "area_code", "area"), proj)
}
#' Get ADF&G groundfish registration areas
#' @param area Character registration codes; NULL returns all.
#' @param proj Output CRS; NULL retains EPSG:4326 geometry.
#' @return An sf object with agency attributes and standardized identifiers.
#' @export
get_registration_areas <- function(area = NULL, proj = proj_aksf()) {
.ak_transform(.ak_filter(.ak_data("adfg_groundfish_registration_areas"), area, "area_code", "area"), proj)
}
#' Get NPFMC FMP reference areas
#' @param fmp Character plan IDs: BSAI_GF, GOA_GF, BSAI_CRAB, SCALLOP,
#' SALMON, or ARCTIC. NULL returns all six plans (eight features).
#' @param proj Output CRS; NULL retains the bundled EPSG:3338 geometry.
#' @return An sf object including `fmp_id`, `area_code`, `area_name`,
#' `geometry_basis`, and `source_url`.
#' @details Reference polygons are derived or republished for scientific maps;
#' they are not legal boundary determinations. Plans overlap. Salmon has
#' East, West, and Cook Inlet features. The crab boundary differs from the
#' groundfish boundary south of the Aleutians. Consult DATA_SOURCES.md in
#' the repository and [get_fmp_catalog()] before analysis.
#' @export
#' @examples
#' get_fmp_areas(c("BSAI_GF", "GOA_GF"))
get_fmp_areas <- function(fmp = NULL, proj = proj_aksf()) {
.ak_transform(.ak_filter(.ak_data("fmp_areas"), fmp, "fmp_id", "fmp"), proj)
}
#' Get Alaska land polygons for a basemap
#' @param proj Output CRS; NULL retains EPSG:4326 geometry.
#' @return An sf object from Natural Earth 1:10 million admin-1 land polygons.
#' @details A generalized cartographic basemap, not a NOAA shoreline or a
#' state/federal waters boundary. Includes the western Aleutians.
#' @export
get_coast <- function(proj = proj_aksf()) .ak_transform(.ak_data("alaska_coast"), proj)
#' NPFMC plan catalog
#' @return A data.frame with plan names, NPFMC URLs, spatial basis, and caveats.
#' @export
get_fmp_catalog <- function() {
utils::read.csv(system.file("extdata", "fmp-catalog.csv", package = "AKsf"),
stringsAsFactors = FALSE, na.strings = "")
}
#' Read the data provenance manifest
#' @return A character vector containing JSON with source URLs, retrieval
#' timestamps, feature counts, and SHA-256 hashes of the downloaded snapshots.
#' @export
get_sources <- function() {
readLines(system.file("extdata", "source-manifest.json", package = "AKsf"), warn = FALSE)
}tests/testthat.R
Show/hide R code
library(testthat)
library(AKsf)
test_check("AKsf")tests/testthat/test-gmt.R
Show/hide R code
test_that("GMT export preserves holes, identifiers, and geographic coordinates", {
outer <- matrix(c(0,0, 4,0, 4,4, 0,4, 0,0), ncol=2, byrow=TRUE)
hole <- matrix(c(1,1, 1,2, 2,2, 2,1, 1,1), ncol=2, byrow=TRUE)
x <- sf::st_sf(area_code="001234", geometry=sf::st_sfc(sf::st_polygon(list(outer,hole)),crs=4326))
path <- tempfile(fileext=".gmt")
on.exit(unlink(path))
write_gmt(sf::st_transform(x,3338),path)
y <- sf::st_read(path,quiet=TRUE)
expect_equal(y$area_code,"001234")
expect_equal(length(sf::st_geometry(y)[[1]]),2L)
expect_equal(sf::st_crs(y)$epsg,4326)
expect_equal(as.numeric(sf::st_area(y)),as.numeric(sf::st_area(x)),tolerance=1e-6)
expect_error(write_gmt(x,path),"File exists")
expect_silent(write_gmt(x,path,overwrite=TRUE))
expect_error(write_gmt(x,"test.txt"),"ending in .gmt")
expect_error(write_gmt(sf::st_set_crs(x,NA),path),"known CRS")
})
test_that("GMT export splits dateline-crossing polygons", {
ring <- matrix(c(179,50, -179,50, -179,52, 179,52, 179,50),ncol=2,byrow=TRUE)
x <- sf::st_sf(area_code="crossing",geometry=sf::st_sfc(sf::st_polygon(list(ring)),crs=4326))
path <- tempfile(fileext=".gmt")
on.exit(unlink(path))
write_gmt(x,path)
y <- sf::st_read(path,quiet=TRUE)
expect_equal(nrow(y),2L)
expect_true(all(y$area_code=="crossing"))
widths <- vapply(sf::st_geometry(y),function(g) diff(range(sf::st_coordinates(g)[,"X"])),numeric(1))
expect_true(all(widths <= 1.01))
})tests/testthat/test-spatial.R
Show/hide R code
test_that("agency codes and source schemas are preserved", {
x <- get_statistical_areas(proj = NULL)
expect_equal(nrow(x), 1735L)
expect_true(all(grepl("^[0-9]{6}$", x$area_code)))
expect_equal(anyDuplicated(x$area_code), 0L)
expect_true(all(c("REGISTRATION_AREA_CODE", "DISTRICT_CODE", "SECTION_CODE",
"WATERS_CODE", "FMP_AREA_CODE", "GEOMETRY_START_DATE") %in% names(x)))
expect_setequal(unique(x$WATERS_CODE), c("FED", "STATE", "INTL"))
expect_equal(nrow(get_statistical_areas(x$area_code[1:2])), 2L)
expect_equal(nrow(get_registration_areas()), 8L)
expect_equal(get_registration_areas("H")$area_name, "Cook Inlet Area")
})
test_that("international areas require explicit selection", {
x <- get_reporting_areas()
expect_false("550" %in% x$area_code)
expect_equal(nrow(get_reporting_areas(include_international = TRUE)), 25L)
expect_equal(get_reporting_areas("550", include_international = TRUE)$SubArea, "Donut")
# Reporting area 523 has two source features; neither is silently discarded.
expect_equal(nrow(get_reporting_areas("523")), 2L)
expect_error(get_reporting_areas("550"), "Unknown area")
})
test_that("input errors do not silently return an empty map", {
expect_error(get_reporting_areas(541), "character")
expect_error(get_reporting_areas(NA_character_), "character")
expect_error(get_reporting_areas(character()), "character")
expect_error(get_reporting_areas(include_international = NA), "TRUE or FALSE")
expect_error(get_fmp_areas("not_a_plan"), "Unknown fmp")
expect_error(get_registration_areas("999"), "Unknown area")
})
test_that("projection preserves western Aleutians without a world-spanning map", {
expect_equal(sf::st_crs(get_reporting_areas())$epsg, 3338L)
expect_equal(sf::st_crs(get_reporting_areas(proj = NULL))$epsg, 4326L)
bb <- sf::st_bbox(get_coast())
expect_lt(as.numeric(bb['xmax'] - bb['xmin']), 5e6)
coast_ll <- sf::st_coordinates(get_coast(proj = NULL))
expect_true(any(coast_ll[, 1] > 170))
expect_true(any(coast_ll[, 1] < -170))
pts <- sf::st_as_sf(data.frame(lon = c(179.9, -179.9), lat = c(52, 52)), coords = c("lon", "lat"), crs = 4326)
pts <- sf::st_transform(pts, proj_aksf())
expect_lt(as.numeric(sf::st_distance(pts)[1, 2]), 20000)
})
test_that("bundled geometries are valid and non-empty in Alaska Albers", {
for (getter in list(get_reporting_areas, get_statistical_areas, get_registration_areas, get_fmp_areas, get_coast)) {
x <- getter()
expect_true(all(sf::st_is_valid(x)))
expect_false(any(sf::st_is_empty(x)))
}
})
test_that("all six FMPs are covered with explicit derivation metadata", {
fmp <- get_fmp_areas()
expect_equal(nrow(fmp), 8L)
expect_setequal(fmp$fmp_id, get_fmp_catalog()$fmp_id)
expect_true(all(fmp$boundary_status == "cartographic_reference_not_regulatory"))
expect_true(all(nzchar(fmp$geometry_basis)))
expect_true(all(fmp$area_km2 > 0))
expect_setequal(get_fmp_areas("SALMON")$area_code,
c("SALMON_EAST", "SALMON_WEST", "SALMON_COOK_INLET"))
})
test_that("FMPs retain fishery-specific coverage", {
# A point south of Unalaska east of 170 W is GOA groundfish but BSAI crab.
p <- sf::st_transform(sf::st_sfc(sf::st_point(c(-166, 52)), crs = 4326), 3338)
inside <- function(plan) lengths(sf::st_intersects(p, get_fmp_areas(plan))) > 0
expect_true(inside("GOA_GF"))
expect_false(inside("BSAI_GF"))
expect_true(inside("BSAI_CRAB"))
expect_true(inside("SCALLOP"))
expect_false(inside("ARCTIC"))
# Donut Hole center is international and must not be a groundfish FMP polygon.
donut <- sf::st_transform(sf::st_sfc(sf::st_point(c(-178, 56)), crs = 4326), 3338)
expect_length(sf::st_intersects(donut, get_fmp_areas(c("BSAI_GF", "GOA_GF")))[[1]], 0L)
})
test_that("salmon separates Cook Inlet from the West Area", {
s <- get_fmp_areas("SALMON")
cook <- s[s$area_code == "SALMON_COOK_INLET", ]
west <- s[s$area_code == "SALMON_WEST", ]
overlap <- suppressWarnings(sf::st_intersection(sf::st_geometry(cook), sf::st_geometry(west)))
expect_lt(sum(as.numeric(sf::st_area(overlap))), 1)
coords <- sf::st_coordinates(sf::st_transform(cook, 4326))
expect_gte(min(coords[, 2]), 59 + 46.15/60 - 1e-5)
})
test_that("mapping helpers render composable layers without network access", {
image <- tempfile(fileext = ".pdf")
grDevices::pdf(image)
on.exit({ grDevices::dev.off(); unlink(image) }, add = TRUE)
p <- ggplot2::ggplot() + plot_reporting_areas("541", fill = NA) +
plot_coast(fill = "grey90") + coord_aksf() + theme_aksf()
expect_s3_class(ggplot2::ggplotGrob(p), "gtable")
p2 <- ggplot2::ggplot() + plot_fmp_areas("ARCTIC") + coord_aksf()
expect_s3_class(ggplot2::ggplotGrob(p2), "gtable")
})
test_that("groundfish reference coverage is clipped at NOAA's offshore envelope", {
fmp <- get_fmp_areas(c("BSAI_GF", "GOA_GF"))
reporting <- get_reporting_areas()
envelope <- sf::st_union(sf::st_geometry(reporting[reporting$SubArea %in% c("BS", "AI", "GOA"), ]))
outside <- sf::st_difference(sf::st_union(sf::st_geometry(fmp)), envelope)
expect_lt(sum(as.numeric(sf::st_area(outside))), 10)
})
test_that("Cook Inlet contains no detached Gulf of Alaska component", {
s <- get_fmp_areas("SALMON", proj = 4326)
cook <- s[s$area_code == "SALMON_COOK_INLET", ]
expect_lt(unname(sf::st_bbox(cook)['xmax']), -151)
anchor <- sf::st_sfc(sf::st_point(c(-152.4, 60)), crs = 4326)
expect_length(sf::st_intersects(sf::st_transform(anchor, 3338), sf::st_transform(cook, 3338))[[1]], 1L)
})vignettes/code-folding.html
Show/hide HTML code
<style>
details.code-disclosure { margin: 1em 0; border: 1px solid #767676; border-radius: .25em; }
details.code-disclosure > summary { padding: .5em .75em; cursor: pointer; font-weight: 600; }
details.code-disclosure > summary:focus-visible { outline: 3px solid currentColor; outline-offset: 3px; }
details.code-disclosure > pre { margin: 0; }
</style>
<script>
// Package vignettes use progressive enhancement: without JavaScript all source
// stays visible. The pkgdown build writes native disclosures into the HTML.
(function () {
if (!("open" in document.createElement("details"))) return;
document.querySelectorAll("pre").forEach(function (pre) {
if (pre.closest("details") || pre.closest(".r-output")) return;
var classes = pre.className + " " + (pre.querySelector("code") || {}).className;
var language = classes.match(/\b(r|bash|sh|python|yaml)\b/i);
if (!language && !/\bsourceCode\b/.test(classes)) return;
var name = language ? language[1] : "source";
name = name.toLowerCase() === "r" ? "R" : name;
var details = document.createElement("details");
details.className = "code-disclosure";
var summary = document.createElement("summary");
summary.textContent = "Show/hide " + name + " code";
pre.parentNode.insertBefore(details, pre);
details.appendChild(summary);
details.appendChild(pre);
});
})();
</script>