Skip to content

Instantly share code, notes, and snippets.

@andrewheiss
Created August 1, 2023 15:01
Show Gist options
  • Save andrewheiss/950248c53e2c2f3be01083b5860064b0 to your computer and use it in GitHub Desktop.
Save andrewheiss/950248c53e2c2f3be01083b5860064b0 to your computer and use it in GitHub Desktop.

Original xkcd

See Georgios Karamanis's example of doing this by converting the map into a raster object

library(tidyverse)
library(sf)
library(rnaturalearth)

# Map data
world_sf <- ne_countries(returnclass = "sf")

# Some cities and places
places <- tribble(
  ~place, ~lat, ~long,
  "Australia",  -25.2744,   133.7751,
  "Greenland",  76.7069,    -40.6043,
  "Congo-Amazon\nrainforest", -8, 45,
  "Quebec", 55.9399,    -65.5491,
  "Andes",  -10.8895,   -68.8458,
  "Hawaii", 24.8968,    -158.5828,
  "Rocky Mountains",    48.5501,    -110.9027,
  "Titanic Wreck", 40.7269, -49.9483,
  "Franklin's\nVery Lost\nExpedition",  69, -97,
  "St. Helena", -15.9583, -5.7020,
  "Palk-Panama Canal", 10, -79
) %>% 
  st_as_sf(coords = c("long", "lat"), crs = st_crs("EPSG:4326"))  # WGS 84

# Basic map
ggplot() +
  geom_sf(data = world_sf) +
  geom_sf_text(
    data = places, aes(label = place),
    lineheight = 0.9
  ) +
  coord_sf(crs = st_crs("ESRI:54030")) +  # Robinson
  theme_void()

# -------------------------------------------------------------------------
# Step 1: Make all the longitude points in the map use the absolute value
# -------------------------------------------------------------------------
# The geometry column contains MULTIPOLYGON shapes that are really just matrices
# of geographic points within deeply nested lists, like this:
example <- list(list(list(matrix(c(-1, 2, 3, 4), ncol = 2)),
  list(matrix(c(5, -3, 7, 8), ncol = 2))),
  list(list(matrix(c(-9, -4, 11, 12), ncol = 2))))
example
#> [[1]]
#> [[1]][[1]]
#> [[1]][[1]][[1]]
#>      [,1] [,2]
#> [1,]   -1    3
#> [2,]    2    4
#> 
#> 
#> [[1]][[2]]
#> [[1]][[2]][[1]]
#>      [,1] [,2]
#> [1,]    5    7
#> [2,]   -3    8
#> 
#> 
#> 
#> [[2]]
#> [[2]][[1]]
#> [[2]][[1]][[1]]
#>      [,1] [,2]
#> [1,]   -9   11
#> [2,]   -4   12

# We need to get the absolute value of the first column in each of these deeply
# nested lists
#
# I tried doing this with purrr functions and with a bunch of nested lapply()s,
# but it was still a huge mess. BUT base R has rapply(), which recursively works
# through nested lists and does stuff to each element
#
# So here, we go through all the nested elements of this gross list. If the
# nested object is a matrix, we'll take the absolute value of the first column
rapply(example, function(x) {
  if (is.matrix(x)) {
    x[, 1] <- abs(x[, 1])
  }
  x
}, how = "replace")
#> [[1]]
#> [[1]][[1]]
#> [[1]][[1]][[1]]
#>      [,1] [,2]
#> [1,]    1    3
#> [2,]    2    4
#> 
#> 
#> [[1]][[2]]
#> [[1]][[2]][[1]]
#>      [,1] [,2]
#> [1,]    5    7
#> [2,]    3    8
#> 
#> 
#> 
#> [[2]]
#> [[2]][[1]]
#> [[2]][[1]][[1]]
#>      [,1] [,2]
#> [1,]    9   11
#> [2,]    4   12


# This also works with the geometry column. The first column in the MULTIPOLYGON
# matrix is longitude, so we'll get its absolute value
world_sf_oops <- world_sf
world_sf_oops$geometry <- rapply(st_geometry(world_sf), function(x) {
  if (is.matrix(x)) {
    x[, 1] <- abs(x[, 1])
  }
  x
}, how = "replace")

# yesssss
# Though the original xkcd map does better with West Africa and Western Europe,
# and with Antarctica—those shapes go all the way to the edge of the map, but
# not here. Alas.
ggplot() +
  geom_sf(data = world_sf_oops) +
  theme_void()

# It would be neat to use st_union() to combine all these overlapping countries
# into one big blob, but I can't figure out how :( There are errors because of
# the weird country overlaps, even when using `st_make_valid()`
world_sf_blob <- world_sf %>% st_make_valid() %>% st_union()
#> Error in wk_handle.wk_wkb(wkb, s2_geography_writer(oriented = oriented, : Loop 0 is not valid: Edge 0 crosses edge 78

# So we can fake it by not plotting any boundaries
ggplot() +
  geom_sf(data = world_sf_oops, linewidth = 0) +
  theme_void()

# ------------------------------------------------------------------------------------
# Step 2: Make all the longitude points in the list of places use the absolute value
# ------------------------------------------------------------------------------------
# The geometry column in `places` contains POINT objects that are just
# two-element vectors. There's no weird deep nesting, so we can just use
# purrr::map() (though we need to wrap it in some sf-related functions to
# extract the geometry column and reproject it to WGS 84 when we're done)

places_oops <- places %>% 
  mutate(geometry = st_sfc(map(st_geometry(.), ~{
    .x[1] <- abs(.x[1])
    .x
  }))) %>% 
  st_set_crs(st_crs("EPSG:4326"))

ggplot() +
  geom_sf(data = world_sf_oops, linewidth = 0, fill = "white") +
  geom_sf_text(data = places_oops, aes(label = place), lineheight = 0.75) +
  theme_void() +
  theme(panel.background = element_rect(fill = "grey80"))

# The cool thing about leaving all this data as sf objects instead of raster
# data is that we can still do all sf-related stuff, like using different
# projections
ggplot() +
  geom_sf(data = world_sf_oops, linewidth = 0, fill = "white") +
  geom_sf_text(data = places_oops, aes(label = place), lineheight = 0.75) +
  coord_sf(crs = st_crs("ESRI:54030")) +  # Robinson
  theme_void() +
  theme(panel.background = element_rect(fill = "grey80"))

ggplot() +
  geom_sf(data = world_sf_oops, linewidth = 0, fill = "white") +
  geom_sf_text(data = places_oops, aes(label = place), lineheight = 0.75) +
  coord_sf(crs = st_crs("ESRI:54008")) +  # Sinusoidal
  theme_void() +
  theme(panel.background = element_rect(fill = "grey80"))

Created on 2023-08-01 with reprex v2.0.2

@andrewheiss
Copy link
Author

UPDATE thanks to Georgios! If you run sf_use_s2(FALSE) to disable spherical projections, you can merge all the countries into one big blob:

library(tidyverse)
library(sf)
library(rnaturalearth)

# Map data
world_sf <- ne_countries(returnclass = "sf")

# Absolute values
world_sf_oops <- world_sf
world_sf_oops$geometry <- rapply(st_geometry(world_sf), function(x) {
  if (is.matrix(x)) {
    x[, 1] <- abs(x[, 1])
  }
  x
}, how = "replace")

# Disable spherical projections
sf_use_s2(FALSE)
#> Spherical geometry (s2) switched off

# Combine all the MULTIPOLYGONs
world_sf_blob <- world_sf_oops %>% 
  st_make_valid() %>% 
  st_union()
#> although coordinates are longitude/latitude, st_union assumes that they are planar

# Plot the blob
ggplot() +
  geom_sf(data = world_sf_blob) +
  coord_sf(crs = st_crs("ESRI:54030")) +
  theme_void()

Created on 2023-08-01 with reprex v2.0.2

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment