Cool maps of the South Pole
6 minutes
Making cards with R is usually simple, but representations that cross boundaries International date line or using polar projections can be tricky.
Different spatial data providers use different conventions: some break geometries at certain longitudes (for example, intersecting the Chukchi Peninsula), while others omit parts of the data. These inconsistencies can cause troublesome artifacts near the poles.
In this post I fix the GISCO (European Commission) shapefile for Antarctica and produce clean orthographic maps. I go through the manual corrections and then create a few sample cards.
# Libraries library(tidyverse) library(sf) library(giscoR) library(ggrepel) library(rmapshaper)
Correct the geometry
First, we obtain the GISCO Antarctica polygon and transform it into an orthographic projection centered on the South Pole.
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")
The shapefile contains a visible “lollipop” cut that looks unnatural in an orthographic projection. I correct it manually by:
- Identify the polygon that represents the main Antarctic landmass.
- Convert that polygon to a series of coordinates (points).
- Remove the small series of points that create the artifact.
- Rebuild the polygon based on the cleaned coordinates and replace the broken geometry with the corrected one.
We convert polygons to point coordinates and inspect them to find the offending sequence:
# 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()
From the plotted indices we can see that the problematic points are roughly between 8200 and 9200. We inspect that interval in detail to select the exact indices to remove.
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)
Note: This cleaning is tailored to this specific shapefile and may need to be repeated for other shapefiles. The approach is simple, but depends on the specific geometry and projection.
# 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")
After removing the offending points, we rebuild the polygon and reconstruct the entire shape of Antarctica based on the corrected piece plus the remaining polygons.
# 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")
Examples of plotting
With the corrected shape we can make maps. Below are a few examples based on proposed Antarctic flag designs.
Graham Bartram’s Proposal (1996)
A simple representation of Bartram’s original concept:
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
)
Emblem of the Antarctic Treaty
In this example, grids are used to create a concentric ‘bullseye’ pattern around Antarctica. Generating such grids and merging meridians requires a few extra steps to avoid small gaps near the pole.
# 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")
We merge meridians to fill the area around the South Pole. st_graticule()
may leave a small hole on the post; we solve this by connecting complementary meridians.
# 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"))
We then cut and color the resulting grids so that they form the emblem-like pattern.
# 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")
Antarctica flag redesigned
In 2024, Graham Bartram unveiled a new version of his original flag as part of a global campaign to raise awareness of the growing problem of microplastic pollution. The new design retains the familiar white outline of Antarctica, but trades the solid blue background for one filled with countless small, colorful dots. These dots represent the microscopic pieces of plastic discovered in even the most pristine places on the planet, including the Antarctic ice and surrounding oceans.
Since the design depends on randomness, we approach it using the following procedure:
- Sample random points across the Antarctic polygon.
- Build Voronoi polygons based on those points and then apply a small negative buffer to create gaps.
- Randomly sample the resulting polygons to increase visual noise.
- Color polygons so that larger areas remain white, while smaller polygons use magenta/pink tones.
# 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
)
Related
#Mapping #Antarctica #bloggers