World map reimagined

Author
Published

May 5, 2018

  1. Intro
library(sf)
Linking to GEOS 3.9.2, GDAL 3.3.3, PROJ 8.2.1; sf_use_s2() is TRUE
library(tmap)
library(spData)
data("world")
rotation = function(a){
  r = a * pi/180 #degrees to radians
  matrix(c(cos(r), sin(r), -sin(r), cos(r)), nrow = 2, ncol = 2)
} 
world_sfc = st_geometry(world) 
  1. South-up map of the world
world_sfc2 = world_sfc %>% st_transform("+proj=robin")
world_sfc2_rev = world_sfc2 * rotation(180) 
world_sfc2_rev = st_set_crs(world_sfc2_rev, "+proj=robin")
tm_shape(world_sfc2_rev) +
  tm_polygons() + 
  tm_graticules()
  1. World maps with different central points, e.g. Europe, Asia, America…
library(sf)
library(spData)
library(tmap)

world_sfc3 = st_geometry(world_sfc)
world_sfc4 = st_buffer(world_sfc3, 0) 
world_sfc5 = st_collection_extract(world_sfc4, "POLYGON")
world_sfc6 = (world_sfc5 + c(180, 90)) %% c(360) - c(180, 90)
tm_shape(world_sfc6) +
        tm_polygons()
world_sfc4 = world_sfc + c(180, 0)
world_sfc4 = lwgeom::st_make_valid(world_sfc4)
world_sfc4 = world_sfc4 %>% 
  st_set_crs(4326) %>% 
  st_segmentize(1000000) 
x = world_sfc4 %>% 
  st_wrap_dateline(options = c("WRAPDATELINE=YES",  "DATELINEOFFSET=180"), quiet = TRUE) %>% 
  st_set_precision(1000) %>% 
  st_union(by_feature = TRUE)
tm_shape(x) +
        tm_polygons()
world_sfc22 = st_segmentize(world_sfc, 1000)

world_sfc4 = world_sfc22 + c(45, 0)
x = world_sfc4 %>% 
  st_set_crs(4326) %>% 
  lwgeom::st_make_valid() %>% 
  st_wrap_dateline(options = c("WRAPDATELINE=YES",  "DATELINEOFFSET=45"), quiet = TRUE) %>% 
  st_set_precision(1000) %>% 
  st_union(by_feature = TRUE)

tm_shape(x) +
        tm_polygons()
  1. 2 and 3 combined
recentre = function(x,
                     clon = NULL,
                     ...,
                     tryfix = TRUE) {
  if (is.null(clon))
    return(x)
  if (!st_is_longlat(x))
    stop("recentring not appropriate for non longlat data")
  ## save the crs while we do our munging
  crs = st_crs(x)
  x = st_set_crs(x, NA)
  
  
  ## try to fix problematic geometry
  if (tryfix) {
    if (all(grepl("POLYGON", st_geometry_type(x))))
      x = suppressWarnings(st_buffer(sf::st_as_sf(x), 0))
    x =
      st_wrap_dateline(x, options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180"))
  }
  wbox =
    st_bbox(c(
      xmin = -180,
      ymin = -90,
      xmax = (clon) %% 360 - 180,
      ymax = 90
    ))
  west = suppressWarnings(st_crop(x, wbox))
  west = st_set_geometry(west, st_geometry(west) + c(360, 0))
  east =
    suppressWarnings(st_crop(x, st_bbox(
      c(
        xmin = (clon) %% 360 - 180,
        xmax = 180,
        ymin = -90,
        ymax = 90
      )
    )))
  xx = rbind(west, east)
  ## ensure geometries are of consistent type
  xx = sf::st_cast(xx)
  bb = st_bbox(xx)
  ## hmmm
  # if (bb["xmax"] > 180 && !grepl("\\+over", crs) && !grepl("init", crs)) {
  #   crs = sprintf("%s +over", crs)
  # }
  st_set_crs(xx, crs)
}

world2 = rmapshaper::ms_simplify(world, keep = 0.99)
all(st_is_valid(world2))
world2 = lwgeom::st_make_valid(world2)

library(dplyr)
rsx = recentre(world2, clon = -152) %>%
  group_by(name_long) %>%
  summarize()

Reuse

Citation

BibTeX citation:
@online{nowosad2018,
  author = {Nowosad, Jakub},
  title = {World Map Reimagined},
  date = {2018-05-05},
  url = {https://jakubnowosad.com/posts/drafts/XXXX-XX-XX-world-map-reimagined.html},
  langid = {en}
}
For attribution, please cite this work as:
Nowosad, Jakub. 2018. “World Map Reimagined.” May 5, 2018. https://jakubnowosad.com/posts/drafts/XXXX-XX-XX-world-map-reimagined.html.