28. The Blue Planet

Map

Water makes up nearly three-quarters of the Earth’s surface. It’s an amazing thing really - if the atmosphere was any heavier, at a higher pressure the seas would boil away, and if our planet’s orbit was slightly further away from the sun the seas would be frozen.

This animation shows countries disapearing and it’s area added to an ever-growing circle. The map is an equal-area map which gives you a good idea of just how blue our planet is.

#First, we'll need to load a bunch of libraries so we can handle and view geospatial data
library(sf)
library(ggplot2)
library(rnaturalearth)
library(gganimate)
library(purrr)
library(dplyr)

sf::sf_use_s2(TRUE)

#Load the shapefile for the world boundaries
a <- st_read('./data/11/TM_WORLD_BORDERS-0.2.shp', quiet = TRUE)

#Transform the shapefile to Mollweide projection - this is an equal-area projection
b <- a %>% st_transform(crs = "ESRI:54009")

#Add an id column to the data
for(i in 1:nrow(b)) {
  b$id[i] = i
}

# Create sf polygon using WGS84 extent coordinates then project to Mollweide
# This will be the circle that grows as the countries disappear
bbox <- data.frame(lon = c(rep(-180, 180), seq(-180, 180, length.out = 100),
                           rep(180, 180), seq(180, -180, length.out = 100)),
                   lat = c(seq(-90, 90, 1), rep(90, 99), 
                           seq(90, -90, -1), rep(-90, 99))) %>%
  st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
  summarise(geometry = st_combine(geometry)) %>%
  st_cast("POLYGON") %>%
  st_transform("ESRI:54009")

# #Loop through each country and create a map
# unique(b$id) %>% purrr::walk(function(this_id) { 
# 
#   #Filter the data to only include countries with an id greater than the current id
#   filtered <-  filter(b, b$id>this_id)
#   
#   #Calculate the total area of the countries that have been removed
#   #and set the area of the circle to be the same
#   removed <-  filter(b, b$id<=this_id)
#   p <- st_as_sfc("POINT(0 0)")
#   st_crs(p) <- 3857
#   total_area <- sum(st_area(removed))
#   radius <- sqrt(total_area/pi)
#   circle <- st_buffer(p,radius)  %>% st_transform(crs = st_crs(b))
#   
# 
#   #Plot the map
#   ggplot() +
#     geom_sf(data = bbox, fill = "darkblue", col = "darkblue", linewidth = 0.25) +
#     geom_sf(data = filtered, fill= "lightgreen", color="darkblue") +
#     geom_sf(data = circle, fill= "lightgreen", color="darkblue") +
#     theme_void() +
#     theme(axis.title = element_blank(),
#           plot.background = element_rect(fill = "transparent", colour = NA),
#           panel.background = element_rect(fill = "white", colour = NA),
#           panel.border = element_rect(fill = NA,
#                                       colour = "#238B45",
#                                       linewidth = 2,
#                                       inherit.blank = TRUE))
# 
#   ggsave(sprintf("/tmp/blue-planet-%i.png", this_id))
# 
# })
# 
# system("ffmpeg -framerate 30 -i /tmp/blue-planet-%d.png -pix_fmt yuv420p images/blue-planet.mp4")

28. The Blue Planet

Map

Credits