Objective

Nearly four years after writing a blog post about recreating R figures in ODV I had someone reach out to me expressing interest in adding a bathymetry layer over the interpolated data. It’s always nice to know that these blog posts are being found useful for other researchers. And I have to admit I’m a bit surprised that the code still runs 4 years later. Especially considering that it uses the tidyverse which is notorious for breaking backwards compatibility. In order to demonstrate the overlaying of bathymetry data on a CTD transect we will need to use a different dataset than in the previous blog post. One may use any data one would like, but for this blog I went to this shiny app to extract some data from the coast of South Africa. Specifically I filtered for temperature data from November 1990 at all depths. We won’t go back over the theory for recreating the ODV figure in this blog post, so please revisit that for a recap as necessary. Below I will show two of the necessary steps to get interpolated CTD data before we begin on the bathymetry mask.

# Load libraries
library(tidyverse)
library(lubridate)
library(reshape2)
library(MBA)
library(mgcv)
library(marmap)
library(FNN)

# The transects in this dataset do not have an ID column
# So we manually select the first transect (rows 1 - 12)
# This is then used as a mask to select all depths for these pixels
# We will also use these unique lon/lat coords for bathymetry points
ctd_mask <- read_csv("../../static/data/CTD_transect.csv") %>% 
  select(lon, lat) %>% 
  slice(1:12) %>% 
  unique()

# Load and screen data
  # For ease I am only using monthly means
  # and depth values rounded to 10 metres
ctd <- read_csv("../../static/data/CTD_transect.csv") %>% 
  mutate(depth = -depth) %>%  # Correct for plotting
  right_join(ctd_mask, by = c("lon", "lat")) %>% 
  select(lon, lat, depth, temp)

# Manually extracted hexidecimal ODV colour palette
ODV_colours <- c("#feb483", "#d31f2a", "#ffc000", "#27ab19", "#0db5e6", "#7139fe", "#d16cfa")

# Create quick scatterplot
ggplot(data = ctd, aes(x = lon, y = depth)) +
  geom_point(aes(colour = temp)) +
  scale_colour_gradientn(colours = rev(ODV_colours)) +
  labs(y = "depth (m)", x = "longitude (°E)", colour = "temp. (°C)")

Figure 1: A non-interpolated scatterplot of our temperature (°C) data shown as a function of depth (m) over longitude (°E).

It looks like we have a nice little upwelling signal coming through at the coast. It will be interesting to see how the interpolation handles that. We’ll quickly run the interpolation and then get to the bathymetry overlay. Note that these data are not on a straight latitude transect, but we are not going to worry about that in this blog post.

# Now we may interpolate the data
# NB: The columns that mba.surf() will interpolate are the X, Y, Z values in that order
ctd_mba <- mba.surf(ctd[c("lon", "depth", "temp")], no.X = 300, no.Y = 300, extend = T)
dimnames(ctd_mba$xyz.est$z) <- list(ctd_mba$xyz.est$x, ctd_mba$xyz.est$y)
ctd_mba <- melt(ctd_mba$xyz.est$z, varnames = c('lon', 'depth'), value.name = 'temp') %>% 
  filter(depth < 0) %>% 
  mutate(temp = round(temp, 1))

# Finally we create our gridded result
ggplot(data = ctd_mba, aes(x = lon, y = depth)) +
  geom_raster(aes(fill = temp)) +
  geom_contour(aes(z = temp), binwidth = 2, colour = "black", alpha = 0.2) +
  geom_contour(aes(z = temp), breaks = 20, colour = "black") +
  scale_fill_gradientn(colours = rev(ODV_colours)) +
  labs(y = "depth (m)", x = "longitude (°E)", fill = "temp. (°C)") +
  coord_cartesian(expand = F)

Figure 2: The same temperature (°C) profiles seen in Figure 1 with the missing values filled in with multilevel B-splines.

Bathymetry

The interpolation seems to have done a decent job of acknowledging the upwelling signal. It may be possible to tweak the interpolation more, as desired, but I’m happy enough with it for the purposes of this post. We are going to skip over the step to cut out the artefacts at the bottom of the figure where there are not data points because we are rather going to just overlay our bathymetry mask. First we will download the bathymetry data. Then we find the points that are closest to our CTD transect. These will then be used for the grey overlay at the bottom of the figure.

# Bathymetry within transect bounding box
bathy <- getNOAA.bathy(lon1 = min(ctd$lon), lon2 = max(ctd$lon), 
                       lat1 = min(ctd$lat), lat2 = max(ctd$lat), 
                       resolution = 5) # Larger numbers for coarser data

# Convert bathy object to a data.frame for easier use
bathy_df <- data.frame(lon_b = as.numeric(rownames(bathy)),
                       lat_b = as.numeric(colnames(bathy)),
                       depth = as.numeric(bathy)) %>% 
  mutate(bathy_idx = 1:n()) # Used for merging CTD and bathy data

# Find nearest points to transect data
ctd_mask <- ctd_mask %>% 
  mutate(bathy_idx = as.vector(knnx.index(as.matrix(bathy_df[,c("lon_b", "lat_b")]),
                                           as.matrix(ctd_mask[,c("lon", "lat")]), k = 1))) %>% 
  left_join(bathy_df, by = "bathy_idx")

# Manually create bottom of the bathy mask polygon
bathy_mask <- data.frame(lon = c(ctd_mask$lon, rev(ctd_mask$lon)),
                         depth = c(ctd_mask$depth, rep(min(ctd_mask$depth), nrow(ctd_mask))))

# We may now use that bathy mask for our final figure
ggplot(data = ctd_mba, aes(x = lon, y = depth)) +
  geom_raster(aes(fill = temp)) +
  geom_contour(aes(z = temp), binwidth = 2, colour = "black", alpha = 0.2) +
  geom_contour(aes(z = temp), breaks = 20, colour = "black") +
  geom_polygon(data = bathy_mask, fill = "grey80", colour = "black") +
  scale_fill_gradientn(colours = rev(ODV_colours)) +
  labs(y = "depth (m)", x = "longitude (°E)", fill = "temp. (°C)") +
  coord_cartesian(expand = F)

Figure 3: The same temperature (°C) profiles seen in Figure 2 with the bathymetry values overlaid.

Unfortunately in this example there is a bit of blank space in the bottom left of the plot because the CTD casts do not go deeper than 200 m, and the interpolation doesn’t fill in values outside of the rectangular box dictated by the X (lon) and Y (depth) values. A cheeky workaround for this issue would be to simply crop the figure to the bottom of the interpolated data, and not the bathymetry.

# We may now use that bathy mask for our final figure
ggplot(data = ctd_mba, aes(x = lon, y = depth)) +
  geom_raster(aes(fill = temp)) +
  geom_contour(aes(z = temp), binwidth = 2, colour = "black", alpha = 0.2) +
  geom_contour(aes(z = temp), breaks = 20, colour = "black") +
  geom_polygon(data = bathy_mask, fill = "grey80", colour = "black") +
  geom_point(data = ctd, aes(x = lon, y = depth),
             colour = 'black', size = 0.2, alpha = 0.4, shape = 8) +
  scale_fill_gradientn(colours = rev(ODV_colours)) +
  labs(y = "depth (m)", x = "longitude (°E)", fill = "temp. (°C)") +
  coord_cartesian(expand = F, ylim = c(-200, 0)) +
  theme(panel.border = element_rect(fill = NA, colour = "black"))

Figure 4: The plotting area cropped to the interpolated data, rather than the bathymetry mask. Also shown with black dots are the original CTD data.

Summary

In this tutorial we have seen how to plot a bathymetry overlay that matches the lon/lat coordinates of the CTD casts. I’m sure there is a way to force the interpolation to fill in values at a greater depth to match the bathymetry, but the focus of this blog was on adding the bathymetry mask itself, and I think we have addressed this issue. The workflow outlined above has a couple of bumps in it, but should be adaptable to a range of applications.

Objective

While running some brief quality control tests on Bio-Oracle layers before using them for a recent project it was detected that some of the layers in the current version of the Bio-Oracle product appear to have very large errors. Specifically the error is that there are layers where the minimum values are greater than the maximum values. It is unclear how this could be possible, so in the following text and code we will look into how we go about investigating these data layers and we will discuss which layers are fine, and which are not. This error was first detected in the current velocity layers but a brief search turned up errors in other layers, too. So in this post we will be going through each individual layer to test for this max less than min error. We will look at all of the different depths as well as the future projections.

# Load required libraries
library(tidyverse)
library(sdmpredictors)

# The possible layers for download from Bio-Oracle
BO_layers <- list_layers(datasets = "Bio-ORACLE")

# The future layers
BO_layers_future <- list_layers_future(datasets = "Bio-ORACLE")

Testing pipeline

The following code chunk contains a function that will run the testing pipeline that highlights any errors in the data. To use it we choose a variable from the list of Bio-Oracle variables shown above that have a max and min version of the layer. One must replace the ‘max’ or ‘min’ with ‘X’ and give that to the function, it will do the rest. Note that if one is running this script the figures this function will save to disk take about 1 minute to render due to their high resolution. Also please note that this function assumes there is a “figures” folder in the root directory on the computer on which this code is being run. If not, one must be created or the function must be changed to point to the desired folder.

BO_test <- function(var_name, scenario = "present", year = NA){
  
  # Establish min/max layer names
  min_layer <- gsub("X", "min", var_name)
  max_layer <- gsub("X", "max", var_name)
  
  # Download data
  if(scenario == "present"){
    BO_layers_dl <- load_layers(c(min_layer, max_layer))
    var_title <- var_name
  } else {
    BO_layer_names <- get_future_layers(c(min_layer, max_layer), scenario = scenario, year = year)
    BO_layers_dl <- load_layers(BO_layer_names$layer_code)
    var_title <- gsub("max_", "X_", BO_layer_names$layer_code[1])
  }
  
  # Prepare data for plotting
  BO_layers_test <- as.data.frame(BO_layers_dl, xy = T) %>% 
    dplyr::rename(lon = x, lat = y) %>% 
    mutate(lon = round(lon, 4), 
           lat = round(lat, 4)) %>% 
    na.omit() %>% 
    `colnames<-`(c("lon", "lat", "min_val", "max_val")) %>% 
    mutate(max_min = ifelse(max_val >= min_val, TRUE, FALSE))
  
  # Visualise pixels where min values are greater than the max
  test_plot <- ggplot(data = BO_layers_test, aes(x = lon, y = lat)) +
    geom_raster(aes(fill = max_min)) +
    coord_quickmap(expand = F) +
    labs(fill = "Max greater than min", x = NULL, y = NULL, title = var_title) +
    theme(legend.position = "bottom")
  
  # Save figure to disk
  ggsave(paste0("~/figures/",var_title,".png"), test_plot, height = 5, width = 8)
}

Look at layers

In this section we will go through all of the BO layers that have a min/max option and we will compare them to ascertain whether the maximum values are always greater than the minimums, which they should be, but we have found that sometimes this is not the case. When possible we will also look at future projections of the layers with RCP8.5 at 2050 and 2100. In the first code chunk in this section we will look at the older Bio-Oracle layers.

# Up first we start with the older Bio-Oracle layers

# Bathymetry
BO_test("BO_bathyX") # No issues

# Chlorophyll
BO_test("BO_chloX") # No issues

# Cloud fraction
BO_test("BO_cloudX") # No issues

# Diffuse attenuation
BO_test("BO_daX") # No issues

# SST
BO_test("BO_sstX") # No issues

It is reassuring to see that all of the older BO layers have no issues in them. From my initial testing it looked like the layers with errors may have been from data assimilation from the GLORYS product for the most recent Bio-Oracle layers. That the older layers have no issues appears to support the hypothesis that the bug in the Bio-Oracle pipeline was introduced in the BO2 version of the product.

The next code chunk goes through all of the newer layers and where possible the future projections, too. Note that many layers have four different depth options. The surface (ss), the min (bdmin), the mean (bdmean), and the max (bdmax) depths present at each pixel. We are testing all of these as I have hypothesised that the inclusion of these three different depths may be responsible for some of the errors observed. Another distinction to make for the following tests is that there are min/max values for each layer, which take the absolute min/max recorded at a pixel. And then there are the long-term min/max values, which are the average annual min/max recorded over the length of the available data. The long-term min/max values are more representative of the climatological means within an area, and the absolute min/max are representative of the most extreme events that may occur in an area. Generally one is going to be more interested in the long-term values for normal species distribution modelling (SDM) applications. Because these min/max values are calculated differently it is necessary to test both of them to see if the errors in the data differ in any discernible way.

# Carbon phytoplankton biomass absolute
BO_test("BO2_carbonphytoX_bdmax") # No issues
BO_test("BO2_carbonphytoX_bdmean") # No issues
BO_test("BO2_carbonphytoX_bdmin") # No issues
BO_test("BO2_carbonphytoX_ss") # No issues

# Carbon phytoplankton biomass long-term
BO_test("BO2_carbonphytoltX_bdmax") # No issues
BO_test("BO2_carbonphytoltX_bdmean") # No issues
BO_test("BO2_carbonphytoltX_bdmin") # No issues
BO_test("BO2_carbonphytoltX_ss") # No issues

# Chlorophyll absolute
BO_test("BO2_chloX_bdmax") # No issues
BO_test("BO2_chloX_bdmean") # No issues
BO_test("BO2_chloX_bdmin") # No issues
BO_test("BO2_chloX_ss") # No issues
BO_test("BO2_chloX_ss", scenario = "RCP85", year = 2050) # Most pixels fail
BO_test("BO2_chloX_ss", scenario = "RCP85", year = 2100) # Slightly better than the 2050 data

# Chlorophyll long-term
BO_test("BO2_chloltX_bdmax") # No issues
BO_test("BO2_chloltX_bdmean") # No issues
BO_test("BO2_chloltX_bdmin") # No issues
BO_test("BO2_chloltX_ss") # No issues
BO_test("BO2_chloltX_ss", scenario = "RCP85", year = 2050) # Same issues as absolute layer
BO_test("BO2_chloltX_ss", scenario = "RCP85", year = 2100) # Slightly better than the 2050 data

# Current velocities absolute
BO_test("BO2_curvelX_bdmax") # Global issues
BO_test("BO2_curvelX_bdmax", scenario = "RCP85", year = 2050) # Global issues
BO_test("BO2_curvelX_bdmax", scenario = "RCP85", year = 2100) # Global issues
BO_test("BO2_curvelX_bdmean") # Global issues
BO_test("BO2_curvelX_bdmean", scenario = "RCP85", year = 2050) # Global issues
BO_test("BO2_curvelX_bdmean", scenario = "RCP85", year = 2100) # Global issues
BO_test("BO2_curvelX_bdmin") # Global issues
BO_test("BO2_curvelX_bdmin", scenario = "RCP85", year = 2050) # Global issues
BO_test("BO2_curvelX_bdmin", scenario = "RCP85", year = 2100) # Global issues
BO_test("BO2_curvelX_ss") # Mostly fails around the equator
BO_test("BO2_curvelX_ss", scenario = "RCP85", year = 2050) # Mirror image errors of present day
BO_test("BO2_curvelX_ss", scenario = "RCP85", year = 2100) # Mirror image errors of present day

# Current velocities long-term
# The first issue noted in the BO2 layers were these
BO_test("BO2_curvelltX_bdmax") # Global issues
BO_test("BO2_curvelltX_bdmax", scenario = "RCP85", year = 2050) # Global issues
BO_test("BO2_curvelltX_bdmax", scenario = "RCP85", year = 2100) # Global issues
BO_test("BO2_curvelltX_bdmean") # Global issues
BO_test("BO2_curvelltX_bdmean", scenario = "RCP85", year = 2050) # Global issues
BO_test("BO2_curvelltX_bdmean", scenario = "RCP85", year = 2100) # Global issues
BO_test("BO2_curvelltX_bdmin") # Global issues
BO_test("BO2_curvelltX_bdmin", scenario = "RCP85", year = 2050) # Global issues
BO_test("BO2_curvelltX_bdmin", scenario = "RCP85", year = 2100) # Global issues
BO_test("BO2_curvelltX_ss") # Mostly fails around the equator
BO_test("BO2_curvelltX_ss", scenario = "RCP85", year = 2050) # Mirror image errors of present day
BO_test("BO2_curvelltX_ss", scenario = "RCP85", year = 2100) # Mirror image errors of present day

# Dissolved oxygen
BO_test("BO2_dissoxX_bdmax") # No issues
BO_test("BO2_dissoxX_bdmean") # No issues
BO_test("BO2_dissoxX_bdmin") # No issues
BO_test("BO2_dissoxX_ss") # No issues

# Dissolved oxygen long-term
BO_test("BO2_dissoxltX_bdmax") # No issues
BO_test("BO2_dissoxltX_bdmean") # No issues
BO_test("BO2_dissoxltX_bdmin") # No issues
BO_test("BO2_dissoxltX_ss") # No issues

# Ice cover
BO_test("BO2_icecoverX_ss") # No issues

# Ice cover long-term
BO_test("BO2_icecoverltX_ss") # No issues

# Ice thickness
BO_test("BO2_icethickX_ss") # No issues
BO_test("BO2_icethickX_ss", scenario = "RCP85", year = 2050) # All ice layers areas appear to be wrong
BO_test("BO2_icethickX_ss", scenario = "RCP85", year = 2100) # All ice layers areas appear to be wrong

# Ice thickness long-term
BO_test("BO2_icethickltX_ss") # No issues
BO_test("BO2_icethickltX_ss", scenario = "RCP85", year = 2050) # All ice layers areas appear to be wrong
BO_test("BO2_icethickltX_ss", scenario = "RCP85", year = 2100) # All ice layers areas appear to be wrong

# Iron
BO_test("BO2_ironX_bdmax") # No issues
BO_test("BO2_ironX_bdmean") # No issues
BO_test("BO2_ironX_bdmin") # No issues
BO_test("BO2_ironX_ss") # No issues

# Iron long-term
BO_test("BO2_ironltX_bdmax") # No issues
BO_test("BO2_ironltX_bdmean") # No issues
BO_test("BO2_ironltX_bdmin") # No issues
BO_test("BO2_ironltX_ss") # No issues

# Light at bottom
BO_test("BO2_lightbotX_bdmax") # No issues
BO_test("BO2_lightbotX_bdmean") # No issues
BO_test("BO2_lightbotX_bdmin") # No issues

# Light at bottom long-term
BO_test("BO2_lightbotltX_bdmax") # Global errors different from current velocity errors
BO_test("BO2_lightbotltX_bdmean") # Global errors different from current velocity errors
BO_test("BO2_lightbotltX_bdmin") # Global errors different from current velocity errors

# Nitrate
BO_test("BO2_nitratemax_bdmax") # No issues
BO_test("BO2_nitratemax_bdmean") # No issues
BO_test("BO2_nitratemax_bdmin") # No issues
BO_test("BO2_nitratemax_ss") # No issues

# Nitrate long-term
BO_test("BO2_nitrateltmax_bdmax") # No issues
BO_test("BO2_nitrateltmax_bdmean") # No issues
BO_test("BO2_nitrateltmax_bdmin") # No issues
BO_test("BO2_nitrateltmax_ss") # No issues

# Phosphate absolute
BO_test("BO2_phosphateX_bdmax") # No issues
BO_test("BO2_phosphateX_bdmean") # No issues
BO_test("BO2_phosphateX_bdmin") # No issues
BO_test("BO2_phosphateX_ss") # No issues

# Phosphate long-term
BO_test("BO2_phosphateltX_bdmax") # No issues
BO_test("BO2_phosphateltX_bdmean") # No issues
BO_test("BO2_phosphateltX_bdmin") # No issues
BO_test("BO2_phosphateltX_ss") # No issues

# Primary production absolute
BO_test("BO2_ppmax_bdmax") # No issues
BO_test("BO2_ppmax_bdmean") # No issues
BO_test("BO2_ppmax_bdmin") # No issues
BO_test("BO2_ppmax_ss") # No issues

# Primary production long-term
BO_test("BO2_ppltmax_bdmax") # No issues
BO_test("BO2_ppltmax_bdmean") # No issues
BO_test("BO2_ppltmax_bdmin") # No issues
BO_test("BO2_ppltmax_ss") # No issues

# Salinity absolute
BO_test("BO2_salinityX_bdmax") # No issues
BO_test("BO2_salinityX_bdmax", scenario = "RCP85", year = 2050) # Most pixels fail
BO_test("BO2_salinityX_bdmax", scenario = "RCP85", year = 2100) # Most pixels fail
BO_test("BO2_salinityX_bdmean") # No issues
BO_test("BO2_salinityX_bdmean", scenario = "RCP85", year = 2050) # Most pixels fail
BO_test("BO2_salinityX_bdmean", scenario = "RCP85", year = 2100) # Most pixels fail
BO_test("BO2_salinityX_bdmin") # No issues
BO_test("BO2_salinityX_bdmin", scenario = "RCP85", year = 2050) # Most pixels fail
BO_test("BO2_salinityX_bdmin", scenario = "RCP85", year = 2100) # Most pixels fail
BO_test("BO2_salinityX_ss") # No issues
BO_test("BO2_salinityX_ss", scenario = "RCP85", year = 2050) # Almost all pixels fail
BO_test("BO2_salinityX_ss", scenario = "RCP85", year = 2100) # Almost all pixels fail

# Salinity long-term
BO_test("BO2_salinityltX_bdmax") # No issues
BO_test("BO2_salinityltX_bdmax", scenario = "RCP85", year = 2050) # Global issues
BO_test("BO2_salinityltX_bdmax", scenario = "RCP85", year = 2100) # Global issues
BO_test("BO2_salinityltX_bdmean") # No issues
BO_test("BO2_salinityltX_bdmean", scenario = "RCP85", year = 2050) # Global issues
BO_test("BO2_salinityltX_bdmean", scenario = "RCP85", year = 2100) # Global issues
BO_test("BO2_salinityltX_bdmin") # No issues
BO_test("BO2_salinityltX_bdmin", scenario = "RCP85", year = 2050) # Global issues
BO_test("BO2_salinityltX_bdmin", scenario = "RCP85", year = 2100) # Global issues
BO_test("BO2_salinityltX_ss") # No issues
BO_test("BO2_salinityltX_ss", scenario = "RCP85", year = 2050) # Almost all pixels fail
BO_test("BO2_salinityltX_ss", scenario = "RCP85", year = 2100) # Almost all pixels fail

# Silicate absolute
BO_test("BO2_silicatemax_bdmax") # No issues
BO_test("BO2_silicatemax_bdmean") # No issues
BO_test("BO2_silicatemax_bdmin") # No issues
BO_test("BO2_silicatemax_ss") # No issues

# Silicate long-term
BO_test("BO2_silicateltmax_bdmax") # No issues
BO_test("BO2_silicateltmax_bdmean") # No issues
BO_test("BO2_silicateltmax_bdmin") # No issues
BO_test("BO2_silicateltmax_ss") # No issues

# Temperature absolute
BO_test("BO2_tempX_bdmax") # No issues
BO_test("BO2_tempX_bdmax", scenario = "RCP85", year = 2050) # Almost all pixels fail
BO_test("BO2_tempX_bdmax", scenario = "RCP85", year = 2100) # Almost all pixels fail
BO_test("BO2_tempX_bdmean") # No issues
BO_test("BO2_tempX_bdmean", scenario = "RCP85", year = 2050) # Almost all pixels fail
BO_test("BO2_tempX_bdmean", scenario = "RCP85", year = 2100) # Almost all pixels fail
BO_test("BO2_tempX_bdmin") # No issues
BO_test("BO2_tempX_bdmin", scenario = "RCP85", year = 2050) # Almost all pixels fail
BO_test("BO2_tempX_bdmin", scenario = "RCP85", year = 2100) # Almost all pixels fail
BO_test("BO2_tempX_ss") # No issues
BO_test("BO2_tempX_ss", scenario = "RCP85", year = 2050) # All pixels fail
BO_test("BO2_tempX_ss", scenario = "RCP85", year = 2100) # All pixels fail

# Temperature long-term
BO_test("BO2_templtX_bdmax") # No issues
BO_test("BO2_templtX_bdmax", scenario = "RCP85", year = 2050) # Almost all pixels fail
BO_test("BO2_templtX_bdmax", scenario = "RCP85", year = 2100) # Almost all pixels fail
BO_test("BO2_templtX_bdmean") # No issues
BO_test("BO2_templtX_bdmean", scenario = "RCP85", year = 2050) # Almost all pixels fail
BO_test("BO2_templtX_bdmean", scenario = "RCP85", year = 2100) # Almost all pixels fail
BO_test("BO2_templtX_bdmin") # No issues
BO_test("BO2_templtX_bdmin", scenario = "RCP85", year = 2050) # Almost all pixels fail
BO_test("BO2_templtX_bdmin", scenario = "RCP85", year = 2100) # Almost all pixels fail
BO_test("BO2_templtX_ss") # No issues
BO_test("BO2_templtX_ss", scenario = "RCP85", year = 2050) # All but a few pixels fail
BO_test("BO2_templtX_ss", scenario = "RCP85", year = 2100) # All but a few different pixels fail

Discussion

This is not meant to be exhaustive, but does represent the majority of the data layers offered by Bio-Oracle. I had hypothesised that the three different depth options per pixel would have been related to the issues in the data assimilation but it does not appear to be the case. I’ve concluded this because whenever a depth layer has issues, those errors appear to be very similar across the three different depth layers. One consistent pattern we do see is if there are any errors, then every depth layer for that variable will also have errors. This also applies to absolute vs. long-term max/min layers. Errors in one means errors in all. Another consistent pattern in the error was that all of the future projections at all depths for absolute and long-term min/max values had errors in them. This begs the question of how it is that the future projection can have no errors, while the present day layers do not. How are these future projection layers calculated differently from the present day? Are they not based on the same data?

Most of the layers that have issues are physical layers. It is my understanding that these layers would have been adapted from the GLORYS reanalysis product. Therefore the next logical step in understanding this issue would be to investigate the GLORYS data. But even if there were issues in the GLORYS product, which I doubt, it would not explain how the data layers here could have minimum values being reported as greater than the maximum values in the distribution. The only thing that makes any sense is that the data layers are created independently of each other. But why?

Without being able to see the pipeline code myself all I can do is ponder, which isn’t terribly useful. So to wrap things up I’ll provide two tables; the layers with no issues, and those with issues. I would strongly recommend against using any data layers that did not pass the tests in this analysis until the curators of the Bio-Oracle data address these issues in a future release/version.

Layers with no issues (fine for use): - All of the older BO layers appear fine - Carbon phytoplankton biomass absolute and long-term at all depths - Chlorophyll absolute and long-term at all depths for present day projections only - Dissolved oxygen absolute and long-term at all depths - Ice cover absolute and long-term - Ice thickness absolute and long-term for present day projections only - Iron absolute and long-term for all depths - Nitrate absolute and long-term for all depths - Phosphate absolute and long-term for all depths - Primary productivity absolute and long-term for all depths - Salinity absolute and long-term at all depths for present day projections only - Temperature absolute and long-term at all depths for present day projections only

Problem layers (do not use): - Chlorophyll future projections for absolutes and long-terms at all depths - Current velocity absolutes and long-terms for all depths and all present and future projections - Ice thickness absolute and long-term for future projections - Light at bottom absolute and long-term for all depths - Salinity absolute and long-term at all depths for future projections - Temperature absolute and long-term at all depths for future projections

Objective

Having been working in environmental science for several years now, entirely using R, I’ve come to greatly appreciate environmental data sources that are easy to access. If you are reading this text now however, that probably means that you, like me, have found that this often is not the case. The struggle to get data is real. But it shouldn’t be. Most data hosting organisations do want scientists to use their data and do make it freely available. But sometimes it feels like the path to access was designed by crab people, rather than normal topside humans. I recently needed to gather several new data products and in classic ‘cut your nose off to spite your face’ fashion I insisted on doing all of it directly through an R script that could be run in RStudio. Besides being stubborn, one of the main reasons I felt this was necessary is that I wanted these download scripts to be able to be run operationally via a cron job. I think I came out pretty successful in the end so wanted to share the code with the rest of the internet. Enjoy.

# Packages not available via CRAN
remotes::install_github("skgrange/threadr")
remotes::install_github("markpayneatwork/RCMEMS")

# The packages we will use
library(tidyverse) # A staple for most modern data management in R
library(RCurl) # For helping R to make sense of URLs for web hosted data
library(XML) # For reading the HTML tables created by RCurl
library(tidync) # For easily dealing with NetCDF data
library(doParallel) # For parallel processing
library(threadr) # For downloading from FTP sites that require user credentials
library(RCMEMS) # For subsetting CMEMS data before download

Downloading NOAA OISST

I’ve already written a post about how to download NOAA OISST data using the rerddap package which may be found here. That post talks about how to get subsets of NOAA data, which is useful for projects with a refined scope, but it is laboriously slow if one simply wants the full global product. It must also be noted that as of this writing (June 3rd, 2020) the new OISST v2.1 data were not yet available on the ERDDAP server even though the old v2 data have now been rendered unavailable. For the time being it is necessary to download the full global data and then subset down to one’s desired study area. The following section of this blog post will outline how to do that.

I need to stress that this is a very direct and unlimited method for accessing these data and I urge responsibility in only downloading as much data as are necessary. Please do not download the entire dataset just because you can.

# First we tell R where the data are on the interwebs
OISST_url_month <- "https://www.ncei.noaa.gov/data/sea-surface-temperature-optimum-interpolation/v2.1/access/avhrr/"

# Then we pull that into a happy format
  # There is a lot here so it takes ~1 minute
OISST_url_month_get <- getURL(OISST_url_month)

# Before we continue let's set a limit on the data we are going to download
  # NB: One should not simply download the entire dataset just because it is possible.
  # There should be a compelling reason for doing so.
start_date <- as.Date("2019-01-01")

# Now we strip away all of the unneeded stuff to get just the months of data that are available
OISST_months <- data.frame(months = readHTMLTable(OISST_url_month_get, skip.rows = 1:2)[[1]]$Name) %>% 
  mutate(months = lubridate::as_date(str_replace(as.character(months), "/", "01"))) %>% 
  filter(months >= max(lubridate::floor_date(start_date, unit = "month"))) %>% # Filtering out months before Jan 2019
  mutate(months = gsub("-", "", substr(months, 1, 7))) %>% 
  na.omit()

# Up next we need to now find the URLs for each individual day of data
# To do this we will wrap the following chunk of code into a function so we can loop it more easily
OISST_url_daily <- function(target_month){
  OISST_url <- paste0(OISST_url_month, target_month,"/")
  OISST_url_get <- getURL(OISST_url)
  OISST_table <- data.frame(files = readHTMLTable(OISST_url_get, skip.rows = 1:2)[[1]]$Name) %>% 
    mutate(files = as.character(files)) %>% 
    filter(grepl("avhrr", files)) %>% 
    mutate(t = lubridate::as_date(sapply(strsplit(files, "[.]"), "[[", 2)),
           full_name = paste0(OISST_url, files))
  return(OISST_table)
}

# Here we collect the URLs for every day of data available from 2019 onwards
OISST_filenames <- plyr::ldply(OISST_months$months, .fun = OISST_url_daily)

# Just to keep things tidy in this vignette I am now going to limit this data collection even further
OISST_filenames <- OISST_filenames %>% 
  filter(t <= "2019-01-31")

# This function will go about downloading each day of data as a NetCDF file
# We will run this via plyr to expedite the process
# Note that this will download files into a 'data/OISST' folder in the root directory
# If this folder does not exist it will create it
# This function will also check if the file has been previously downloaded
OISST_url_daily_dl <- function(target_URL){
  dir.create("~/data/OISST", showWarnings = F)
  file_name <- paste0("~/data/OISST/",sapply(strsplit(target_URL, split = "/"), "[[", 10))
  if(!file.exists(file_name)) download.file(url = target_URL, method = "libcurl", destfile = file_name)
}

# The way this code has been written it may be run on multiple cores
# Most modern laptops have at least 4 cores, so we will utilise 3 of them here
# One should always leave at least 1 core free
doParallel::registerDoParallel(cores = 3)

# And with that we are clear for take off
system.time(plyr::ldply(OISST_filenames$full_name, .fun = OISST_url_daily_dl, .parallel = T)) # ~15 seconds

# In roughly 15 seconds a user may have a full month of global data downloaded
# This scales well into years and decades, too

Because it is not currently possible to download subsetted OISST data from a GRIDDAP server I find that it is useful to include here the code one would use to load and subset downloaded OISST data. Please note that the OISST data have longitude values from 0 to 360, not -180 to 180.

# This function will load and subset daily data into one data.frame
# Note that the subsetting of lon/lat is done before the data are loaded
# This means it will use much less RAM and is viable for use on most laptops
# Assuming one's study area is not too large
OISST_load <- function(file_name, lon1, lon2, lat1, lat2){
      OISST_dat <- tidync(file_name) %>%
        hyper_filter(lon = between(lon, lon1, lon2),
                     lat = between(lat, lat1, lat2)) %>% 
        hyper_tibble() %>% 
        select(lon, lat, time, sst) %>% 
        dplyr::rename(t = time, temp = sst) %>% 
        mutate(t = as.Date(t, origin = "1978-01-01"))
      return(OISST_dat)
}

# Locate the files that will be loaded
OISST_files <- dir("~/data/OISST", full.names = T)

# Load the data in parallel
OISST_dat <- plyr::ldply(.data = OISST_files, .fun = OISST_load, .parallel = T,
                         lon1 = 260, lon2 = 280, lat1 = 30, lat2 = 50)

# This should only take a few seconds to run at most

Downloading CCI

An up-and-coming star in the world of remotely sensed data products, the Climate Change Initiative (CCI) has recently been putting out some industry leading products. These are all freely available for access and use for scientific research purposes. These have quickly become regarded as the most accurate products available and their use is now encouraged over other products. Unfortunately they are not available in near-real-time and so can currently only be used for historic analyses. A recent update of these data for 2017 and 2018 was made available and one assumes that 2019 will follow suit some time by the end of 2020.

# The URLs where the data are housed for direct download
  # NB: Note that the versions are different; v2.1 vs. v2.0
  # NB: It looks like going straight through the thredds server is a more stable option
CCI_URL_old <- "http://dap.ceda.ac.uk/thredds/fileServer/neodc/esacci/sst/data/CDR_v2/Analysis/L4/v2.1"
CCI_URL_new <- "http://dap.ceda.ac.uk/thredds/fileServer/neodc/c3s_sst/data/ICDR_v2/Analysis/L4/v2.0"

# The date ranges that are housed therein
  # NB: These are historic repos and therefore the dates are static
  # I assume that the 'new' data will be updated through 2019 by the end of 2020
date_range_old <- seq(as.Date("1981-09-01"), as.Date("2016-12-31"), by = "day")
date_range_new <- seq(as.Date("2017-01-01"), as.Date("2018-12-31"), by = "day")

# The function we will use to download the data
download_CCI <- function(date_choice, CCI_URL){
  
  # Prep the necessary URL pieces
  date_slash <- str_replace_all(date_choice, "-", "/")
  date_nogap <- str_replace_all(date_choice, "-", "")
  
  if(str_detect(CCI_URL, "esacci")){
    tail_chunk <- "120000-ESACCI-L4_GHRSST-SSTdepth-OSTIA-GLOB_CDR2.1-v02.0-fv01.0.nc"
  } else if(str_detect(CCI_URL, "c3s_sst")){
    tail_chunk <- "120000-C3S-L4_GHRSST-SSTdepth-OSTIA-GLOB_ICDR2.0-v02.0-fv01.0.nc"
  } else{
    stop("The URL structure has changed.")
  }
  
  complete_URL <- paste0(CCI_URL,"/",date_slash,"/",date_nogap,tail_chunk)
  # Note that this will download the files to data/CCI in the root directory
  file_name <- paste0("~/data/CCI/",date_nogap,tail_chunk)
  
  # Download and save the file if needed
  if(file.exists(file_name)){
    return()
  } else{
    download.file(url = complete_URL, method = "libcurl", destfile = file_name)
  }
  Sys.sleep(2) # Give the server a quick breather
}

# Run in parallel
# Most laptops have 4 cores, so 3 is a good choice
doParallel::registerDoParallel(cores = 3)

# Download all old data: 1981-09-01 to 2016-12-31
  # NB: Note the '[1:3]' below. This limits the downloads to only the first three files
  # Delete that to download everything.
  # But please do not download ALL of the files unless there is a need to do so.
plyr::l_ply(date_range_old[1:3], .fun = download_CCI, CCI_URL = CCI_URL_old, .parallel = T)

# Download all new data: 2016-01-01 to 2018-12-31
plyr::l_ply(date_range_new[1:3], .fun = download_CCI, CCI_URL = CCI_URL_new, .parallel = T)

Downloading OSTIA

As noted above, CCI data products are quickly becoming the preferred standard. Unfortunately they are not available in near-real-time. This is where OSTIA data come in to fill the gap. Though not exactly the same assimilation process as CCI, these products come from the same suite of data sources. I do not yet know if these data for 2019 onwards can be used in combination with a climatology created from the CCI data, but it is on my to do list to find out. In order to download these data one will need to have a CMEMS account. This is free for researchers and very fast to sign up for. Once one has received a user name and password it is possible to use the code below to download the data via their FTP server. No Python required!

# The URL where the data are housed for FTP
OSTIA_URL <- "ftp://nrt.cmems-du.eu/Core/SST_GLO_SST_L4_NRT_OBSERVATIONS_010_001/METOFFICE-GLO-SST-L4-NRT-OBS-SST-V2"

# The date ranges that are housed therein
# NB: These are historic repos and therefore the dates are static
# I assume that the 'new' data will be updated through 2019 by the end of 2020
date_range <- seq(as.Date("2019-01-01"), as.Date("2019-01-03"), by = "day")

# Enter ones credentials here
# Note that the ':'  between 'username' and 'password' is required
user_credentials <- "username:password"

# Download function 
download_OSTIA <- function(date_choice, user_credentials){
  
  # Prep the necessary URL pieces
  date_slash <- strtrim(str_replace_all(date_choice, "-", "/"), width = 7)
  date_nogap_day <- str_replace_all(date_choice, "-", "")
  
  tail_chunk <- "120000-UKMO-L4_GHRSST-SSTfnd-OSTIA-GLOB-v02.0-fv02.0.nc"

  complete_URL <- paste0(OSTIA_URL,"/",date_slash,"/",date_nogap_day,tail_chunk)
  file_name <- paste0("~/data/OSTIA/",date_nogap_day,tail_chunk)
  
  # Download and save the file if needed
  if(file.exists(file_name)){
    return()
  } else{
    download_ftp_file(complete_URL, file_name, verbose = TRUE, credentials = user_credentials)
  }
  Sys.sleep(2) # Give the server a quick breather
}

# Run in parallel
doParallel::registerDoParallel(cores = 3)

# Download data from 2019-01-01 to present day
  # NB: Some files won't download when run in parallel
  # I think the FTP server may be more aware of multiple requests than an HTTPS server
  # It may also have been due to high server use at the time, too
plyr::l_ply(date_range, .fun = download_OSTIA, .parallel = T, 
            user_credentials = user_credentials)

Downloading GLORYS

At this point one may be thinking “wait a second, these have all been SST only products, this isn’t really a post about environmental data!”. But that’s where GLORYS comes in. This product has a range of variables one may be interested in. Not just SST. But yes, they are all physical variables. No bio-geochemistry in sight. Bamboozled! But if you’ve read this far, why stop now?! These data require a CMEMS account, same as the OSTIA data. They can also be downloaded via direct FTP access, but these files are enormous so in almost every use case this is not what one is intending to do. Rather these data are almost always subsetted in some way first. Luckily CMEMS has made this available to their user base with the introduction of the MOTU client. Unluckily they have only made this available for use in Python. I have asked the people behind this process in person if there are plans for an officially supported R version and the short and long answers were no. That’s where Mark Payne and his RCMEMS package enter the picture. He has wrapped the MOTU client for Python up in a handy R package that allows us to access, subset, and download CMEMS data all through the comfort of the RStudio interface! There is a tutorial on the GitHub repo that walks through the process that I show below if one would like an additional look at this process.

# Non-R software
# Unfortunately the subsetting of CMEMS data will require that one has Python installed
# https://www.python.org/downloads/
# Then one must download
# https://github.com/clstoulouse/motu-client-python/releases
# For instructions on how and why to properly install please see:
# https://github.com/markpayneatwork/RCMEMS

# Here is a cunning method of generating a brick of year-month values
date_range <- base::expand.grid(1993:2018, 1:12) %>% 
  dplyr::rename(year = Var1, month = Var2) %>% 
  arrange(year, month) %>% 
  mutate(year_mon = paste0(year,"-",month)) %>% 
  dplyr::select(year_mon)

# Download function
  # NB: This function is currently designed to subset data to a specific domain
  # Please change your lon/lat accordingly
  # NB: This function will save files to data/GLORYS in the root directory
  # To change this change the --out-dir argument near the end of the chunk of text
  # NB: This big text chunk needs to be left as one long line
  # NB: The --user and --pwd arguments need to be given the users real username and passwords
  # from their CMEMS account
download_GLORYS <- function(date_choice){
  
  # The GLORYS script
    # This is a dummy script first generated by using the UI on the CMEMS website
    # No need to change anything here except for the --user and --pwd at the end
    # Please place your CMEMS username and password in those fields
  GLORYS_script <- 'python ~/motuclient-python/motuclient.py --motu http://my.cmems-du.eu/motu-web/Motu --service-id GLOBAL_REANALYSIS_PHY_001_030-TDS --product-id global-reanalysis-phy-001-030-daily --longitude-min -180 --longitude-max 179.9166717529297 --latitude-min -80 --latitude-max 90 --date-min "2018-12-25 12:00:00" --date-max "2018-12-25 12:00:00" --depth-min 0.493 --depth-max 0.4942 --variable thetao --variable bottomT --variable so --variable zos --variable uo --variable vo --variable mlotst --variable siconc --variable sithick --variable usi --variable vsi --out-dir data --out-name test.nc --user username --pwd password'
  
  # Prep the necessary URL pieces
  date_start <- parse_date(date_choice, format = "%Y-%m")
  # A clever way of finding the end date of any month!
    # I found this on stackoverflow somewhere...
  date_end <- date_start %m+% months(1) - 1
  
  # Cannot get data past 2018-12-25
  if(date_end > as.Date("2018-12-25")) date_end <- as.Date("2018-12-25")
  
  # Set the file name
  file_name <- paste0("GLORYS_",date_choice,".nc")
  
  # Take the chunk of code above and turn it into something useful
  cfg <- parse.CMEMS.script(GLORYS_script, parse.user = T)
  
  # This is where one should make any required changes to the subsetting of the data
  # This is now the magic of the RCMEMS package, which allows us to interface with the Python code as though it were R
  cfg_update <- RCMEMS::update(cfg, variable = "thetao --variable bottomT --variable so --variable zos --variable uo --variable vo --variable mlotst --variable siconc --variable sithick --variable usi --variable vsi",
                               longitude.min = "-80.5",
                               longitude.max = "-40.5",
                               latitude.min = "31.5",
                               latitude.max = "63.5",
                               date.min = as.character(date_start),
                               date.max = as.character(date_end),
                               out.name = file_name)
  
  # Download and save the file if needed
  if(file.exists(paste0("~/data/GLORYS/",file_name))){
    return()
  } else{
    CMEMS.download(cfg_update)
  }
  Sys.sleep(2) # Give the server a quick breather
}

# I've limited the download to only 1 file
# Delete '[1]' to download everything
  #NB: The CMEMS server is a little wonky, rather not try to multicore this
plyr::l_ply(date_range$year_mon[1], .fun = download_GLORYS, .parallel = F)

Conclusion

I hope this has been a useful whack of data for anyone looking to download any of these products for their science. The techniques laid out in the code here should apply to most other data products as well as there aren’t that many different methods of hosting data. If I’ve missed anything that people feel is an important data source that can’t be adapted from the code here let me know and I’m happy to see what I can do.

Objective

In South Africa there are a range of idioms for different time frames in which someone may (or may not) do something. The most common of these are: ‘now’, ‘just now’, and ‘now now’. If one were to Google these sayings one would find that there is general agreements on how long these time frames are, but that agreement is not absolute.

This got me to wondering just how much disagreement there may be around the country. And more specifically I wanted to know how these times changed between specific locations. If one is interested in contributing to the survey, it may be taken here. To avoid too much confusion with the answers that could be given, specific times were provided to the participants in a multiple choice format. These times (minutes) were: 5, 15, 30, 60, 120, 300.

Data prep

The survey data are downloaded from Google Forms rather easily as a .csv file, so that’s nice. Unfortunately, the way in which one sets up the survey for humans is difficult for R to understand so we need quite a bit of processing after we load the data.

library(tidyverse)
library(ggpubr)
library(broom)

survey <- read_csv("../../static/data/SA Time Survey.csv", skip = 1, col_types = "cccccc",
                   col_names = c("time", "just now", "now now", "now", "province", "city")) %>% 
  select(-time) %>%
  mutate(`just now` = as.numeric(sapply(strsplit(`just now`, " "), "[[", 1)),
         `now now` = as.numeric(sapply(strsplit(`now now`, " "), "[[", 1)),
         `now` = as.numeric(sapply(strsplit(`now`, " "), "[[", 1)),
         province = gsub("Kzn", "KZN", province),
         province = gsub("GP", "Gauteng", province),
         province = as.factor(province),
         city = as.factor(city))

# Check that city and province names are all lekker
# levels(survey$province)
# levels(survey$city)

# Create a long version for easier stats
survey_long <- survey %>% 
  gather(key = "saying", value = "minutes", -province, -city) %>% 
  na.omit()

Participant locations

With our data prepared, I first wanted to see from where the surveys were taken. I’ve done this by splitting them up into province or city. This is also one of the few situations in which a bar plot is an appropriate visualisation. The columns below that show ‘NA’ are for participants that declined to share their location.

province_plot <- ggplot(data = survey, aes(x = province)) +
  geom_bar(aes(fill = province), show.legend = F) +
  ggtitle("Provinces of participants") +
  labs(x = "")
# province_plot
city_plot <- ggplot(data = survey, aes(x = city)) +
  geom_bar(aes(fill = city), show.legend = F) +
  ggtitle("Cities of participants") +
  labs(x = "") +
  theme(axis.text.x = element_text(angle = 15))
# city_plot
ggarrange(province_plot, city_plot, ncol = 1, nrow = 2)

Participant time frames

With the locations of of our participants visualised we now want to see what sort of time frames people around the country attribute to the three most common idioms.

ggplot(data = survey_long, aes(x = saying, y = minutes, fill = saying)) +
  geom_boxplot(show.legend = FALSE, outlier.colour = NA) +
  geom_jitter(shape = 21, alpha = 0.6, width = 0.3, height = 0.0, show.legend = FALSE) +
  scale_y_continuous(breaks = c(5, 15, 30, 60, 120, 300)) +
  scale_fill_brewer(palette = "Accent") +
  labs(x = "")

As we may see in Figure @ref(fig:basic-plot), ‘just now’ and ‘now now’ appear to have similar distributions, whereas ‘now’ is markedly different. Participants answered the maximum score of 300 minutes for all idioms, but for ‘just now’ and ‘now now’ this was infrequent enough that the large scores are considered to be outliers. For ‘now’, enough participants answered with longer times that the distribution appears much larger than for the other two idioms. Even though these distributions appear different, let’s run the stats on them to make sure. Because we want to compare distributions of scores for three different categories we will be using an ANOVA if the data meet a few basic assumptions.

Just as a quick recap, these assumptions are: homoscedasticity (homogeneity of variance), normality of distribution, random & independently sampled. It is also a good idea to have at least a sample size of ten for each category. Seeing as how this was an Internet survey, we were not able to ensure that the participants are a random representation of the South African populace, nor can we be certain that they submitted their answers independent of one another. I am however just going to go ahead and assume that they did. As for the assumptions of homoscedasticity and the normality of the distributions, we can directly test these. In R, the normality of a distribution is tested with shapiro.test(). Any non-significant result (p > 0.05) means that the data are normally distributed. To test for homoscedasticity we will use bartlett.test(). A non-significant result (p > 0.05) from this test indicates that the variances between the categories are equivalent.

# test for normality
survey_long %>% 
  group_by(saying) %>% 
  summarise(noramlity = as.numeric(shapiro.test(minutes)[1]))

# A tibble: 3 × 2
  saying   noramlity
  <chr>        <dbl>
1 just now     0.565
2 now          0.713
3 now now      0.671

# Test for homoscedasticity
survey_long %>% 
  bartlett.test(minutes ~ saying, data = .)

    Bartlett test of homogeneity of variances

data:  minutes by saying
Bartlett's K-squared = 5.227, df = 2, p-value = 0.07328

Surprisingly these data meet all of our assumptions so we may perform a simple one-way ANOVA on them to detect any significant differences.

glance(aov(minutes ~ saying, data = survey_long))

# A tibble: 1 × 6
  logLik   AIC   BIC deviance  nobs r.squared
   <dbl> <dbl> <dbl>    <dbl> <int>     <dbl>
1  -670. 1349. 1360. 1143843.   111    0.0615

Less surprisingly, there is a significant difference in the times given for these three idioms. But let’s dive just a bit deeper with a post-hoc Tukey (not Turkey) test to see which categories specifically are different from which.

TukeyHSD(aov(minutes ~ saying, data = survey_long))

  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = minutes ~ saying, data = survey_long)

$saying
                      diff         lwr       upr     p adj
now-just now      60.81081    3.949653 117.67197 0.0330869
now now-just now  14.18919  -42.671969  71.05035 0.8241544
now now-now      -46.62162 -103.482779  10.23954 0.1302148

Looking at the names given in the ‘saying’ column, and the values given in the ‘p adj’ column we may see which individual idioms are different from which. Unsurprisingly, judging from Figure @ref(fig:basic-plot), ‘now now’ and ‘just now’ are not different. Interesting though is that ‘now’ is significantly different from ‘just now’, but not ‘now now’. The initial results made it look as though ‘now’ would have been significantly different from both.

Province time frames

Preferably, many more people would have taken the survey so that we could draw more conclusive results. I’m rather certain that should more people take the survey the distributions of the scores for the three idioms would even out more until there were no significant differences between any of them. Enough participants have taken the test however that we may compare the results for a few different provinces.

# Remove provinces with fewer than nine entries
# Ten would be preferable, but at nine we allow the inclusion of KZN
survey_province <- survey_long %>% 
  group_by(province) %>% 
  filter(n() >= 9) %>% 
  ungroup()

And now with the provinces that have only a few answers filtered out, let’s see what the data look like as boxplots.

ggplot(data = survey_province, aes(x = saying, y = minutes, fill = province)) +
  geom_boxplot(outlier.colour = NA) +
  geom_point(shape = 21, position = position_jitterdodge()) +
  scale_y_continuous(breaks = c(5, 15, 30, 60, 120, 300)) +
  scale_fill_brewer(palette = "Set2") +
  labs(x = "")

Right away for me it appears that the time frames for the Eastern Cape are shorter than for the other three provinces. KZN appears to be the longest, with Gauteng and the Western Cape seeming similar. Because we have multiple independent variables (saying and province) we want a two-way ANOVA. But before we do that, let’s again check for normality and homoscedasticity.

# test for normality
survey_province %>% 
  group_by(saying, province) %>% 
  summarise(normality = as.numeric(shapiro.test(minutes)[1]))

# A tibble: 12 × 3
# Groups:   saying [3]
   saying   province     normality
   <chr>    <fct>            <dbl>
 1 just now Eastern Cape     0.640
 2 just now Gauteng          0.867
 3 just now KZN              0.865
 4 just now Western Cape     0.537
 5 now      Eastern Cape     0.766
 6 now      Gauteng          0.721
 7 now      KZN              0.75 
 8 now      Western Cape     0.729
 9 now now  Eastern Cape     0.684
10 now now  Gauteng          0.689
11 now now  KZN              0.813
12 now now  Western Cape     0.718

# Test for homoscedasticity
survey_province %>% 
  bartlett.test(minutes ~ interaction(saying, province), data = .)

    Bartlett test of homogeneity of variances

data:  minutes by interaction(saying, province)
Bartlett's K-squared = 69.523, df = 11, p-value = 1.505e-10

The different groups of time are all normally distributed, but the variances differ. Regardless, we are going to stick to a normal two-way ANOVA as there are no good alternatives to this for non-parametric data and transforming these data is a bother.

glance(aov(minutes ~ saying + province, data = survey_province))

# A tibble: 1 × 6
  logLik   AIC   BIC deviance  nobs r.squared
   <dbl> <dbl> <dbl>    <dbl> <int>     <dbl>
1  -623. 1261. 1279.  881685.   105     0.204

Significant differences are to be had here. So let’s break it down and see which groups specifically differ.

TukeyHSD(aov(minutes ~ saying + province, data = survey_province))

  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = minutes ~ saying + province, data = survey_province)

$saying
                      diff        lwr        upr     p adj
now-just now      70.14286   16.46427 123.821448 0.0068600
now now-just now  15.42857  -38.25002  69.107162 0.7734013
now now-now      -54.71429 -108.39288  -1.035695 0.0447008

$province
                                diff         lwr       upr     p adj
Gauteng-Eastern Cape       63.452381  -15.761193 142.66595 0.1624466
KZN-Eastern Cape          139.722222   39.043527 240.40092 0.0025348
Western Cape-Eastern Cape  73.289474    6.613379 139.96557 0.0252743
KZN-Gauteng                76.269841  -21.982505 174.52219 0.1845631
Western Cape-Gauteng        9.837093  -53.115472  72.78966 0.9768852
Western Cape-KZN          -66.432749 -154.888584  22.02309 0.2092492

We may see that by removing some of the answers from the less represented provinces there is now a significant difference between the scores for ‘now’ and ‘now now’ as well as ‘just now’. Additionally we may see that the scores for Eastern Cape differ significantly from KZN and the Western Cape. One could also look at the interactions between the two independent variables but I’m not quite interested in that level of depth here.

City time frames

With the breakdown for the province time frames out of the way, we are going to wrap up this analysis by looking at the difference between cities.

# Remove provinces with fewer than five entries
# Ten is preferable, but at five we may include Mthatha
survey_city <- survey_long %>% 
  group_by(saying, city) %>% 
  filter(n() >= 5) %>% 
  ungroup()

ggplot(data = survey_city, aes(x = saying, y = minutes, fill = city)) +
  geom_boxplot(outlier.colour = NA) +
  geom_point(shape = 21, position = position_jitterdodge()) +
  scale_y_continuous(breaks = c(5, 15, 30, 60, 120, 300)) +
  scale_fill_brewer(palette = "Set3") +
  labs(x = "")

Again with the assumptions…

# test for normality
survey_city %>% 
  group_by(saying, city) %>% 
  summarise(normality = as.numeric(shapiro.test(minutes)[1]))

# A tibble: 9 × 3
# Groups:   saying [3]
  saying   city         normality
  <chr>    <fct>            <dbl>
1 just now Cape Town        0.577
2 just now Johannesburg     0.912
3 just now Mthatha          0.552
4 now      Cape Town        0.739
5 now      Johannesburg     0.757
6 now      Mthatha          0.754
7 now now  Cape Town        0.739
8 now now  Johannesburg     0.741
9 now now  Mthatha          0.552

# Test for homoscedasticity
survey_city %>% 
  bartlett.test(minutes ~ interaction(saying, city), data = .)

    Bartlett test of homogeneity of variances

data:  minutes by interaction(saying, city)
Bartlett's K-squared = 55.177, df = 8, p-value = 4.078e-09

… and again we see that while normally distributed, the variance of our sample sets differ significantly from one another. Regardless, we’ll stick to the two-way ANOVA.

glance(aov(minutes ~ saying + city, data = survey_city))

# A tibble: 1 × 6
  logLik   AIC   BIC deviance  nobs r.squared
   <dbl> <dbl> <dbl>    <dbl> <int>     <dbl>
1  -481.  973.  987.  674933.    81     0.205

As one likely would have deduced from Figure @ref(fig:city-plot), the scores are significantly different from one another.

TukeyHSD(aov(minutes ~ saying + city, data = survey_city))

  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = minutes ~ saying + city, data = survey_city)

$saying
                      diff        lwr         upr     p adj
now-just now      77.96296   16.65151 139.2744119 0.0090081
now now-just now  16.85185  -44.45960  78.1633008 0.7889537
now now-now      -61.11111 -122.42256   0.2003379 0.0509401

$city
                            diff        lwr        upr     p adj
Johannesburg-Cape Town -10.72917  -72.99124  51.532904 0.9108240
Mthatha-Cape Town      -84.89583 -151.53238 -18.259285 0.0088590
Mthatha-Johannesburg   -74.16667 -152.92265   4.589316 0.0691761

From the post-hoc test we may see that ‘now’ differs significantly from ‘just now in these three cities, and if we’re feeling generous we may say that ’now’ also differs significantly from ‘now now’. But like with the rest of the country, ‘now now’ and ‘just now’ are not significantly different time frames. Looking at the city breakdown we see that the only significant difference is between Mthatha and Cape Town. Johannesburg and Cape Town do not differ.

Conclusion

The general conclusion I’ve drawn from the analysis of the South Africa time survey results is that the understanding people in the Eastern Cape have of the time frames for these idioms is significantly faster than in the other major provinces in South Africa. The numbers don’t lie!

Speaking to people about this survey (before the results were out), the general consensus was that Johannesburg people would give significantly faster scores than people in other parts of the country, particularly Cape Town. That does not however appear to be the case. Also surprising from these results was that ‘now’ tended to be considered to be a significantly longer time frame than ‘just now’ and ‘now now’. Most people I’ve talked to about these idioms agree that ‘now’ is meant to be the fastest… so I’m not sure how that worked out. Unsurprising to me, but perhaps to some South Africans, was that there is no difference between ‘just now’ and ‘now now’. I was not surprised by this because talking with people around the country I very infrequently heard people, even while in the same room, agree on the time frames for these idioms.

There are of course a host of issues with this study. One thing I’m wondering about the Eastern Cape scores being significantly faster than the other provinces is if perhaps people in the Eastern Cape have a wider range of idioms for giving someone a time frame? Meaning, perhaps ‘now’, ‘just now’, and ‘now now’ are all much faster than other provinces because there is some other popular idiom people use there that denotes a longer time frame. It’s also possible that people in other provinces misunderstood the survey. Though I did make it very clear that the answers were in minutes and not seconds, specifically to attempt to prevent people from making that mistake. Lastly, this analysis suffers from a regrettably small sample size. I would have preferred at least 100 responses, rather than 40. It is still wonderful to be able to get some numbers in the game and get a glimpse of the fact that there is little agreement about these time frames.

Hopefully posting these results will snare a few more people into taking the survey and in another couple of months I can make a follow up post with the additional feedback.

Preface

This week I have expanded the coastR package with the inclusion of a function that calculates the angle of the heading for alongshore or shore-normal transects. The rest of this blog post is the vignette that I’ve written detailing the set of this function. Next week I’ll likely be taking a break from coastR development to finally create a package for the SACTN dataset. That is a project that has been in the works for a loooong time and it will be good to finally see a development release available to the public.

Overview

There are a number of reasons why one would want to calculate transects along or away from a coastline. Examples include: finding the fetch across an embayment, finding the coordinates of a point 200 km from the coast, finding the appropriate series of SST pixels along/away from the coast, (or if one is feeling particular feisty) the creation of shape files for a given area away from the coast. The function that we will be introducing here does none of these things. What the transects() function does do is calculate the angle of the heading along or away from the coast against true North, which is then the basis for all of the other fancy things one may want to do. Baby steps people. Baby steps.

# devtools::install_github("robwschlegel/coastR") # Install coastR
library(coastR)
library(dplyr)
library(ggplot2)
library(gridExtra)
library(geosphere)

Sample locations

For this vignette we will re-use the same coastlines as those created for the sequential sites vignette. The ordering of the sites remains jumbled up to demonstrate that transects() does not require orderly data. Should one want to order ones site list before calculating transect headings it is possible to do so with seq_sites(). This is of course a recommended step in any workflow.

# Cape Point, South Africa
cape_point <- SACTN_site_list %>% 
  slice(c(31, 22, 26, 17, 19, 21, 30)) %>% 
  mutate(order = 1:n())

# South Africa
south_africa <- SACTN_site_list %>% 
  slice(c(1,34, 10, 20, 50, 130, 90)) %>% 
  mutate(order = 1:n())

# Baja Peninsula, Mexico
baja_pen <- data.frame(
  order = 1:7,
  lon = c(-116.4435, -114.6800, -109.6574, -111.9503, -112.2537, -113.7918, -114.1881),
  lat = c(30.9639, 30.7431, 22.9685, 26.9003, 25.0391, 29.4619, 28.0929)
)

# Bohai Sea, China
bohai_sea <- data.frame(
  order = 1:7,
  lon = c(122.0963, 121.2723, 121.0687, 121.8742, 120.2962, 117.6650, 122.6380),
  lat = c(39.0807, 39.0086, 37.7842, 40.7793, 40.0691, 38.4572, 37.4494)
)

Transects

With our site lists created we now want to see what the correct headings for alongshore and shore-normal transects are for our sites. We will also demonstrate what happens when we increase the spread used in the calculation and also how the inclusion of island masks affects the angle of the headings.

# Cape Point, South Africa
cape_point_along <- transects(cape_point, alongshore = T)
cape_point_away <- transects(cape_point)

# South Africa
south_africa_along <- transects(south_africa, alongshore = T)
south_africa_away <- transects(south_africa)
  # NB: Note here the use of the `spread` argument
south_africa_along_wide <- transects(south_africa, alongshore = T, spread = 30)
south_africa_away_wide <- transects(south_africa, spread = 30)

# Baja Peninsula, Mexico
baja_pen_along <- transects(baja_pen, alongshore = T)
baja_pen_away <- transects(baja_pen)
  # NB: Note here the use of the `coast` argument
baja_pen_island <- transects(baja_pen, coast = FALSE)

# Bohai sea, China
bohai_sea_along <- transects(bohai_sea, alongshore = T)
bohai_sea_away <- transects(bohai_sea)

Visualise

Now that the correct headings have been calculated for our alongshore and shore-normal transects let’s visualise them with ggplot. First we will create a function that does this in order to keep the length of this vignette down.

# Create base map
world_map <- ggplot() + 
  borders(fill = "grey40", colour = "black")

# Create titles
titles <- c("Alongshore", "Shore-normal", "Islands")

# Plotting function
plot_sites <- function(site_list, buffer, title_choice, dist){
  
  # Find the point 200 km from the site manually to pass to ggplot
  heading2 <- data.frame(geosphere::destPoint(p = select(site_list, lon, lat),  
                                              b = site_list$heading, d = dist))
  
  # Add the new coordinates tot he site list
  site_list <- site_list %>% 
    mutate(lon_dest = heading2$lon,
           lat_dest = heading2$lat)
  
  # Visualise
  world_map +
    geom_segment(data = site_list, colour = "red4", 
                 aes(x = lon, y = lat, xend = lon_dest, yend = lat_dest)) +
    geom_point(data = site_list, size = 3, colour = "black", aes(x = lon, y = lat)) +
    geom_point(data = site_list, size = 3, colour = "red", aes(x = lon_dest, y = lat_dest)) +
    coord_cartesian(xlim = c(min(site_list$lon - buffer), 
                             max(site_list$lon + buffer)),
                    ylim = c(min(site_list$lat - buffer), 
                             max(site_list$lat + buffer))) +
    labs(x = "", y = "", colour = "Site\norder") +
    ggtitle(titles[title_choice])
}

cape_point_along_map <- plot_sites(cape_point_along, 0.5, 1, 10000)
cape_point_away_map <- plot_sites(cape_point_away, 0.5, 2, 10000)
grid.arrange(cape_point_along_map, cape_point_away_map, nrow = 1)

south_africa_along_map <- plot_sites(south_africa_along, 1, 1, 100000)
south_africa_away_map <- plot_sites(south_africa_away, 1, 2, 100000)
south_africa_along_wide_map <- plot_sites(south_africa_along_wide, 1, 1, 100000)
south_africa_away_wide_map <- plot_sites(south_africa_away_wide, 1, 2, 100000)
grid.arrange(south_africa_along_map, south_africa_away_map, 
             south_africa_along_wide_map, south_africa_away_wide_map, nrow = 2)

baja_pen_along_map <- plot_sites(baja_pen_along, 1, 1, 100000)
baja_pen_away_map <- plot_sites(baja_pen_away, 1, 2, 100000)
baja_pen_island_map <- plot_sites(baja_pen_island, 1, 3, 100000)
grid.arrange(baja_pen_along_map, baja_pen_away_map, baja_pen_island_map, nrow = 1)

bohai_sea_along_map <- plot_sites(bohai_sea_along, 1, 1, 70000)
bohai_sea_away_map <- plot_sites(bohai_sea_away, 1, 2, 70000)
grid.arrange(bohai_sea_along_map, bohai_sea_away_map, nrow = 1)

Conclusion

As we may see in the previous example figures, the transect() function tends to work better by default at smaller scales. This was an intentional decision as it is much more accurate when scaling the function up for larger coastal features than when scaling it down for smaller ones.

The calculation of the heading for alongshore and shore-normal transects is rarely the end goal itself. One then generally wants to find specific points from the coastline along the transects that have been determined. This is done in the code above within the plot_sites() function created within this vignette, but the process is not detailed specifically. How to do more elaborate things with transects will be explained with the following functions to be added to coastR. This will include how to draw coastal polygons based on distance and bathymetry.

Objective

Whilst cruising about on Imgur I found a post about science stuff. Not uncommon, which is nice. These sorts of grab-bag posts about nothing in particular often include some mention of climate science, almost exclusively some sort of clever visualisation of a warming planet. That seems to be what people are most interested in. I’m not complaining though, it keeps me employed. The aforementioned post caught my attention more than usual because it included a GIF, and not just a static picture of some sort of blue thing that is becoming alarmingly red (that was not meant to be a political metaphor). I’m referring to the now famous GIF by climate scientist Ed Hawkins (@ed_hawkins) whose blog may be found here, and the specific post in question here. A quick bit of research on this animation revealed that it has likely been viewed by millions of people, was featured in the opening ceremony of the Rio Olympics, and was created in MATLAB. Those three key points made me decide to do a post on how to re-create this exact figure in R via a bit of reverse engineering. The original GIF in question is below.

Figure 1: The ever broadening spiral of global temperatures created by Ed Hawkins.

Data

Figure 1 above uses the global mean temperature anomalies taken from HadCRUT4. These data have an impressive range of collection, going back to 1850. Very few datasets match this length of collection, and I’m not going to attempt to do so here. What I am going to do is use the data that I work with on a daily basis. These are the SACTN data that may also be downloaded here via a GUI. As a coastal oceanographer I am mostly interested in changing climates in the near shore. While not publish explicitly, a paper about the appropriate methodology one should use does exist, and this methodology has been applied to all of the time series in the SACTN dataset accordingly. It is therefore known what the rates of decadal change along the coast of South Africa are, and we may rely on this in order to cherry pick the more dramatic time series in order to make prettier visuals.

Code

With our end goal established (Figure 1), and our dataset chosen (SACTN), we may now get busy with the actual code necessary. As one may have inferred from the title of this post, Figure 1 is what we call a “polar plot”. This may appear complex to some, but is actually a very simple visualisation, as we shall see below. But first we need to prep our data. For consistency in the creation of the anomaly values below I will use 1981 – 2010 for the climatology of each time series.

## Libraries
library(tidyverse)
library(viridis)
library(lubridate)
library(zoo)
library(gridExtra)
library(animation)

## Data
# SACTN
load("../../static/data/SACTN_monthly_v4.2.RData")

## Subset
# Subseting function
ts.sub <- function(site){
  ts <- SACTN_monthly_v4.2 %>% 
    filter(index == site) %>%
    mutate(year = year(as.yearmon(date)),
           month = month(as.yearmon(date), label = T),
           clim = mean(temp[year %in% seq(1981,2010)], na.rm = T),
           anom = temp-clim,
           index = as.character(index)) %>%
    rename(site = index) %>% 
    select(site, year, month, anom)
  return(ts)
}

# Warming site
PN <- ts.sub("Port Nolloth/SAWS")

# Cooling site
SP <- ts.sub("Sea Point/SAWS")

# Neutral site
KB <- ts.sub("Kent Bay/KZNSB")

With our data prepared we may now create the series of functions that will make a spiralling polar plot of temperatures for any time series we feed into it. I prefer to use the animation package to create animations in R. This requires that one also installs image magick beforehand. This is a free software that is available for all major operating systems. There are a few ways to create animations in R, but I won’t go into that now. The method I employ to create the animations below may seem odd at first, but as far as I have seen it is the most efficient way to do so. The philosophy employed here is that we want to have one final function that simply counts forward one step at a time, creating each frame of the GIF. This function calls on other functions that are calculating the necessary stats and creating the visuals from them in the background. By creating animations in this way, our up front prep and calculation time is almost non-existent. It does mean that the animations take longer to compile, but they are also much more dynamic and we may feed any number of different dataframes into them to get different outputs. I have found over the years that the more automated ones code can be the better.

## Function that creates a polar plot
polar.plot <- function(df, i){
  # Add bridges for polar coordinates
  years <- unique(df$year)[1:i]
  df2 <- filter(df, year %in% years)
  bridges <- df2[df2$month == 'Jan',]
  bridges$year <- bridges$year - 1
  if(nrow(bridges) == 0){
    bridges <- data.frame(site = df2$site[1], year = min(df2$year), month = NA, anom = NA)
  } else {
    bridges$month <- NA
  }
  blanks <- data.frame(site = df2$site[1], expand.grid(year = min(df2$year)-1, month = month.abb), anom = NA)
  # Polar plot
  pp <- ggplot(data = rbind(blanks, df2, bridges), aes(x = month, y = anom, group = year)) +
    # Circular black background
    geom_rect(colour = "black", fill = "black", aes(xmin = "Jan", xmax = NA,
                  ymin = min(df$anom, na.rm = T), ymax = max(df$anom, na.rm = T))) +
                  # ymin = min(df$anom, na.rm = T), ymax = 3)) +
    # Anomaly threshold labels
    geom_hline(aes(yintercept = 1.0), colour = "red") +
    geom_label(aes(x = "Jan", y = 1.0, label = "1.0°C"),
               colour = "red", fill = "black", size = 3) +
    geom_hline(aes(yintercept = 2.0), colour = "red") +
    geom_label(aes(x = "Jan", y = 2.0, label = "2.0°C"),
               colour = "red", fill = "black", size = 3) +
    geom_hline(aes(yintercept = 3.0), colour = "red") +
    geom_label(aes(x = "Jan", y = 3.0, label = "3.0°C"),
               colour = "red", fill = "black", size = 3) +
    geom_hline(aes(yintercept = 4.0), colour = "red") +
    geom_label(aes(x = "Jan", y = 4.0, label = "4.0°C"),
               colour = "red", fill = "black", size = 3) +
    # Temperature spiral
    geom_path(aes(colour = anom), show.legend = F) +
    # Scale corrections
    scale_colour_viridis(limits = c(min(df$anom, na.rm = T), max(df$anom, na.rm = T))) +
    scale_x_discrete(expand = c(0,0), breaks = month.abb) +
    scale_y_continuous(expand = c(0,0),
                       limits = c(min(df$anom, na.rm = T), max(df$anom, na.rm = T))) +
    # Year label
    geom_text(aes(x = "Jan", y = min(df$anom, na.rm = T), label = max(df2$year, na.rm = T)),
              colour = "ivory", size = 8) +
    # Additional tweaks
    ggtitle(paste0(df$site[1]," temperature change (",min(df$year),"-",max(df$year),")")) +
    coord_polar() +
    theme(panel.background = element_rect(fill = "grey20"),
          plot.background = element_rect(fill = "grey20"),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          # axis.text.x = element_text(colour = "ivory"),
          axis.text.x = element_text(colour = "ivory", angle =
            (360/(2*pi)*rev(seq(pi/12, 2*pi-pi/12, len = 12)))+15,
            size = 12),
          axis.text.y = element_blank(),
          axis.title = element_blank(),
          axis.ticks = element_blank(),
          axis.ticks.length = unit(0, "cm"),
          plot.title = element_text(hjust = 0.5, colour = "ivory", size = 15))
  print(pp)
}

## Create animation of polar plots
animate.polar.plot <- function(df) {
  lapply(seq(1,length(unique(df$year))), function(i) {
    polar.plot(df = df, i = i)
  })
}

With the above two functions created, we may now call them nested within one another via the saveGIF function below.

# By default 'saveGIF()' outputs to the same folder 
# the script where the code is being run from is located.
# For that reason one may want to manually change the
# working directory beforehand.
# setwd("somewhere else")
system.time(saveGIF(animate.polar.plot(df = PN), interval = 0.4, ani.width = 457, 
                    movie.name = "polar_plot_PN.gif")) ## 262 seconds
system.time(saveGIF(animate.polar.plot(df = SP), interval = 0.4, ani.width = 457, 
                    movie.name = "polar_plot_SP.gif")) ## 221 seconds
system.time(saveGIF(animate.polar.plot(df = KB), interval = 0.4, ani.width = 457, 
                    movie.name = "polar_plot_KB.gif")) ## 183 seconds
# setwd("back to where you were")

Summary

As one may see in the following GIFs, local extremes often outpace global averages. This should not be terribly surprising. In order to better illustrate this I have expanded the anomaly labels along the y-axes more so than seen in Figure 1. The increasing patterns are not as clear in these following GIFs as in the original that they are based on. This is because the original is based on a global average, which provides for a much smoother trend. I hope people enjoy these and feel free to plop your own temperature time series into the code to create your own polar plot figures!

Figure 2: The polar plot for Port Nolloth, where temperatures have been increasing.

Figure 3: The polar plot for Sea Point, where temperatures have been decreasing.

Figure 4: The polar plot for Kent Bay, where temperatures have been holding level.

Preface

The rest of the blog post after this preface section is a copy of the vignette I’ve written for the first function in the new package I am developing: coastR. This package aims to provide functions that are useful for coastal oceanography but that do not yet exist in the R language. It is not my intention to provide algorithms for physical oceanography as these may already be found elsewhere. This post covers how one may determine the correct sequence of sites along a convoluted coastline.

Now that I’ve handed in my PhD I am a little less pressed as far as deadlines go and I would like to return to my habit of creating a new blog post every Friday. I’ve written quite a bit of code over the last three years and much of it needs to find it’s way into the coastR. Next week I am planning on uploading a function for calculating shore normal transects. Until then, please enjoy the spectacle of sequential ordering. Woo.

Overview

The human mind prefers to see patterns in whatever it encounters. To this end we try to provide ourselves with data that are stored in a way that will appeal to that disposition. For a time series this usually means that the data are saved sequentially through time. For spatial data this means that the data are saved in some sort of sequential state, too. But what might that be? For 2D, 3D, or 4D data this can get tricky rather quickly and one tends to default to netcdf files. But with 1D data we are able to decide how we want the data to be structured as they will fit within a simple dataframe. But how can spatial data be 1D? Nothing in nature truly is, but I use 1D here as an expedient way of describing data that are constrained to some physical (usually continuous) barrier. Specifically for use with seq_sites() we will be looking at sites along a coastline.

If one has meta-data for a number of sampling sites they should be saved in the order they may be found along the coastline. Some would perhaps prefer to order sites alphabetically, I am not one of them for a number of reasons. Not least of which being that this is too simple a way of organising. One could also choose to organise ones coastal sites in numerical order of either longitude or latitude. This quickly becomes problematic for most stretches of coastline as natural formations such as peninsulas and embayments will prevent the correct ordering of sites based on only latitude or longitude. It is therefore necessary to query the longitude and latitude of each site in a list against a land mask in order to determine the correct order along the coastline. This is what will be demonstrated below.

# devtools::install_github("robwschlegel/coastR") # Install coastR
library(coastR)
library(tidyverse)
library(gridExtra)

Sample locations

For the purpose of this vignette we will manually create a few dataframes for different coastlines around the world of varying degrees of complexity and length. The first two dataframes are taken from the SACTN site list included in the coastR package. The rest have their lon/lat values grabbed from Google maps. Note that the order of the sites is intentionally entered incorrectly so as to be able to demonstrate the efficacy of seq_sites().

# Cape Point, South Africa
cape_point <- SACTN_site_list %>% 
  slice(c(31, 22, 26, 17, 19, 21, 30)) %>% 
  mutate(order = 1:n())

# South Africa
south_africa <- SACTN_site_list %>% 
  slice(c(1,34, 10, 20, 50, 130, 90)) %>% 
  mutate(order = 1:n())

# Baja Peninsula, Mexico
baja_pen <- data.frame(
  order = 1:7,
  lon = c(-116.4435, -114.6800, -109.6574, -111.9503, -112.2537, -113.7918, -114.1881),
  lat = c(30.9639, 30.7431, 22.9685, 26.9003, 25.0391, 29.4619, 28.0929)
)

# Bohai Sea, China
bohai_sea <- data.frame(
  order = 1:7,
  lon = c(122.0963, 121.2723, 121.0687, 121.8742, 120.2962, 117.6650, 122.6380),
  lat = c(39.0807, 39.0086, 37.7842, 40.7793, 40.0691, 38.4572, 37.4494)
)

Sequential sites

Now that we have our sample sites it is time to order them correctly along the coast sequentially. Should one prefer the opposite order to what seq_sites() produces, this may be changed by using the reverse argument found within the function. Additionally, if one has sites located on islands just off the coast, one may choose to allow the algorithm to take these islands into account. Note that this then will force the algorithm to calculate the sequential order of these sites as though they were part of a different sequence because they will no longer be on the same 1D plain. Generally this would not be desirable and one would rather order sites on coastal islands in line with the rest of the coast. This is the default setting, but we may see how this changes with the Baja Peninsula site list.

# NB: This code will produce warnings
  # This is fine as it is stating that the
  # 'order' column has been re-written,
  # which is the intended result of this function.

# Cape Point, South Africa
cape_point_seq <- seq_sites(cape_point)

# South Africa
south_africa_seq <- seq_sites(south_africa)

# Baja Peninsula, Mexico
baja_pen_seq <- seq_sites(baja_pen)
baja_pen_island_seq <- seq_sites(baja_pen, coast = FALSE)

# Bohai sea, China
bohai_sea_seq <- seq_sites(bohai_sea)

Comparison

With the sites correctly ordered sequentially along the coast we may now compare the before and after products. To do so in a tidy way we will first create a function that plots our sites for us on a global map.

# Create base map
world_map <- ggplot() + 
  borders(fill = "grey40", colour = "black")

# Create titles
titles <- c("Deurmekaar", "Sequential", "Islands")

# Plotting function
plot_sites <- function(site_list, buffer, title_choice){
  world_map +
  geom_point(data = site_list, size = 6,
             aes(x = lon, y = lat, colour = as.factor(order))) +
  coord_cartesian(xlim = c(min(site_list$lon - buffer), 
                           max(site_list$lon + buffer)),
                  ylim = c(min(site_list$lat - buffer), 
                           max(site_list$lat + buffer))) +
  labs(x = "", y = "", colour = "Site\norder") +
  ggtitle(titles[title_choice])
}

cape_point_map <- plot_sites(cape_point, 0.5, 1)
cape_point_seq_map <- plot_sites(cape_point_seq, 0.5, 2)
grid.arrange(cape_point_map, cape_point_seq_map, nrow = 1)

south_africa_map <- plot_sites(south_africa, 1, 1)
south_africa_seq_map <- plot_sites(south_africa_seq, 1, 2)
grid.arrange(south_africa_map, south_africa_seq_map, nrow = 1)

baja_pen_map <- plot_sites(baja_pen, 1, 1)
baja_pen_seq_map <- plot_sites(baja_pen_seq, 1, 2)
baja_pen_island_seq_map <- plot_sites(baja_pen_island_seq, 1, 3)
grid.arrange(baja_pen_map, baja_pen_seq_map, baja_pen_island_seq_map, nrow = 1)

bohai_sea_map <- plot_sites(bohai_sea, 1, 1)
bohai_sea_seq_map <- plot_sites(bohai_sea_seq, 1, 2)
grid.arrange(bohai_sea_map, bohai_sea_seq_map, nrow = 1)

Conclusion

The usefulness of the seq_sites() function is demonstrated above on a number of different scales and coastal features. This is in no way an exhaustive test of this function and I welcome any input from anyone that uses it for their own work. The premise on which this function operates is very basic and so theoretically it should be very adaptive. The only thing to look out for is if one has a very convoluted coastline with a long stretch without any sites as the algorithm may think this is two separate coastlines.

Objective

There are many different things that require scientists to use programming languages (like R). Far too many to count here. There is however one common use amongst almost all environmental scientists: mapping. Almost every report, research project or paper will have need to refer to a study area. This is almost always “Figure 1”. To this end, whenever I teach R, or run workshops on it, one of the questions I am always prepared for is how to create a map of a particular area. Being a happy convert to the tidyverse I only teach the graphics of ggplot2. I have found that people often prefer to use the ggmap extension to create ggplot quality figures with Google map backgrounds, but I personally think that a more traditional monotone background for maps looks more professional. What I’ve decided to showcase this week is the data and code required to create a publication quality map. Indeed, the following code will create the aforementioned obligatory “Figure 1” in a paper I am currently preparing for submission.

Data

There are heaps of packages etc. that one may use to create maps. And there is a never ending source of blogs, books and tutorials that illustrate many of the different ways to visualise spatial data. For my international and geographic borders I prefer to use data I’ve downloaded from GSHHSG and then converted to dataframes using functions found in the PBSmapping package. I then save these converted dataframes as .Rdata objects on my computer for ease of use with all of my projects. For the domestic borders of a country, which I won’t use in this post, one may go here. Note however that for some strange reason this website still has the pre-1994 borders for South Africa. For the correct SA borders one must go here. The current SA borders may actually be download in the .Rdata format, which is neat.

Once one has the borders to be used in the map, the next step is to think about what one actually wants to show. The main purpose of this map is to show where several in situ coastal seawater temperature time series were collected. This could be done quite simply but a plain black and white map is offensively boring so we want to make sure there is a good amount of (but not too much!) colour in order to entice the reader. I personally find pictures of meso-scale oceanic phenomena particularly beautiful so try to include them whenever I can. Luckily that is also what I study so it is not strange that I include such things in my work. Now if only I studied panda’s, too…

Panda’s aside, the current work I am engaged in also requires that the atmospheric processes around southern Africa be considered in addition to the oceanography. To visualise both air and sea concurrently would be a mess so we will want to create separate panels for each. Because I have been working with reanalysis data lately, and not satellite data, I am also able to include the wind/ current vectors in order to really help the temperature patterns pop. The oceanic data are from the BRAN2016 product and the atmospheric data are from ERA-Interim. Both of which are available for download for free for scientific pursuits. I’ve chosen here to use the mean values for January 1st as the summer months provide the most clear example of the thermal differences between the Agulhas and Benguela currents. The code used to create the scale bar in the maps may be found here. It’s not a proper ggplot geom function but works well enough. I’ve also decided to add the 200 m isobath to the sea panel. These data come from NOAA.

## Libraries
library(tidyverse)
library(viridis)
library(gridExtra)

## Data
# South Africa map data
load("../../static/data/southern_africa_coast.Rdata") # Lowres
names(southern_africa_coast)[1] <- "lon"
load("../../static/data/sa_shore.Rdata") # Hires
names(sa_shore)[4:5] <- c("lon","lat")

# International borders
load("../../static/data/africa_borders.Rdata")

# Reanalysis data
load("../../static/data/all_jan1_0.5.Rdata")
names(all_jan1_0.5)[1:2] <- c("lon","lat")

# In situ time series locations
site_list <- read_csv("../../static/data/mg_site_list.csv")
site_list$order <- 1:nrow(site_list)

# Bathymetry data
load("../../static/data/sa_bathy.Rdata")

## Scale bar function
source("../../static/func/scale.bar.func.R")

Mapping

I find that it is easier to keep track of the different aspects of a map when they are stored as different dataframes. One should however avoid having too many loose dataframes running about in the global environment. It is a balancing act and requires one to find a happy middle ground. Here I am going to cut the all_jan1_0.5 dataframe into 4. One each for air and sea temperatures and vectors. I am also going to reduce the resolution of the wind so that the vectors will plot more nicely.

# Devide the reanalysis data
sea_temp <- filter(all_jan1_0.5, variable == "BRAN/temp")
air_temp <- filter(all_jan1_0.5, variable == "ERA/temp")
currents <- filter(all_jan1_0.5, variable == "BRAN/u" | variable == "BRAN/v") %>% 
  select(-date, -index) %>% 
  spread(key = variable, value = value) %>% 
  rename(u = "BRAN/u", v = "BRAN/v")
winds <- filter(all_jan1_0.5, variable == "ERA/u" | variable == "ERA/v") %>% 
  select(-date, -index) %>% 
  spread(key = variable, value = value) %>% 
  rename(u = "ERA/u", v = "ERA/v")

# Reduce wind/ current vectors
lon_sub <- seq(10, 40, by = 1)
lat_sub <- seq(-40, -15, by = 1)
# currents <- currents[(currents$lon %in% lon_sub & currents$lat %in% lat_sub),]
winds <- winds[(winds$lon %in% lon_sub & winds$lat %in% lat_sub),]

With just a few alterations to our nicely divided up dataframes we are ready to create a map. We will look at the code required to create each map and then put it all together in the end.

First up is the most busy. The following code chunk will create the top panel of our map, the sea state. It is necessary to label all of the locations mentioned in the text and so they are thrown on here. In order to make the site label easier to read I’ve made them red. This is particularly jarring but I think I like it.

# Establish the vector scalar for the currents
current_uv_scalar <- 2

# The top figure (sea)
mg_top <- ggplot(data = southern_africa_coast, aes(x = lon, y = lat)) +
  # The ocean temperature
    geom_raster(data = sea_temp, aes(fill = value)) +
  # The bathymetry
    stat_contour(data = sa_bathy[sa_bathy$depth < -200 & sa_bathy$depth > -2000,], 
                 aes(x = lon, y = lat, z = depth, alpha = ..level..),
                 colour = "ivory", size = 0.5, binwidth = 1000, na.rm = TRUE, show.legend = FALSE) +
  # The current vectors
    geom_segment(data = currents, aes(xend = lon + u * current_uv_scalar, yend = lat + v * current_uv_scalar),
                 arrow = arrow(angle = 15, length = unit(0.02, "inches"), type = "closed"), alpha = 0.4) +
  # The land mass
    geom_polygon(aes(group = group), fill = "grey70", colour = "black", size = 0.5, show.legend = FALSE) +
    geom_path(data = africa_borders, aes(group = group)) +
  # The legend for the vector length
    geom_label(aes(x = 36, y = -37, label = "1.0 m/s\n"), size = 3, label.padding = unit(0.5, "lines")) +
    geom_segment(aes(x = 35, y = -37.5, xend = 37, yend = -37.5)) +
  # The in situ sites
    geom_point(data = site_list, shape = 1,  size = 2.8, colour = "ivory") +
    geom_text(data = site_list, aes(label = order), size = 1.9, colour = "red") +
  # Oceans
    annotate("text", label = "INDIAN\nOCEAN", x = 37.00, y = -34.0, size = 4.0, angle = 0, colour = "ivory") +
    annotate("text", label = "ATLANTIC\nOCEAN", x = 13.10, y = -34.0, size = 4.0, angle = 0, colour = "ivory") +
  # Benguela
    geom_segment(aes(x = 17.2, y = -32.6, xend = 15.2, yend = -29.5),
                arrow = arrow(length = unit(0.3, "cm")), size = 0.5, colour = "ivory") +
    annotate("text", label = "Benguela", x = 16.0, y = -31.8, size = 3.5, angle = 298, colour = "ivory") +
  # Agulhas
    geom_segment(aes(x = 33, y = -29.5, xend = 29.8, yend = -33.0),
                arrow = arrow(length = unit(0.3, "cm")), size = 0.5, colour = "ivory") +
    annotate("text", label = "Agulhas", x = 31.7, y = -31.7, size = 3.5, angle = 53, colour = "ivory") +
  # Agulhas Bank
    annotate("text", label = "Agulhas\nBank", x = 22.5, y = -35.5, size = 3.0, angle = 0, colour = "ivory") +
  # Cape Peninsula
    annotate("text", label = "Cape\nPeninsula", x = 17.2, y = -35, size = 3.0, angle = 0, colour = "ivory") +
  # Improve on the x and y axis labels
    scale_x_continuous(breaks = seq(15, 35, 5),
                       labels = scales::unit_format(prefix = "°E", sep = ""),
                       position = "top") +
    scale_y_continuous(breaks = seq(-35, -30, 5),
                       labels = c("35°S", "30°S")) +
    labs(x = NULL, y = NULL) +
  # Slightly shrink the plotting area
    coord_cartesian(xlim = c(10.5, 39.5), ylim = c(-39.5, -25.5), expand = F) +
  # Use viridis colour scheme
    scale_fill_viridis(name = "Temp.\n(°C)", option = "D") +
  # Adjust the theme
    theme_bw() +
    theme(panel.border = element_rect(fill = NA, colour = "black", size = 1),
          axis.text = element_text(colour = "black"),
          axis.ticks = element_line(colour = "black"))

Many of the sites that need to be plotted are laying on top of each other. This is never good, but is made worse when the sites in question are refereed to frequently in the text. For this reason we need to create a little panel inside of the larger figure that shows a zoomed in picture of False Bay. Complete with text labels.

# False Bay inset
fb <- ggplot(data = sa_shore, aes(x = lon, y = lat)) +
  # The land mass
    geom_polygon(aes(group = PID),
                fill = "grey70", colour = NA, size = 0.5, show.legend = FALSE) +
  # The in situ sites
    geom_point(data = site_list, shape = 1,  size = 3, colour = "black") +
    geom_text(data = site_list, aes(label = order), size = 2.3, colour = "red") +
  # Text label
    geom_text(aes(x = 18.65, y = -34.25, label = "False\nBay"), size = 2.7) +
  # Control the x and y axes
    coord_cartesian(xlim = c(18.2, 19), ylim = c(-34.5, -33.8), expand = F) +
    scale_x_continuous(breaks = c(18.5), label = "18.5°E") +
    scale_y_continuous(breaks = c(-34.1), label = "34.1°S") +
    labs(x = NULL, y = NULL) +
  # Change the theme for cleaner over-plotting
    theme_bw() +
    theme(plot.background = element_blank(),
          axis.text = element_text(colour = "ivory"),
          axis.text.y = element_text(angle = 90, hjust = 0.5),
          axis.ticks = element_line(colour = "ivory"),
          panel.border = element_rect(colour = "ivory"),
          panel.grid = element_blank())

We could possibly create another inset panel for the clomp of sites around Hamburg but this figure is already getting too busy. So we’ll leave it for now. One inset panel will serve to illustrate the code necessary to create a faceted map so for the purposes of this post it will also suffice. That leaves us with only the bottom panel to create. The air state. I’ve decided to put the scale bar/ North arrow on this panel in an attempt to balance the amount of information in each panel.

# Establish the vector scalar for the wind
wind_uv_scalar <- 0.5

# The bottom figure (air)
mg_bottom <- ggplot(data = southern_africa_coast, aes(x = lon, y = lat)) +
  # The ocean temperature
    geom_raster(data = air_temp, aes(fill = value)) +
  # The land mass
    geom_polygon(aes(group = group), fill = NA, colour = "black", size = 0.5, show.legend = FALSE) +
    geom_path(data = africa_borders, aes(group = group)) +
  # The current vectors
    geom_segment(data = winds, aes(xend = lon + u * wind_uv_scalar, yend = lat + v * wind_uv_scalar),
                 arrow = arrow(angle = 15, length = unit(0.02, "inches"), type = "closed"), alpha = 0.4) +
  # The legend for the vector length
    geom_label(aes(x = 36, y = -37, label = "4.0 m/s\n"), size = 3, label.padding = unit(0.5, "lines")) +
    geom_segment(aes(x = 35, y = -37.5, xend = 37, yend = -37.5)) +
  # Improve on the x and y axis labels
    scale_x_continuous(breaks = seq(15, 35, 5),
                       labels = scales::unit_format(prefix = "°E", sep = "")) +
    scale_y_continuous(breaks = seq(-35, -30, 5),
                       labels = c("35°S", "30°S")) +
    labs(x = NULL, y = NULL) +
  # Scale bar
    scaleBar(lon = 13, lat = -38.0, distanceLon = 200, distanceLat = 50, distanceLegend = 90, dist.unit = "km",
             arrow.length = 200, arrow.distance = 130, arrow.North.size = 4) +
  # Slightly shrink the plotting area
    coord_cartesian(xlim = c(10.5, 39.5), ylim = c(-39.5, -25.5), expand = F) +
  # Use viridis colour scheme
    scale_fill_viridis(name = "Temp.\n(°C)", option = "A") +
  # Adjust the theme
    theme_bw() +
    theme(panel.border = element_rect(fill = NA, colour = "black", size = 1),
          axis.text = element_text(colour = "black"),
          axis.ticks = element_line(colour = "black"))

With our three pieces of the map complete, it is time to stick them together. There are many ways to do this but I have recently found that using annotation_custom allows one to stick any sort of ggplot like object onto any other sort of ggplot object. This is an exciting development and opens up a lot of doors for some pretty creative stuff. Here I will just use it to demonstrate simple faceting, but combined with panel gridding. Really though the sky is the limit.

# Convert the figures to grobs
mg_top_grob <- ggplotGrob(mg_top)
fb_grob <- ggplotGrob(fb)
mg_bottom_grob <- ggplotGrob(mg_bottom)

# Stick them together
gg <- ggplot() +
  # First set the x and y axis values so we know what the ranges are
  # in order to make it easier to place our facets
    coord_equal(xlim = c(1, 10), ylim = c(1, 10), expand = F) +
  # Then we place our facetsover one another using the coordinates we created
    annotation_custom(mg_top_grob,
                      xmin = 1, xmax = 10, ymin = 5.5, ymax = 10) +
    annotation_custom(fb_grob,
                      xmin = 3.5, xmax = 5.5, ymin = 7.2, ymax = 8.8) +
    annotation_custom(mg_bottom_grob,
                      xmin = 1, xmax = 10, ymin = 1, ymax = 5.5)

Summary

The developments in the gridding system have brought the potential for using ggplot for these more complex maps forward quite a bit. As long as one does not use a constrained mapping coordinate system (i.e. coord_fixed) the grob-ification of the ggplot objects seems to allow the placing of the pieces into a common area to be performed smoothly. Displaying many different bits of information cleanly is always a challenge. This figure is particularly busy, out of necessity. I think it turned out very nicely though.

Figure 1: Map showing the southern tip of the African continent. The top panel shows the typical sea surface temperature and surface currents on January 1st. The bottom panel likewise shows the typical surface air temperatures and winds on any given January 1st.

Objective

A few weeks ago for a post about the relationship between gender equality and GDP/ capita I found a nifty website that has a massive amount of census information for most countries on our planet. Much of this information could be used to answer some very interesting and/ or important questions. But some of the data can be used to answer seemingly pointless questions. And that’s what I intend to do this week. Specifically, which countries in the world have the highest rates of goats/ capita?

Data

The goats per capita data were downloaded from the clia-infra website. These data are already in the format we need so there is little to be done before jumping straight into the analysis. We will however remove any records from before 1900 as these are almost entirely estimates, and not real records.

# Load libraries
library(tidyverse)
library(gridExtra)

# Load data
goats <- read_csv("../../static/data/GoatsperCapita_Compact.csv") %>% 
  filter(year >= 1900)

Analysis

First of all, I would like to know what the global trend in goats/ capita has been since 1900. To do so we need to create annual averages and apply a simple linear model to them. We will also plot boxplots to give us an idea of the spread of goats/ capita over the world.

goats %>% 
  group_by(year) %>% 
  select(-ccode, -country.name) %>% 
  summarise(value = mean(value)) %>% 
  ggplot(aes(x = year, y = value)) +
  geom_boxplot(data = goats, aes(group = year)) +
  geom_smooth(method = "lm")

Figure 1: Boxplots with a fitted linear model showing the global trend in goats/ capita over the last century.

As we may see in Figure 1, the overall trend in goats/ capita in the world has been decreasing very slightly over the last century. The striking result from Figure 1 however is the massive range of values as seen by the outliers from the boxplots. So which countries are these that have so many more goats/ capita than the rest of the world?

We want to see which countries have the most goats/ capita but there are 172 unique countries in this dataset so it would look much too busy to plot them all. To that end we want only the top and bottom 10 countries from the most recent year of reporting (2010).

# Top 10 goat having countries
goats_top <- goats %>% 
  arrange(desc(value)) %>% 
  filter(ccode %in% head(unique(ccode), 10))

# Bottom 10
goats_bottom <- goats %>% 
  arrange(value) %>% 
  filter(ccode %in% head(unique(ccode), 10))

# Line graphs
gt <- ggplot(data = goats_top, aes(x = year, y = value)) +
  geom_line(aes(colour = country.name)) +
  labs(y = "Goats/ Capita", x = NULL) +
  scale_x_continuous(expand = c(0,0)) +
  scale_color_brewer(name = NULL, palette = "Set3") +
  theme(legend.position = "top")
gb <- ggplot(data = goats_bottom, aes(x = year, y = value)) +
  geom_line(aes(colour = country.name)) +
  labs(y = "Goats/ Capita", x = NULL) +
  scale_x_continuous(expand = c(0,0)) +
  theme(legend.position = "bottom",
        legend.title = element_blank())

# Combine
grid.arrange(gt, gb)

Figure 2: Line graphs showing the rate of goats/ capita for the top and bottom 10 goat having countries in the world over the last century.

Summary

I was a bit surprised to find that Mongolia is far and away the country with the most goats/ capita at 5.140 in 2010. Less surprising is that the other top 9 goat having countries in the world in 2010 were all in Africa and their rate of goats/ capita was between 1.634 (Mauritania) to 0.124 (South Africa). This makes for a massive spread in what is already an outlying set of countries. How is it that Mongolia has so many more goats/ capita? This is a very odd result but the data were reported annually from 2000 to 2010 and they consistently show similarly high rates for Mongolia.

The bottom 10 goat having countries in the world are a mix of European, Asian, North American and Pacific Islands. This mix is not surprising as we may see in Figure 1 that there are no outliers in the bottom of the distribution. The highest value for the bottom 10 countries in 2010 was Tonga at 0.121. This is very close to the lowest value from the top 10 countries, and shows us that most of the 172 countries in this dataset have ~0.12 goats per person. With this average in mind, we see that the other bottom nine countries in Figure 2 really are much lower than the global average with rates approaching 0 goats/ capita. It is worth mentioning that the lowest overall rate of goats/ capita in 2010 was Japan at 0.0001. Meaning that there is only one goat in Japan for every 10,000 people. As opposed to Mongolia that has more than five goats for every one person. Therefore there were 50,000 times more goats/ capita in Mongolia than Japan in 2010…

I supposes the take away message from this analysis is that if one ever wants to get away from it all and just go spend time with a lot of goats, Mongolia is the place for you!

(and definitely avoid Japan)

Objective

As an immigrant myself, all of the talk of immigration to be found in main stream media outlets today makes me a bit nervous. Whereas most people that speak of the pro’s and con’s of immigration do so from the point of view of how it may affect the country of their birth, I view this issue as something that affects my ability to live outside the country of my birth. I immigrated into the Republic of South Africa in 2013 and have been living here since. I would do a piece on South African immigration but the numbers are difficult to get a hold of and honestly most people are less interest in South Africa than the USA.

Immigration is not a new talking point. It’s something that comes up in political and a-political circles all of the time. The current debate on the Muslim Ban in the USA may have reached a new level for this sort of rhetoric in the West, but targeted crackdowns of this sort are not new in the world. I won’t bother with citations here, but if one is interested a quick google of “xenophobia” + “border control” should yield some convincing results. As this current row of immigration debates in the USA has become so partisan, I decided that an interesting question to ask would be “Under which of the two parties have more people immigrated into the USA?” and “Under which of the two parties have more people been removed from the USA?”

Data

The historical data on immigration into the USA are located at the Department of Homeland Securities website. In 2013 the DHS started keeping very detailed reports of all immigration by age, country, marital status, etc. These highly detailed data are very interesting but will not help us to ask our central questions. We want long time series of data so that we may compare many different administrations from each party. For ease of analysis I have chosen to classify the party in power at any point in time based on the party of the President. I understand that the Senate or Congress would perhaps be better, if not more egalitarian choices, but the current focus of this issue has the US President at it’s core, so I decided to keep that theme constant in this analysis. I’ll only start from Eisenhower and go up until Obama as the publicly available DHS data end in 2015. They begin as far back as 1892, but ggplot2 has built into it a US president dataframe and I am going to just use that because I’m lazy.

# Libraries
library(tidyverse)
library(lubridate)
library(broom)
library(gridExtra)

# President data
data(presidential)
presidential$start <- year(presidential$start)
presidential$end <- year(presidential$end)-1

# Create index of party years
  # I couldn't think of a clever automatic way of doing this...
party_year <- data.frame(Year = seq(1953, 2016), Party = c(rep("Republican",8), rep("Democrat",8), 
                                                           rep("Republican",8), rep("Democrat",4),
                                                           rep("Republican",12), rep("Democrat",8),
                                                           rep("Republican",8), rep("Democrat",8)))

# Immigration data
green_card <- read_csv("../../static/data/Persons Obtaining Lawful Permanent Resident Status-Fiscal Years 1820 to 2015.csv")
green_card <- merge(green_card, party_year, by = "Year")
removals <- read_csv("../../static/data/Aliens Removed Or Returned-Fiscal Years 1892 To 2015.csv")
removals <- merge(removals, party_year, by = "Year")

Immigration

In this first figure we are defining immigration as the number of people actually receiving a green card in any given year. This is the most strict definition of “immigration” and I think may be best used to show whom the USA was choosing to let in.

ggplot(data = green_card, aes(x = Year, y = Number)) +
  geom_col(aes(fill = Party), colour = "black") +
  geom_smooth(method = "lm", colour = "black") +
  labs(x = NULL, y = "Green Cards Granted") +
  scale_fill_manual(values = c("slateblue1", "firebrick1"))

Figure 1: Bar charts showing the number of green cards granted each year in the USA. The colour of the bars show the ruling party at the time of issuance. A linear model is imposed in black.

We may see in Figure 1 that the all time high for the granting of green cards was during the four year administration of George Bush Senior. These values are so much higher than the other administrations that it leverages the linear model drawn on these data up past where it should normally be to show the more normal trend exhibited by all of the other administrations since Eisenhower. That being said, we actually see a bit of a turn down during the Obama administration, with the largest year of green card issuance during the George Bush Junior administration larger than any year under Obama. I find that surprising. Figure 1 also shows us that we can’t really directly compare the different administrations because as populations increase, so too will the number of people that want to immigrate. In a quick pinch however we may use the residuals from the linear model to give us a slightly better visualisation of how the parties stack up against one another.

# Calculate residuals
green_card_resids <- augment(lm(Number~Year, data = green_card))
green_card_resids <- merge(green_card_resids, party_year, by = "Year")

# Plot them
ggplot(data = green_card_resids, aes(x = Year, y = .resid)) +
  geom_col(aes(fill = Party), colour = "black") +
  geom_smooth(method = "lm", colour = "black") +
  labs(x = NULL, y = "Green Cards Granted") +
  scale_fill_manual(values = c("slateblue1", "firebrick1"))

Figure 2: The residuals from a linear model fitted to the data shown in Figure 1.

It appears as though whenever there was a Bush in office it was much easier to get a green card. And that Democrats generally made it more difficult to do so.

Expulsion

Now that we have seen that it is easier to enter the USA during a Republican presidency, let’s see under which party an illegal immigrant is most likely to be expelled. There are two different classes of expulsion: ‘Removal’ and ‘Return’. Removal means that a legal order was issued to remove the individual. Return means that the individual was likewise not legally in the states, but left of their own volition.

# Returns
return_bar <- ggplot(data = removals, aes(x = Year, y = Returns)) +
  geom_col(aes(fill = Party), colour = "black") +
  # geom_smooth(method = "lm", colour = "black") +
  labs(x = NULL, y = "Immigrants Returned") +
  scale_fill_manual(values = c("slateblue1", "firebrick1")) +
  ggtitle("Returns")

# Removals
removal_bar <- ggplot(data = removals, aes(x = Year, y = Removals)) +
  geom_col(aes(fill = Party), colour = "black") +
  # geom_smooth(method = "lm", colour = "black") +
  labs(x = NULL, y = "Immigrants Removed") +
  scale_fill_manual(values = c("slateblue1", "firebrick1")) +
  ggtitle("Removals")

# Stick'em
grid.arrange(return_bar, removal_bar)

Figure 3: Two bar charts showing the rates of returns and removals for immigrants from the USA.

Figure 3 tells a very interesting story. In the top panel (Returns), we see that from 1953-55 (shortly after WWII) there were massive numbers of immigrants that returned to their home countries voluntarily. Then there is a period of increase leading up to the 80’s. This then follows a somewhat normal distribution, peaking in the late 90’s near the end of the Clinton administration before the peaceful return of immigrants drops steadily through the 8 years of Bush then Obama. The bottom panel (Removals) shows the reason for this apparent relaxation on immigrants. It isn’t that immigrants were being sent away less, but rather they began to be removed more forcefully than appears to have been the policy until something changed during the Clinton Administration. The rate of immigrants being removed became greater than those being returned in 2011 under Obama. Again we see a heavy hand on immigration during years with a Democratic president in office. It is hard to compare the parties on this issue as the policy of forcefully removing immigrants in favour of having them leave peacefully has only been in practice over three administrations (Clinton, Bush Jr. and Obama). That being said, it is worth noting that the y axes on these two figures are not the same. The increase in removals does not outweigh the decrease in returns. Overall the rate of expulsion of immigrants from the states declined during the Obama administration. And perhaps also Bush Jr.

It is fair criticism to point out that a green card may take several years to acquire. This means that when one begins the process of applying for a green card it may take so long that a different party will be in power by the time it is granted… or not. I would argue however that most of these parties (with the exception of Carter) are in office for eight year stretches. This is not meant to be a definitive analysis, but I think it has proven to be a rather interesting first step. I didn’t expect the data to look like this. George Bush Senior, saviour to immigrants, who would have thought.

Objective

With more and more scientists moving to open source software (i.e. R or Python) to perform their numerical analyses the opportunities for collaboration increase and we may all benefit from this enhanced productivity. At the risk of sounding sycophantic, the future of scientific research truly is in multi-disciplinary work. What then could be inhibiting this slow march towards progress? We tend to like to stick to what is comfortable. Oceanographers in South Africa have been using MATLAB and ODV (Ocean Data View) since about the time that Jesus was lacing up his sandals for his first trip to Palestine. There has been much debate on the future of MATLAB in science, so I won’t get into that here, but I will say that the package oce contains much of the code that one would need for oceanographic work in R, and the package angstroms helps one to work with ROMS (Regional Ocean Modeling System) output. The software that has however largely gone under the radar in these software debates has been ODV. Probably because it is free (after registration) it’s fate has not been sealed by university departments looking to cut costs. The issue with ODV however is the same with all Microsoft products; the sin of having a “pointy clicky” user interface. One cannot perform truly reproducible research with a menu driven user interface. The steps must be written out in code. And so here I will lay out those necessary steps to create an interpolated CTD time series of temperature values that looks as close to the default output of ODV as possible.

Colour palette

Perhaps the most striking thing about the figures that ODV creates is it’s colour palette. A large criticism of this colour palette is that the range of colours used are not equally weighted visually, with the bright reds drawing ones eye more than the muted blues. This issue can be made up for using the viridis package, but for now we will stick to a ODV-like colour palette as that is part of our current objective. To create a colour palette that appears close to the ODV standard I used GIMP to extract the hexadecimal colour values from the colour bar in Figure 1.

# Load libraries
library(tidyverse)
library(lubridate)
library(reshape2)
library(MBA)
library(mgcv)

# Load and screen data
  # For ease I am only using monthly means
  # and depth values rounded to 0.1 metres
ctd <- read_csv("../../static/data/ctd.csv") %>% 
  mutate(depth  = -depth) %>%  # Correct for plotting
  filter(site == 1) %>% 
  select(date, depth, temperature) %>% 
  rename(temp = temperature) #%>%
### Uncomment out the following lines to reduce the data resolution
  # mutate(date = round_date(date, unit = "month")) %>%
  # mutate(depth = round(depth, 1)) %>%
  # group_by(date, depth) %>%
  # summarise(temp = round(mean(temp, na.rm = TRUE),1))
###

# Manually extracted hexidecimal ODV colour palette
ODV_colours <- c("#feb483", "#d31f2a", "#ffc000", "#27ab19", "#0db5e6", "#7139fe", "#d16cfa")

# Create quick scatterplot
ggplot(data = ctd, aes(x = date, y = depth)) +
  geom_point(aes(colour = temp)) +
  scale_colour_gradientn(colours = rev(ODV_colours)) +
  labs(y = "depth (m)", x = NULL, colour = "temp. (°C)")

Figure 2: A non-interpolated scatterplot of our temperature (°C) data shown as a function of depth (m) over time.

Interpolating

Figure 2 is a far cry from the final product we want, but it is a step in the right direction. One of the things that sets ODV apart from other visualisation software is that it very nicely interpolates the data you give it. While this looks nice, there is some criticism that may be leveled against doing so. That being said, what we want is a pretty visualisation of our data. We are not going to be using these data for any numerical analyses so the main priority is that the output allows us to better visually interpret the data. The package MBA already has the necessary functionality to do this, and it works with ggplot2, so we will be using this to get our figure. The interpolation method used by mba.surf() is multilevel B-splines.

In order to do so we will need to dcast() our data into a wide format so that it simulates a surface layer. spread() from the tidyr package doesn’t quite do what we need as we want a proper surface map, which is outside of the current ideas on the structuring of tidy data. Therefore, after casting our data wide we will use melt(), rather than gather(), to get the data back into long format so that it works with ggplot2.

It is important to note with the use of mba.surf() that it transposes the values while it is creating the calculations and so creating an uneven grid does not work well. Using the code written below one will always need to give the same specifications for pixel count on the x and y axes.

# The date column must then be converted to numeric values
ctd$date <- decimal_date(ctd$date)

# Now we may interpolate the data
ctd_mba <- mba.surf(ctd, no.X = 300, no.Y = 300, extend = T)
dimnames(ctd_mba$xyz.est$z) <- list(ctd_mba$xyz.est$x, ctd_mba$xyz.est$y)
ctd_mba <- melt(ctd_mba$xyz.est$z, varnames = c('date', 'depth'), value.name = 'temp') %>% 
  filter(depth < 0) %>% 
  mutate(temp = round(temp, 1))

# Finally we create our gridded result
ggplot(data = ctd_mba, aes(x = date, y = depth)) +
  geom_raster(aes(fill = temp)) +
  scale_fill_gradientn(colours = rev(ODV_colours)) +
  geom_contour(aes(z = temp), binwidth = 2, colour = "black", alpha = 0.2) +
  geom_contour(aes(z = temp), breaks = 20, colour = "black") +
### Activate to see which pixels are real and not interpolated
  # geom_point(data = ctd, aes(x = date, y = depth),
  #            colour = 'black', size = 0.2, alpha = 0.4, shape = 8) +
###
  labs(y = "depth (m)", x = NULL, fill = "temp. (°C)") +
  coord_cartesian(expand = 0)

Figure 3: The same temperature (°C) profiles seen in Figure 2 with the missing values filled in with multilevel B-splines. Note the artefact created in the bottom right corner. The 20°C contour line is highlighted in black.

At first glance this now appears to be a very good approximation of the output from ODV. An astute eye will have noticed that the temperatures along the bottom right corner of this figure are not interpolating in a way that appears possible. It is very unlikely that there would be a deep mixed layer underneath the thermoclines detected during 2015. The reason the splines create this artefact is that they are based on a convex hull around the real data points and so the interpolating algorithm wants to perform a regression towards a mean value away from the central point of where the spline is being calculated from. Because the thermoclines detected are interspersed between times where the entire water column consists of a mixed layer mba.surf() is filling in the areas without data as though they are a fully mixed surface layer.

Bounding boxes

There are many ways to deal with this problem with four possible fixes coming to mind quickly. The first is to set extend = F within mba.surf(). This tells the algorithm not to fill up every part of the plotting area and will alleviate some of the inaccurate interpolation that occurs but will not eliminate it. The second fix, which would prevent all inaccurate interpolation would be to limit the depth of all of the temperature profiles to be the same as the shallowest sampled profile. This is not an ideal fix because we would then lose quite a bit of information from the deeper sampling that occurred from 2013 to 2014. The third fix is to create a bounding box and screen out all of the interpolated data outside of it. A fourth option is to use soap-film smoothing over some other interpolation method, such as a normal GAM, concurrently with a bounding box. This is normally a good choice but does not work well with these data so I have gone with option three.

# Create a bounding box
  # We want to slightly extend the edges so as to use all of our data
left <- ctd[ctd$date == min(ctd$date),] %>% 
  select(-temp) %>% 
  ungroup() %>% 
  mutate(date = date-0.01)
bottom <- ctd %>%
  group_by(date) %>% 
  summarise(depth = min(depth)) %>% 
  mutate(depth = depth-0.01)
right <- ctd[ctd$date == max(ctd$date),] %>% 
  select(-temp) %>% 
  ungroup() %>% 
  mutate(date = date+0.01)
top <- ctd %>%
  group_by(date) %>% 
  summarise(depth = max(depth)) %>% 
  mutate(depth = depth+0.01)
bounding_box <- rbind(data.frame(left[order(nrow(left):1),]), data.frame(bottom), 
                      data.frame(right), data.frame(top[order(nrow(top):1),]))

# Now that we have a bounding box we need to 
# screen out the pixels created outside of it
bounding_box_list <- list(bounding_box)
names(bounding_box_list[[1]]) <- c("v","w")
v <- ctd_mba$date
w <- ctd_mba$depth
ctd_mba_bound <- ctd_mba[inSide(bounding_box_list, v, w),]

# Correct date values back to date format
  # Not used as it introduces blank space into the figure
# ctd_mba_bound$date <- as.Date(format(date_decimal(ctd_mba_bound$date), "%Y-%m-%d"))


# The screened data
ggplot(data = ctd_mba_bound, aes(x = date, y = depth)) +
  geom_raster(aes(fill = temp)) +
  scale_fill_gradientn(colours = rev(ODV_colours)) +
  geom_contour(aes(z = temp), binwidth = 2, colour = "black", alpha = 0.2) +
  geom_contour(aes(z = temp), breaks = 20, colour = "black") +
  labs(y = "depth (m)", x = NULL, fill = "temp. (°C)") +
  coord_cartesian(expand = 0)

Figure 4: The same temperature (°C) profiles seen in Figure 3 with a bounding box used to screen out data interpolated outside of the range of the recordings.

Summary

In this short tutorial we have seen how to create an interpolated temperature depth profile over time after a fashion very similar to the default output from ODV. We have also seen how to either fill the entire plotting area with interpolated data (Figure 3), or quickly generate a bounding box in order to remove any potential interpolation artefacts (Figure 4). I think this is a relatively straight forward work flow and would work with any tidy dataset. It is worth noting that this is not constrained to depth profiles, but would work just as well with map data. One would only need to change the date and depth variables to lon and lat.

R is an amazingly flexible language with an incredible amount of support and I’ve yet to see it not be able to emulate, or improve upon, an analysis or graphical output from any other software.

Objective

Most people living in the Western World are very quick to extol the virtues of gender equality. There are however many places where this is not so. This then inevitably leads to conflict as cultures and nations are drawn closer together on our ever shrinking earth. Perhaps not the sort of conflict that leads to sabre rattling, but certainly ideological disagreements that affect policy and have real impacts on large swathes of humanity. So what is to be done? How can say how anyone else should be. There are of course all sorts of moral back and forth’s that could be pursued cyclically ad nauseum, but what if we could show quantitatively what the benefit of gender equality was to a nation and the lives of it’s people? That is the exact sort of question I like to answer here at this blog and it is a question that came up in my daily life a couple of weeks ago. Because most metrics for most countries are recorded, this is the sort of thing that can be answered. Indeed, it has been before, so here I add another take on an argument that really shouldn’t still be happening…

Data

In order to quantify the benefit of gender equality we are going to need global census data, as this is a conversation that needs to be had at a global level. Happily for us these data may be found at Clio Infra. This is an amazing web hosted database that contains an unexpected range of information as it aggregates data from many other sources. I’ll likely be going back to this data repository on multiple occasions in the future. But for now we’ll stick to gender equality. For this post we will be looking at a number of variables as this allows us to develop a more nuanced view of the relationships that exist between the wealth of nations and the egalitarianism their cultures engender. It is unfortunately not possible to show causality in the relationships we will model below but I think that educated readers will likely arrive at the same inferences as myself. Of course, if anyone has any objections, faults or errors to point out in the analysis that follows I would be very happy to hear them.

The data used in this blog were downloaded in “Compact” form, which comes in .xlsx format. These files were then opened and only the tab containing the data in long format were saved as a .csv file. As an aside, these data are visualised on the Clio Infra website as boxplots using what is clearly ggplot2 code. Also note that unless specified all values are taken as either women/ men or women-men. Meaning that proportions below 1, or negative values signify greater abundance for men than women in those populations.

I’ve chosen o use the metrics seen below as I think they represent inequality between genders as well as throughout populations as a whole.

## Load libraries
library(tidyverse)
library(broom)
# library(RColorBrewer)

## Load data
# Educational Inequality Gini Coefficient (after age 15)
education_inequality <- read_csv("../../static/data/EducationalInequalityGiniCoefficient.csv") %>% 
  mutate(variable = "education_inequality")
# GDP per Capita
gdp_per_capita <- read_csv("../../static/data/GDPperCapita.csv") %>% 
  mutate(variable = "gdp_per_capita")
# Gender Equality Years of Education (after age 15)
gender_equality_education <- read_csv("../../static/data/GenderEqualityYearsofEducation.csv") %>% 
  mutate(variable = "gender_equality_education")
# Historical Gender Equality Index
gender_equality_index <- read_csv("../../static/data/HistoricalGenderEqualityIndex_Compact.csv") %>% 
  mutate(variable = "gender_equality_index")
# Gender Equality of Numeracy
gender_equality_numeracy <- read_csv("../../static/data/GenderEqualityofNumeracy_Compact.csv") %>% 
  mutate(variable = "gender_equality_numeracy")
# Income Inequality
income_inequality <- read_csv("../../static/data/IncomeInequality.csv") %>% 
  mutate(variable = "income_inequality")
# Sex Ratio (ages 0 - 5)
sex_ratio <- read_csv("../../static/data/SexRatio_Compact.csv") %>% 
  mutate(variable = "sex_ratio")
# Total Population
total_population <- read_csv("../../static/data/TotalPopulation_Compact.csv") %>% 
  mutate(variable = "total_population",
         value = scale(value)) # Scale the large range
# Average Years of Education (after age 15)
years_of_education <- read_csv("../../static/data/AverageYearsofEducation.csv") %>% 
  mutate(variable = "education_years")

## Create different dataframe
data_long <- rbind(gdp_per_capita, education_inequality, gender_equality_education, 
                   gender_equality_index, gender_equality_numeracy, income_inequality, 
                   sex_ratio, total_population, years_of_education)

Analysis

I recently learned how to use the dplyr pipe (%>%) to perform nested models and so am excited to put that to use here. Our first step is to run simple linear models for each metrics we have loaded against GDP per capita without controlling for time (year of sampling) or space (country). The GDP per capita will be correctly compared against it’s corresponding metric at that year and in that country, but we are then allowing mean values effectively to be made of these results. These models will provide us with a range of R^2 values (coefficients of determination), which is the statistic showing how much of the variance in a dependent variable is explained by the independent variable. This allows us to see which of our metrics have the strongest relationship with GDP per capita. Which we may infer as being related to the prosperity of a nation and it’s people.

# Here we run linear models on all available data against GDP per capita
  # We are not controlling for country or year
lm_data_all <- data_long %>%
  left_join(., gdp_per_capita[,-5], by = c("ccode", "country.name", "year")) %>% 
  rename(., value = value.x, gdp = value.y) %>% 
  group_by(variable) %>% 
  mutate(n = sum(!is.na(gdp))) %>%
  ungroup() %>% 
  nest(-n, -variable) %>%
  mutate(fit = map(data, ~ lm(value ~ gdp, data = .)),
    results = map(fit, glance)) %>% 
  unnest(results) %>%
  select(n, variable, adj.r.squared, p.value) %>% 
  arrange(-adj.r.squared) %>% 
  filter(variable != "gdp_per_capita")

# These data are best represented with a table
knitr::kable(lm_data_all, digits = 3, caption = "R^2 and p-values for the relationship between several metrics and GDP per capita. Years and country of sampling were not controlled for.")

It is possible however that these relationships have not been static over time. We will also want to display the changes in the R^2 values as time series.

# Or we may control for years of sampling
  # This allows us to see if the relationship changes much over time
lm_data_year <- data_long %>% 
  left_join(., gdp_per_capita[,-5], by = c("ccode", "country.name", "year")) %>% 
  rename(., value = value.x, gdp = value.y) %>% 
  group_by(year, variable) %>% 
  mutate(n = sum(!is.na(gdp))) %>%
  ungroup() %>% 
  filter(n > 10) %>% # Require at least 10 data points 
  nest(-n, -year, -variable) %>%
  mutate(fit = map(data, ~ lm(value ~ gdp, data = .)),
    results = map(fit, glance)) %>% 
  unnest(results) %>%
  select(n, variable, year,  adj.r.squared, p.value) %>% 
  arrange(-adj.r.squared) %>% 
  filter(variable != "gdp_per_capita")

# And now for a time series
ggplot(data = lm_data_year, aes(x = year, y = adj.r.squared)) +
  geom_line(aes(colour = variable)) +
  labs(y = "R^2")

# Or we may control for the country of sampling
  # This allows us to see if these relationships 
  # differ in certain parts of the world
lm_data_country <- data_long %>% 
  left_join(., gdp_per_capita[,-5], by = c("ccode", "country.name", "year")) %>% 
  rename(., value = value.x, gdp = value.y) %>% 
  group_by(country.name, variable) %>% 
  mutate(n = sum(!is.na(gdp))) %>%
  ungroup() %>% 
  filter(n > 10) %>% # Require at least 10 data points 
  nest(-n, -country.name, -variable) %>%
  mutate(fit = map(data, ~ lm(value ~ gdp, data = .)),
    results = map(fit, glance)) %>% 
  unnest(results) %>%
  select(n, variable, country.name,  adj.r.squared, p.value) %>% 
  arrange(-adj.r.squared) %>% 
  filter(variable != "gdp_per_capita")

# Create labels for figure
lm_label <- lm_data_country %>% 
  select(n, variable) %>% 
  group_by(variable) %>% 
  summarise(n = sum(n))

# These data allow us to display the range of R^2 values
# for each country with boxplots
  # Just to be cheeky let's use the same themeas Clio Infra
ggplot(data = lm_data_country, aes(x = variable, y = adj.r.squared)) +
  geom_boxplot(outlier.colour = NA) +
  geom_point(colour = "steelblue", alpha = 0.6, position = "jitter") +
  geom_text(data = lm_label, aes(y = -0.1, label = n), 
            colour = "royalblue3") +
  labs(y = "R^2") +
  theme(axis.text.x = element_text(angle = 15))

Years of education of the populace is constantly coming out on top, with gender equality in education in third. These two metrics must be related in some way though so let’s look specifically at that relationship.

data_gender <- years_of_education[,-5] %>% 
  left_join(., gender_equality_education[,-5], by = c("ccode", "country.name", "year")) %>% 
  rename(., education_years = value.x, gender_equality_education = value.y)
data_gender <- data_gender[complete.cases(data_gender$gender_equality_education),]

lm_data_gender1 <- glance(lm(gender_equality_education ~ education_years, data = data_gender))
lm_data_gender2 <- glance(lm(gender_equality_education ~ education_years, 
                             data = filter(data_gender, education_years >= 5)))

# And now for a scatterplot
ggplot(data = data_gender, aes(x = education_years, 
                                  y = gender_equality_education)) +
  geom_point() +
  geom_smooth(colour = "blue", method = "lm") +
  geom_smooth(data = filter(data_gender, education_years >= 5), colour = "red", method = "lm") +
  geom_label(aes(x = 8.5, y = 0.5, label = paste0("blue line\nR^2 = ", 
                                                  round(lm_data_gender1$adj.r.squared,3), 
                                                  "\nred line\nR^2 = ", 
                                                  round(lm_data_gender2$adj.r.squared,3))))

Results

From Table 1 we may see that the three metrics in descending order that best explain the variance occurring in GDP per capita over time and space are: education of the population as a whole, equality between the genders and the equality in education between the genders. Equality in education for the populace as a whole came in at a close fourth and is perhaps a better predictor than equality between genders due to the much higher sample size that the result is based on (this is an oddly well reported metric). The metrics of income inequality for the populace as a whole, equality in numeracy between genders, and the ratio of sex near birth showed significant relationships with GDP per capita but explained little of the variance. The total population of a country has absolutely nothing to do with the GDP per capita when time and space are not controlled for.

We see in Figure 1 that for our top four metrics (education_years, gender_equality_index, gender_equality_education and education_inequality), only education_years shows any consistency over time. We also see that education_inequality has become a much better test of the GDP per capita of a country since the mid 19th century.

Figure 2 shows that there is a very large range in the relationship between many of these metrics and GDP per capita when we control for country of measurement. Interestingly, the total_population of the country is relevant to the GDP per capita when this information is analysed independently by each country. More important than total_population we see are the metrics education_years and gender_equality_index.

When we look at the specific relationship between education_years and gender_equality_education it would at first appear that at an R^2 value of 0.518 this was a strong relationship. Looking more closely at Figure 3 one will notice that this relationship is not linear and that the fit of the linear model is being affected by several scores at very low education levels and equality scores. If one were to only account for scores where the education_years metric is at least 5 years the strength of the relationship falls dramatically to R^2 = 0.199.

Discussion

If one was satisfied to take all of the GDP data and the several metrics of equality used in this analysis and clump them together one would be led to believe that the most important thing for a prosperous society is the overall years of education for that countries citizens. This metric is clearly the most important in Table 1, Figure 1 and Figure 2. Equality in education between the genders is also of great importance, though perhaps half as much so as the overall education of the populace. It leads that a society with more equitable education levels between genders would have a greater proportion of educated people and this is generally so however, Figure 3 shows that if one removes scores from nations with particularly low levels of overall education this relationship falls apart. This is because most countries in the world have relatively even levels of education between genders. There is little pattern here because there is little variance in gender_equality_education once the less educated nations have been removed from the calculation.

More important to GDP than equal education for genders appears to be the overall equality between genders. This value accounts for much more than education alone and appears to better capture how an egalitarian society benefits from the equal treatment of it’s citizens. Clio Infra states that this metric represents:

The composite index aims to evaluate countries’ performances regarding the progress they made in closing the gender gap in the fields of health, socio-economic resources, politics and household since 1950

When I started this research I had assumed that equal education between genders would clearly be a very important metric in regards to a prosperous society. Surprisingly this appears to not be as concrete as expected. It certainly is important, more so than income inequality, for example, but is not as important as the overall equality between the genders. This finding is deceiving though because the equality in education for most countries (not just rich ones) is high. It is the difference in equality between genders generally that shows a broader range, and the difference relates strongly to GDP per capita. So a potential recipe for success seems to be to first ensure that as much of a populace as possible (of all genders) receives as much education as possible. It seems likely that this would then fuel gender equality, but the data don’t show this unilaterally. So to really move a nation to the top of the GDP per capita list would also require an active effort in ensuring well rounded rights to all genders.

Objective

As more and more physical scientists (e.g. oceanographers) move to R from other object oriented command line programming languages, such as Matlab, there will be more and more demand for the code that is needed to do some basic things that they may already know how to do in their previous languages that they don’t yet know how to do in R. Surprisingly, there are many things that should be very easy to find how to do in R that are not. Or are at least not widely publicized. One such example is how to plot wind vectors as a time series. This is a very necessary part of any analysis of the wind or currents in a particular area. Making it useful broadly to most climate scientists. Try as I might, I’ve only been able to find one source that gives an example of how to plot wind (or current) vectors as a time series with ggplot2 in R. Having now been asked how to do this by several people I thought it would be useful to write up my workflow and put it on the internet so that there is one more source that people searching for answers may find.

Data

The data used in this example come from the ERA-Interim reanalysis product. This is an amazing product with dozens of data layers stretched over an even global grid at a native resolution of 0.75°. Here we use the one pixel from this product closest to Cape Town in order to illustrate how to use these data as a time series for a single point in space at a daily resolution for one month (December, 2016). For the purposes of this example we will only be using the following three layers: ‘2 metre temperature’, ‘10 metre U wind component’ and ‘10 metre V wind component’. The data used in this post may be downloaded here.

# First load libraries
library(tidyverse)
library(scales)

# Then data
load('../../static/data/ERA_pixel.Rdata')

Wind Vectors

The data as they exist within ERA-Interim are already in the format that we need. U and V vectors. Had they not been then we would have needed to convert them. The other common format for wind data are bearing (degrees) and speed (m/s). With this information it is possible to use trigonometry to create the necessary U and V vectors. One may do so with the following chunk of code:

## Assuming your data frame is called 'my_df'
# First it is necessary to correct any bearings of '0' to '360'
my_df$bearing[my_df$bearing == 0] <- 360
my_df$u <- (1 * my_df$speed) * sin((my_df$bearing * pi / 180.0))
my_df$v <- (1 * my_df$speed) * cos((my_df$bearing * pi / 180.0))

Assuming that we now have a u and v column in our wind vector data frame, and that the speed of these vectors are in metres per second, we may now use the functionality within ggplot2 to create our wind vector time series. It’s almost anti-climactic how straight forward it all is.

Plotting

As we will be using geom_segment() within ggplot2 to create our wind vectors we will want to maintain some control over the output by introducing a scaling object and a default range for the y axis. For now we will just set the wind scalar to 1. We’ll change it later to see what benefit this extra step adds. I have chosen the range of values for the y_axis below based on what I knew would illustrate my point, not through any a priori statistical analysis.

wind_scale <- 1
y_axis <- seq(-5, 5, 5)

To create a wind vector time series we use the following few lines of code:

ggplot(data = ERA_pixel, aes(x = date, y = y_axis)) +
  # Here we create the wind vectors as a series of segments with arrow tips
    geom_segment(aes(x = date, xend = date + u*wind_scale, y = 0, yend = v*wind_scale), 
                 arrow = arrow(length = unit(0.15, 'cm')), size = 0.5, alpha = 0.7) +
  # I think adding points at the base of the vectors makes the figure easier to read
    geom_point(aes(x = date, y = 0), alpha = 0.5, size = 1) +
  # Changing the dates to better match the range shown on the x axis
    scale_x_date(labels = date_format('%Y-%m-%d'), breaks = date_breaks('4 days')) +
  # Change the y axis labels to make sense
    scale_y_continuous(breaks = y_axis, labels = as.character(abs(y_axis)/wind_scale)) +
  # Change the x and y axis labels
    labs(x = NULL, y = 'Wind Speed (m/s)') +
    coord_equal(ylim = c(min(y_axis/wind_scale), max(y_axis/wind_scale))) +
    theme(axis.text.x = element_text(angle = 20, hjust = 0.4, vjust = 0.5, size = 8),
          axis.text.y = element_text(size = 8))

Visualizing wind data in this way introduces a problem into our figure that we do not normally need to contend with when we create time series figures. That problem is that wind speed/ bearing is a two dimensional value, not one dimensional. Therefore the y axis as well as the x axis must be utilized in order to show the wind speed/ bearing accurately. We find a compromise by using coord_equal() to ensure that every step on the x axis is the same size as the y axis. Thus preventing any distortion of vectors that are showing mostly an East/ West heading.

For particularly windy parts of the world (such as Cape Town) it may be better to scale the wind vectors so as to help them to look a bit more tidy. But if we do this, our x and y axis relationship will no longer be 1 for 1, as with the figure above. That is where our decision to set a static wind scalar and y axis come into play.

# Reset the wind scalar to be half the size
wind_scale <- 0.5

# The exact same code as above
ggplot(data = ERA_pixel, aes(x = date, y = y_axis)) +
    geom_segment(aes(x = date, xend = date + u, y = 0, yend = v), 
                 arrow = arrow(length = unit(0.15, 'cm')), size = 0.5, alpha = 0.7) +
    geom_point(aes(x = date, y = 0), alpha = 0.5, size = 1) +
    scale_x_date(labels = date_format('%Y-%m-%d'), breaks = date_breaks('4 days')) +
    scale_y_continuous(breaks = y_axis/wind_scale, labels = as.character(abs(y_axis)/wind_scale)) +
    labs(x = NULL, y = 'Wind Speed (m/s)') +
    coord_equal(ylim = c(min(y_axis/wind_scale), max(y_axis/wind_scale))) +
    theme(axis.text.x = element_text(angle = 20, hjust = 0.4, vjust = 0.5, size = 8),
          axis.text.y = element_text(size = 8))

By assigning our scaling variable to an object and using it to control the y axis of our ggplot code we may be sure that no matter how we choose to scale our wind variables they will be correctly represented. This does however limit how large our y axis may be as it must be kept to the same ratio as the x axis. Any larger than the figure shown above and we would start to have unappealingly square figures.

Multiple Y Axes

While it may be frowned upon in the tidyverse, there are still many people that like to use multiple y axes within one figure. I’m not going to get into the pro’s and con’s here, but I will say that of all the possible reasons for using multiple y axes, comparing wind vectors against some other variable is more reasonable than most. This is because the wind vectors themselves do not really have a y axis per se. As we’ve seen above, the actual values on the y axis don’t matter as long as they are shown 1 for 1 against whatever is on the x axis. Therefore we may very easily show temperature on the y axis and still overplot wind vectors without needing a proper second y axis. We will however insert a label onto the figure so as to make it clear how the wind vectors are to be estimated.

# Reset the wind scale to 1
wind_scale <- 1

# Now we use temperature for the y axis, so some things must change
ggplot(data = ERA_pixel, aes(x = date, y = temp)) +
    geom_line(colour = 'salmon', show.legend = F, size = 1.5) +
    geom_segment(aes(x = date, xend = date + u, 
                     y = mean(temp, na.rm = T), yend = mean(temp, na.rm = T) +v), 
                 arrow = arrow(length = unit(0.15, 'cm')), size = 0.5, alpha = 0.7) +
    geom_point(aes(x = date, y = mean(temp, na.rm = T)), alpha = 0.5, size = 1) +
  # Create the label box for our wind vector length legend
    geom_label(aes(x = as.Date('2016-12-04'), y = 22, label = '  4 m/s  \n'), size = 5) +
  # Create the segment for the wind vector legend
    geom_segment(aes(x = as.Date('2016-12-02'), xend = as.Date('2016-12-06'), 
                     y = 21.4, yend = 21.4), size = 0.5, alpha = 0.7) +
    scale_x_date(labels = date_format('%Y-%m-%d'), breaks = date_breaks('4 days')) +
    labs(x = NULL, y = 'Temperature (°C)') +
  # Here we choose to allow ggplot to determine the best range for y axis values
    coord_equal() +
    theme(axis.text.x = element_text(angle = 20, hjust = 0.4, vjust = 0.5, size = 8),
          axis.text.y = element_text(size = 8))

I’ll leave it to the reader to decide if this is a reasonable way to visualise these data. But I do know that there is some use for displaying the information in this way. For example, one can clearly see that on days were the temperature decreases rapidly there is a south westerly wind moving over the city. Of course this could still be elucidated were these two figures plotted next to each other via facets, but it should be noted that it isn’t necessary.

Objective

Before we begin, I would like to acknowledge that the framework for this analysis was adapted from a blogpost found on the wonderfully interesting R-bloggers website. The objective of this analysis is to use sentiment analysis on different religious texts to visualise the differences/ similarities between them. This concept is of course fraught with a host of issues. Not least of which being detractors who will likely not endeavour to engage in rational debate against the findings of this work. This is of course beyond the control of the experimental design so I rather focus here on the issue that the translations of the texts used are not modern, and none of them were written (and generally not intended to be read in) English. Therefore a sentiment analysis of these works will be given to a certain amount of inaccuracy because the sentiment database is a recent project and one must assume that the emotions attached to the words in the English language reflect modern sentiment, and not the emotive responses that were necessarily desired at the time of writing/ translation. That being said, the sentiment that these texts would elicit in a reader today (assuming that anyone actually still reads the source material for their faith) would be accurately reflected by the sentiment analysis project and so this issue is arguably a minor one. As a control group (non-religious text), we will be using Pride and Prejudice, by Jane Austen simply because this has already been ported into R and is readily accesible in the package janeaustenr.

For more information on the sentiment analysis project one may find the home page here.

Text Downloads

The following links were used to download the religious texts used in this analysis: