#30DayMapChallenge 2021 - Day 13 - Natural Earth data

personal_bounding_box.R

# Create a personal bounding box of travel on a world map
# For #30DayMapChallenge 2021 - Day 13 - Natural Earth data
#  -- David Friggens, November 2021

library(glue)
library(dplyr)
library(sf)
library(maps)
library(rnaturalearth)
library(ggplot2)
library(ggtext)

FONT <- "Love Ya Like A Sister"

COLOUR_LAND <- "light green"
COLOUR_BG <- "light blue"
COLOUR_TEXT <- "#333333"
COLOUR_STAY <- "blue"
COLOUR_TRANSIT <- "red"

# Prepare the world -------------------------------------------------------

world_small <-
  ne_countries(scale = "small", returnclass = "sf") %>%
  filter(!iso_a3 %in% c("ATA", "GRL", "ISL")) %>% 
  st_transform("+proj=patterson +lon_0=160")

world_crs <- 
  world_small %>% 
  st_crs()

# Prepare the cities ------------------------------------------------------

stayed <- 
  world.cities %>% 
  filter(name %in%
           c("Invercargill",
             "Dunedin",
             "Gisborne",
             "Wuhan",
             "Edinburgh",
             "Cardiff",
             "Saumane",
             "Lipari",
             "Melbourne"),
         ! country.etc %in%
           c("USA", "Canada", "Saint Helena")) %>% 
  # Got to do my own detective work!
  bind_rows(
    tribble(~name, ~country.etc, ~pop, ~lat, ~long, ~capital,
            "Lipari", "Italy", 0, 38.47, 14.95, 0,
            "Saumane", "France", 0, 44.12, 3.75, 0)
  ) %>% 
  st_as_sf(coords = c("long", "lat"), crs = 4326L) %>% 
  # Don't do this now or the great circles trick won't work
  # st_transform(crs = world_crs) %>% 
  # Easy hacks for label placement
  mutate(hj = if_else(substr(name, 1, 1) %in% c("D", "G", "L", "W"),
                      0, 1))

transited <- 
  world.cities %>% 
  filter(name %in% c("Bluff", "Los Angeles", "Catania"),
         country.etc != "Chile",
         !(name == "Frankfurt" & pop < 100000)) %>% 
  st_as_sf(coords = c("long", "lat"), crs = 4326L) %>% 
  # st_transform(crs = world_crs) %>% 
  mutate(up = name == "Los Angeles",
         hj = c(0.5, 1, 0)) # alphabetical order



# Prepare the lines -------------------------------------------------------

stayed_list <- 
  c("Gisborne", "Dunedin", "Invercargill", "Melbourne", "Lipari", "Saumane", "Cardiff", "Edinburgh", "Wuhan", "Gisborne")

stayed_lines <- 
  inner_join(
    tibble(name = stayed_list %>% head(-1)) %>% 
      mutate(segment_id = row_number()) %>% 
      inner_join(stayed, by = "name") %>% 
      select(segment_id, c1 = geometry),
    tibble(name = stayed_list %>% tail(-1)) %>% 
      mutate(segment_id = row_number()) %>% 
      inner_join(stayed, by = "name") %>% 
      select(segment_id, c2 = geometry)
  ) %>% 
  rowwise() %>% 
  mutate(geometry = st_union(c1, c2) %>% st_cast("LINESTRING")) %>% 
  ungroup() %>% 
  select(-c1, -c2) %>% 
  st_as_sf() %>% 
  st_segmentize(units::set_units(20, km))


transited_list <- 
  c("Gisborne", "Dunedin", "Bluff", "Melbourne", "Catania", "Saumane", "Cardiff", "Edinburgh", "Wuhan", "Los Angeles", "Gisborne")

transited_lines <- 
  inner_join(
    tibble(name = transited_list %>% head(-1)) %>% 
      mutate(segment_id = row_number()) %>% 
      inner_join(bind_rows(stayed, transited), by = "name") %>% 
      select(segment_id, c1 = geometry),
    tibble(name = transited_list %>% tail(-1)) %>% 
      mutate(segment_id = row_number()) %>% 
      inner_join(bind_rows(stayed, transited), by = "name") %>% 
      select(segment_id, c2 = geometry)
  ) %>% 
  rowwise() %>% 
  mutate(geometry = st_union(c1, c2) %>% st_cast("LINESTRING")) %>% 
  ungroup() %>% 
  select(-c1, -c2) %>% 
  st_as_sf() %>% 
  st_segmentize(units::set_units(20, km))


stayed <- 
  stayed %>% 
  st_transform(crs = world_crs)
stayed_lines <- 
  stayed_lines %>% 
  st_transform(crs = world_crs)
transited <- 
  transited %>% 
  st_transform(crs = world_crs)
transited_lines <- 
  transited_lines %>% 
  st_transform(crs = world_crs)


# Plot the map ------------------------------------------------------------

gg_pbb <- 
  ggplot() +
  geom_sf(data = world_small,
          colour = COLOUR_TEXT,
          fill = COLOUR_LAND) +
  geom_sf(data = transited,
          size = 3,
          colour = COLOUR_TRANSIT) +
  geom_sf_text(data = transited %>% filter(up),
                aes(label = name,
                    hjust = hj),
                nudge_y = 300000,
                colour = COLOUR_TRANSIT, family = FONT, size = 10) +
  geom_sf_text(data = transited %>% filter(!up),
                aes(label = name,
                    hjust = hj),
                nudge_y = -300000,
                colour = COLOUR_TRANSIT, family = FONT, size = 10) +
  geom_sf(data = transited_lines,
          size = 0.5,
          colour = COLOUR_TRANSIT,
          linetype = "11") +
  geom_sf(data = stayed_lines,
          size = 1,
          colour = COLOUR_STAY) +
  geom_sf(data = stayed,
          size = 5,
          colour = COLOUR_STAY) +
  geom_sf_text(data = stayed %>% filter(hj == 1),
               aes(label = name,
                   hjust = hj),
               nudge_x = -250000,
               colour = COLOUR_STAY, family = FONT, size = 10) +
  geom_sf_text(data = stayed %>% filter(hj == 0),
               aes(label = name,
                   hjust = hj),
               nudge_x = 250000,
               colour = COLOUR_STAY, family = FONT, size = 10) +
  coord_sf(datum = NA) +
  labs(title = glue("My Personal Bounding Box <span style='font-size:48pt;'>(both <span style='color:{COLOUR_STAY};'>stayed the night</span> and <span style='color:{COLOUR_TRANSIT};'>visit/transit</span>)</span>"),
       subtitle = "#30DayMapChallenge 20201 - 13 - Natural Earth data",
       caption = "David Friggens, @dakvid",
       x = NULL, y = NULL) +
  theme_minimal() +
  theme(plot.background = element_rect(fill = COLOUR_BG, colour = COLOUR_BG),
        panel.background = element_rect(fill = COLOUR_BG, colour = COLOUR_BG),
        plot.title = element_markdown(family = FONT, colour = COLOUR_TEXT, size = 72, vjust = 0.5),
        plot.subtitle = element_text(family = FONT, colour = COLOUR_TEXT, size = 32),
        plot.caption = element_text(family = FONT, colour = COLOUR_TEXT, size = 28))

ggsave(plot = gg_pbb,
       path = "Day_13", filename = "Day_13_personal_bb.png", device = "png",
       width = 38, height = 20, dpi = 72)