Hărți cool de la Polul Sud
6 min.
Crearea de hărți cu R este de obicei simplu, dar reprezentările care traversează linia internațională a datei sau care folosesc proiecții polare pot fi dificile.
Diferiți furnizori de date spațiale folosesc convenții diferite: unii rup geometriile la anumite longitudini (de exemplu, tăind Peninsula Chukchi), în timp ce alții omit porțiuni din date. Aceste inconsecvențe pot produce artefacte incomode în apropierea polilor.
În această postare repar fișierul de formă GISCO (Comisia Europeană) pentru Antarctica și produc hărți ortografice curate. Trec prin corecțiile manuale și apoi creez câteva exemple de hărți.
# Libraries library(tidyverse) library(sf) library(giscoR) library(ggrepel) library(rmapshaper)
Fixarea geometriei
În primul rând, obținem poligonul GISCO Antarctica și îl transformăm într-o proiecție ortografică centrată pe Polul Sud.
antarct <- gisco_get_countries(year = 2024, resolution = 1, country = "ATA") %>% select(NAME = NAME_ENGL) |> # Ortho proj centered in the South Pole st_transform(crs = "+proj=ortho +lat_0=-90 +lon_0=0") ggplot(antarct) + geom_sf(fill = "lightblue")
Fișierul de formă conține o tăietură vizibilă „acadea” care pare nenaturală într-o proiecție ortografică. O corectez manual prin:
- Identificați poligonul care reprezintă principala masă terestră a Antarcticii.
- Convertiți acel poligon într-o secvență de coordonate (puncte).
- Eliminați secvența mică de puncte care creează artefactul.
- Reconstruiți poligonul din coordonatele curățate și înlocuiți geometria ruptă cu cea corectată.
Convertim poligoane în coordonate punct și le inspectăm pentru a găsi secvența ofensătoare:
# Identify the max
ant_explode <- antarct |>
st_cast("POLYGON")
nrow(ant_explode)
#> (1) 778
# Max polygon
ant_max <- ant_explode(which.max(st_area(ant_explode)), )
coords <- st_coordinates(ant_max) |>
as_tibble() |>
# Add id for points
mutate(np = row_number())
ggplot(coords, aes(X, Y)) +
geom_point(size = 0.05, color = "darkblue") +
geom_text(aes(label = np), check_overlap = TRUE) +
coord_equal()
Din indicii reprezentați, putem vedea că punctele problematice se încadrează aproximativ în intervalul 8200–9200. Inspectăm acel interval în detaliu pentru a selecta indicii exacti care trebuie eliminați.
test <- coords |> filter(np %in% seq(8200, 9200)) test |> ggplot(aes(X, Y)) + geom_point(size = 0.05, color = "darkblue") + geom_text(aes(label = np), check_overlap = TRUE)
Notă: Această curățare este adaptată pentru acest fișier de formă specific și poate fi necesar să fie repetată pentru alte fișiere de formă. Abordarea este simplă, dar depinde de geometria și proiecția particulară.
# Final solution after some iterations... test |> filter(np %in% seq(8289, 9130)) |> ggplot(aes(X, Y)) + geom_point(color = "darkblue") + labs(title = "To remove") test |> filter(!np %in% seq(8289, 9130)) |> ggplot(aes(X, Y)) + geom_point(color = "darkblue") + labs(title = "To keep")
După înlăturarea punctelor ofensive, reconstruim poligonul și reconstituim întreaga formă a Antarcticii din piesa corectată plus poligoanele rămase.
# From coordinates to polygon newpol <- coords |> as.data.frame() |> filter(!np %in% seq(8289, 9130)) |> # Removing offending points select(X, Y) |> as.matrix() |> list() |> st_polygon() |> st_sfc() |> st_set_crs(st_crs(ant_max)) ant_max_fixed <- st_sf(st_drop_geometry(ant_max), geometry = newpol) # Regenerate initial shape antarctica_fixed <- bind_rows( ant_max_fixed, ant_explode(-which.max(st_area(ant_explode)), ) ) |> group_by(NAME) |> summarise(m = 1) |> select(-m) |> st_make_valid() antarctica_fixed #> Simple feature collection with 1 feature and 1 field #> Geometry type: MULTIPOLYGON #> Dimension: XY #> Bounding box: xmin: -2583099 ymin: -2458296 xmax: 2690846 ymax: 2233395 #> Projected CRS: +proj=ortho +lat_0=-90 +lon_0=0 #> # A tibble: 1 × 2 #> NAME geometry #> *#> 1 Antarctica (((-2456385 1179033, -2456141 1178965, -2456464 1178341, -2456563 117… ggplot(antarctica_fixed) + geom_sf(fill = "lightblue")
Exemple de complot
Cu forma corectată putem produce hărți. Mai jos sunt câteva exemple bazate pe modelele propuse de steag antarctic.
Propunerea lui Graham Bartram (1996)
O interpretare simplă a conceptului original al lui Bartram:
bbox <- st_bbox(antarctica_fixed) # For limits on the panel
antarctica_fixed |>
ggplot() +
geom_sf(fill = "white", color = NA) +
theme(
panel.background = element_rect(fill = "#009fdc"),
panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank()
) +
labs(title = "Graham Bartram's proposal") +
coord_sf(
xlim = c(bbox(c(1, 3))) * 1.8,
ylim = c(bbox(c(2, 4))) * 1.4
)
Emblema Tratatului Antarctic
Acest exemplu folosește reticule pentru a crea un model concentric „ochi de taur” în jurul Antarcticii. Generarea unor astfel de reticule și îmbinarea meridianelor necesită câțiva pași suplimentari pentru a evita golurile mici în apropierea polului.
# Need graticules
grats <- giscoR::gisco_get_countries() |>
st_transform(st_crs(antarctica_fixed)) |>
# Specify the cuts of the graticules
st_graticule(
lat = c(-80, -70, -60),
lon = seq(-180, 180, 30),
ndiscr = 10000,
margin = 0.000001
)
ggplot(grats) +
geom_sf(color = "darkblue")
Îmbinăm meridianele astfel încât zona din jurul Polului Sud este umplută. st_graticule()
poate lăsa o gaură mică la stâlp; rezolvăm acest lucru prin alăturarea meridianelor complementare.
# Merge meridians
merid <- lapply(seq(-180, 0, 30), function(x) {
df <- grats |>
filter(type == "E") |>
filter(degree %in% c(x, x + 180))
df2 <- df |>
st_geometry() |>
st_cast("MULTIPOINT") |>
st_union() |>
st_cast("LINESTRING")
sf_x <- st_sf(
degree = x,
type = "E",
geometry = df2
)
}) |> bind_rows()
grats_end <- merid |>
bind_rows(grats |>
filter(type != "E"))
Apoi tăiem și colorăm reticulele rezultate, astfel încât acestea să formeze modelul asemănător emblemei.
# Cut since some grats should be colored differently
antarctica_simp <- rmapshaper::ms_simplify(antarctica_fixed, keep = 0.005)
grats_yes <- st_intersection(grats_end, antarctica_simp)
grats_no <- st_difference(grats_end, antarctica_simp)
antarctica_simp |>
ggplot() +
geom_sf(fill = "white", color = NA) +
theme(
panel.background = element_rect(fill = "#072b5f"),
panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank()
) +
geom_sf(data = grats_yes, color = "#072b5f", linewidth = 1) +
geom_sf(data = grats_no, color = "white", linewidth = 1) +
coord_sf(
xlim = c(bbox(c(1, 3))) * 1.8,
ylim = c(bbox(c(2, 4))) * 1.4
) +
labs(title = "Emblem of the Antarctic Treaty")
Steagul Antarcticii reproiectat
În 2024, Graham Bartram a dezvăluit o nouă versiune a steagului său original, ca parte a unei campanii globale de sensibilizare cu privire la problema în creștere a poluării cu microplastic. Noul design păstrează conturul alb familiar al Antarcticii, dar schimbă fundalul albastru simplu cu unul plin de nenumărate puncte mici și colorate. Aceste puncte reprezintă bucățile microscopice de plastic care au fost descoperite chiar și în locurile cele mai neatinse ale planetei – inclusiv gheața Antarctica și oceanele din jur.
Deoarece designul se bazează pe aleatoriu, îl aproximăm folosind următoarea procedură:
- Eșantionați puncte aleatorii din poligonul antarctic.
- Construiți poligoane Voronoi din acele puncte, apoi aplicați un mic tampon negativ pentru a crea goluri.
- Eșantionați aleatoriu poligoanele rezultate pentru a crește zgomotul vizual.
- Poligoane de culoare, astfel încât zonele mai mari să rămână albe, în timp ce poligoanele mai mici folosesc tonuri magenta/roz.
# Maximum chunk of Antarctica, the one that we fixed ant_max_fixed #> Simple feature collection with 1 feature and 1 field #> Geometry type: POLYGON #> Dimension: XY #> Bounding box: xmin: -2447764 ymin: -2125910 xmax: 2690846 ymax: 2233395 #> Projected CRS: +proj=ortho +lat_0=-90 +lon_0=0 #> NAME geometry #> 1 Antarctica POLYGON ((-2423737 1557908,... set.seed(2024) # Sample, Voronoi and negative buffer plastics <- st_sample(ant_max_fixed, 3000) |> st_union() |> st_voronoi(envelope = st_geometry(ant_max_fixed)) |> st_collection_extract() |> st_buffer(dist = -10000) # Keep only those properly included in the outline toinc <- st_contains_properly(ant_max_fixed, plastics, sparse = FALSE) |> as.vector() # Select random chunks plastic_end <- plastics(toinc, ) |> st_as_sf() |> slice_sample(prop = 0.75) ggplot(plastic_end) + geom_sf(fill = "darkblue")
# Random coloring
plastic_end$area <- st_area(plastic_end) |> as.double()
plastic_end$fill <- sample(c("#ff00ec", "#9e00ec"), nrow(plastic_end), replace = TRUE)
plastic_end$fill <- ifelse(plastic_end$area > quantile(plastic_end$area, probs = 0.4),
"white",
plastic_end$fill
)
bbox2 <- st_bbox(plastic_end)
ggplot() +
geom_sf(data = plastic_end, aes(fill = fill), color = NA) +
scale_fill_identity() +
theme(
panel.background = element_rect(fill = "#009fdc"),
panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank()
) +
labs(title = "New redesign") +
coord_sf(
xlim = c(bbox2(c(1, 3)) * 1.8),
ylim = c(bbox2(c(2, 4))) * 1.4
)
