Back Home

Setup

library(rjson)
library(dplyr)
library(readr)
library(purrr)
library(ggplot2)
library(geosphere)
library(gridExtra)
library(maps)

The data comes from Google Flights. On Nov 2nd, 2019 I collected all direct flights destinations for each day between Nov 24th and Nov 30th, for each major airport: Havana, Varadero, Santa Clara, Camaguey, Holguin and Santiago de Cuba. Also, wrote a blog post on how I got the data.

json_data <- fromJSON(file = "DATA/flight-data.json")

# Convert json file into dataframe
data = suppressWarnings(json_data %>% imap(function(airport, airport_code) {
  airport %>% imap(function(day, day_name) {
      day %>% lapply(function(x) {
          as.data.frame(list(
            price=ifelse(is.null(x$price) || x$price == '', NA, x$price),
            duration=ifelse(is.null(x$duration), NA, x$duration),
            city=ifelse(is.null(x$destination), NA, x$destination),
            day=day_name,
            cu_code=airport_code
          ))
        }) %>% bind_rows
  }) %>% bind_rows
}) %>% bind_rows)

We also have airport information location from the open flights datasets.

# download.file("https://raw.githubusercontent.com/jpatokal/openflights/master/data/airports.dat", destfile = "DATA/airports.dat", mode = "wb")
airport_codes <- fread("DATA/airports.dat", sep = ",")
colnames(airport_codes) <- c("airport_id", "name", "city", "country", "iata", "icao", "latitude", "longitude",  "altitude", "timezone", "dst", "tz_database_time_zone", "type", "source")

# Simplify the dataset
airport_codes = airport_codes[, c(3, 4, 5, 7, 8)]
names(airport_codes) = c("city", "country", 'code', 'lat', 'lon')

airport_codes_mappings = airport_codes %>%
  select(city, code) %>%
  group_by(city) %>%
  filter(substr(code, 1, 1) != '\\') %>%
  top_n(1) %>%
  bind_rows(read_csv('DATA/airport-code-mapping.csv'))

data = data %>%
  left_join(airport_codes_mappings) %>%
  select(day, cu_code, code) %>%
  left_join(airport_codes) %>%
  left_join((airport_codes %>% select(code, lat, lon) %>% rename(cu_lat=lat, cu_lon=lon)), by=(c('cu_code'='code')))

Define utility functions, since the goal is to render a graph for each airport.

data_for_connection=function( dep_lon, dep_lat, arr_lon, arr_lat, group){
  inter <- gcIntermediate(c(dep_lon, dep_lat), c(arr_lon, arr_lat), n=50, addStartEnd=TRUE, breakAtDateLine=F)
  inter=data.frame(inter)
  inter$group=NA
  diff_of_lon=abs(dep_lon) + abs(arr_lon)
  if(diff_of_lon > 180){
    inter$group[which(inter$lon>=0)]=paste(group, "A",sep="")
    inter$group[which(inter$lon<0)]=paste(group, "B",sep="")
  } else {
    inter$group=group
  }
  return(inter)
}

data_for_plot = function(data, airport_code) {
  data_ready_plot=data.frame()
  for(i in c(1:nrow(data))){
    tmp=data_for_connection(data$cu_lon[i], data$cu_lat[i], data$lon[i], data$lat[i] , i)
    tmp$cancel = ifelse(data$country[i] == 'United States' && data$cu_code != 'HAV', 'yes', 'no')
    data_ready_plot=rbind(data_ready_plot, tmp)
  }
  data_ready_plot
}

The plot

Save the plots

ggsave("IMG/cuba-flights.png", width = 24, height = 24*405/440, units = "in", dpi = 100, g)

Inspiration

I took inspiration from several sources to generate these.

The color scheme came from NASA’s world photo. https://earthobservatory.nasa.gov/images/79765/night-lights-2012-map
This article gave me the initial idea. https://lucidmanager.org/create-air-travel-route-maps/

LS0tCnRpdGxlOiAnRmxpZ2h0cyBvdXQgb2YgQ3ViYScKb3V0cHV0OgogIGh0bWxfbm90ZWJvb2s6CiAgICB0b2M6IGZhbHNlCi0tLQoKQmFjayBbSG9tZV0oaHR0cDovL2FyaWVscm9kcmlndWV6cm9tZXJvLmNvbS9jdWJhLXBsb3RzLykKCiMgU2V0dXAKCmBgYHtyLCB3YXJuaW5nPUZBTFNFLG1lc3NhZ2U9RkFMU0V9CmxpYnJhcnkocmpzb24pCmxpYnJhcnkoZHBseXIpCmxpYnJhcnkocmVhZHIpCmxpYnJhcnkocHVycnIpCmxpYnJhcnkoZ2dwbG90MikKbGlicmFyeShnZW9zcGhlcmUpCmxpYnJhcnkoZ3JpZEV4dHJhKQpsaWJyYXJ5KG1hcHMpCmxpYnJhcnkoZGF0YS50YWJsZSkKYGBgCgpUaGUgZGF0YSBjb21lcyBmcm9tIEdvb2dsZSBGbGlnaHRzLiBPbiBOb3YgMm5kLCAyMDE5IEkgY29sbGVjdGVkIGFsbCBkaXJlY3QgZmxpZ2h0cyBkZXN0aW5hdGlvbnMgZm9yIGVhY2ggZGF5IGJldHdlZW4gTm92IDI0dGggYW5kIE5vdiAzMHRoLCBmb3IgZWFjaCBtYWpvciBhaXJwb3J0OiBIYXZhbmEsIFZhcmFkZXJvLCBTYW50YSBDbGFyYSwgQ2FtYWd1ZXksIEhvbGd1aW4gYW5kIFNhbnRpYWdvIGRlIEN1YmEuIEFsc28sIHdyb3RlIGEgW2Jsb2cgcG9zdF0oaHR0cDovL2FyaWVscm9kcmlndWV6cm9tZXJvLmNvbS9ibG9nL2dldC1yb3V0ZS1pbmZvcm1hdGlvbi1nb29nbGUtZmxpZ2h0cy0yMDE5Lmh0bWwpIG9uIGhvdyBJIGdvdCB0aGUgZGF0YS4KCmBgYHtyLCB3YXJuaW5nPUZBTFNFLCBtZXNzYWdlPUZBTFNFfQpqc29uX2RhdGEgPC0gZnJvbUpTT04oZmlsZSA9ICJEQVRBL2ZsaWdodC1kYXRhLmpzb24iKQoKIyBDb252ZXJ0IGpzb24gZmlsZSBpbnRvIGRhdGFmcmFtZQpkYXRhID0gc3VwcHJlc3NXYXJuaW5ncyhqc29uX2RhdGEgJT4lIGltYXAoZnVuY3Rpb24oYWlycG9ydCwgYWlycG9ydF9jb2RlKSB7CiAgYWlycG9ydCAlPiUgaW1hcChmdW5jdGlvbihkYXksIGRheV9uYW1lKSB7CiAgICAgIGRheSAlPiUgbGFwcGx5KGZ1bmN0aW9uKHgpIHsKICAgICAgICAgIGFzLmRhdGEuZnJhbWUobGlzdCgKICAgICAgICAgICAgcHJpY2U9aWZlbHNlKGlzLm51bGwoeCRwcmljZSkgfHwgeCRwcmljZSA9PSAnJywgTkEsIHgkcHJpY2UpLAogICAgICAgICAgICBkdXJhdGlvbj1pZmVsc2UoaXMubnVsbCh4JGR1cmF0aW9uKSwgTkEsIHgkZHVyYXRpb24pLAogICAgICAgICAgICBjaXR5PWlmZWxzZShpcy5udWxsKHgkZGVzdGluYXRpb24pLCBOQSwgeCRkZXN0aW5hdGlvbiksCiAgICAgICAgICAgIGRheT1kYXlfbmFtZSwKICAgICAgICAgICAgY3VfY29kZT1haXJwb3J0X2NvZGUKICAgICAgICAgICkpCiAgICAgICAgfSkgJT4lIGJpbmRfcm93cwogIH0pICU+JSBiaW5kX3Jvd3MKfSkgJT4lIGJpbmRfcm93cykKYGBgCgpXZSBhbHNvIGhhdmUgYWlycG9ydCBpbmZvcm1hdGlvbiBsb2NhdGlvbiBmcm9tIHRoZSBbb3BlbiBmbGlnaHRzXShodHRwczovL29wZW5mbGlnaHRzLm9yZy9kYXRhLmh0bWwpIGRhdGFzZXRzLgoKYGBge3IsIHdhcm5pbmc9RkFMU0UsbWVzc2FnZT1GQUxTRX0KIyBkb3dubG9hZC5maWxlKCJodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vanBhdG9rYWwvb3BlbmZsaWdodHMvbWFzdGVyL2RhdGEvYWlycG9ydHMuZGF0IiwgZGVzdGZpbGUgPSAiREFUQS9haXJwb3J0cy5kYXQiLCBtb2RlID0gIndiIikKYWlycG9ydF9jb2RlcyA8LSBmcmVhZCgiREFUQS9haXJwb3J0cy5kYXQiLCBzZXAgPSAiLCIpCmNvbG5hbWVzKGFpcnBvcnRfY29kZXMpIDwtIGMoImFpcnBvcnRfaWQiLCAibmFtZSIsICJjaXR5IiwgImNvdW50cnkiLCAiaWF0YSIsICJpY2FvIiwgImxhdGl0dWRlIiwgImxvbmdpdHVkZSIsICAiYWx0aXR1ZGUiLCAidGltZXpvbmUiLCAiZHN0IiwgInR6X2RhdGFiYXNlX3RpbWVfem9uZSIsICJ0eXBlIiwgInNvdXJjZSIpCgojIFNpbXBsaWZ5IHRoZSBkYXRhc2V0CmFpcnBvcnRfY29kZXMgPSBhaXJwb3J0X2NvZGVzWywgYygzLCA0LCA1LCA3LCA4KV0KbmFtZXMoYWlycG9ydF9jb2RlcykgPSBjKCJjaXR5IiwgImNvdW50cnkiLCAnY29kZScsICdsYXQnLCAnbG9uJykKCmFpcnBvcnRfY29kZXNfbWFwcGluZ3MgPSBhaXJwb3J0X2NvZGVzICU+JQogIHNlbGVjdChjaXR5LCBjb2RlKSAlPiUKICBncm91cF9ieShjaXR5KSAlPiUKICBmaWx0ZXIoc3Vic3RyKGNvZGUsIDEsIDEpICE9ICdcXCcpICU+JQogIHRvcF9uKDEpICU+JQogIGJpbmRfcm93cyhyZWFkX2NzdignREFUQS9haXJwb3J0LWNvZGUtbWFwcGluZy5jc3YnKSkKCmRhdGEgPSBkYXRhICU+JQogIGxlZnRfam9pbihhaXJwb3J0X2NvZGVzX21hcHBpbmdzKSAlPiUKICBzZWxlY3QoZGF5LCBjdV9jb2RlLCBjb2RlKSAlPiUKICBsZWZ0X2pvaW4oYWlycG9ydF9jb2RlcykgJT4lCiAgbGVmdF9qb2luKChhaXJwb3J0X2NvZGVzICU+JSBzZWxlY3QoY29kZSwgbGF0LCBsb24pICU+JSByZW5hbWUoY3VfbGF0PWxhdCwgY3VfbG9uPWxvbikpLCBieT0oYygnY3VfY29kZSc9J2NvZGUnKSkpCmBgYAoKRGVmaW5lIHV0aWxpdHkgZnVuY3Rpb25zLCBzaW5jZSB0aGUgZ29hbCBpcyB0byByZW5kZXIgYSBncmFwaCBmb3IgZWFjaCBhaXJwb3J0LgoKYGBge3J9CmRhdGFfZm9yX2Nvbm5lY3Rpb249ZnVuY3Rpb24oIGRlcF9sb24sIGRlcF9sYXQsIGFycl9sb24sIGFycl9sYXQsIGdyb3VwKXsKICBpbnRlciA8LSBnY0ludGVybWVkaWF0ZShjKGRlcF9sb24sIGRlcF9sYXQpLCBjKGFycl9sb24sIGFycl9sYXQpLCBuPTUwLCBhZGRTdGFydEVuZD1UUlVFLCBicmVha0F0RGF0ZUxpbmU9RikKICBpbnRlcj1kYXRhLmZyYW1lKGludGVyKQogIGludGVyJGdyb3VwPU5BCiAgZGlmZl9vZl9sb249YWJzKGRlcF9sb24pICsgYWJzKGFycl9sb24pCiAgaWYoZGlmZl9vZl9sb24gPiAxODApewogICAgaW50ZXIkZ3JvdXBbd2hpY2goaW50ZXIkbG9uPj0wKV09cGFzdGUoZ3JvdXAsICJBIixzZXA9IiIpCiAgICBpbnRlciRncm91cFt3aGljaChpbnRlciRsb248MCldPXBhc3RlKGdyb3VwLCAiQiIsc2VwPSIiKQogIH0gZWxzZSB7CiAgICBpbnRlciRncm91cD1ncm91cAogIH0KICByZXR1cm4oaW50ZXIpCn0KCmRhdGFfZm9yX3Bsb3QgPSBmdW5jdGlvbihkYXRhLCBhaXJwb3J0X2NvZGUpIHsKICBkYXRhX3JlYWR5X3Bsb3Q9ZGF0YS5mcmFtZSgpCiAgZm9yKGkgaW4gYygxOm5yb3coZGF0YSkpKXsKICAgIHRtcD1kYXRhX2Zvcl9jb25uZWN0aW9uKGRhdGEkY3VfbG9uW2ldLCBkYXRhJGN1X2xhdFtpXSwgZGF0YSRsb25baV0sIGRhdGEkbGF0W2ldICwgaSkKICAgIHRtcCRjYW5jZWwgPSBpZmVsc2UoZGF0YSRjb3VudHJ5W2ldID09ICdVbml0ZWQgU3RhdGVzJyAmJiBkYXRhJGN1X2NvZGUgIT0gJ0hBVicsICd5ZXMnLCAnbm8nKQogICAgZGF0YV9yZWFkeV9wbG90PXJiaW5kKGRhdGFfcmVhZHlfcGxvdCwgdG1wKQogIH0KICBkYXRhX3JlYWR5X3Bsb3QKfQpgYGAKCiMjIFRoZSBwbG90CgpgYGB7cn0Kd29ybGRfZGF0YSA9IG1hcF9kYXRhKCJ3b3JsZCIpICU+JSBmaWx0ZXIocmVnaW9uICE9ICJBbnRhcmN0aWNhIikKCm1hcF90aGVtZSA9IHRoZW1lKHBhbmVsLmJhY2tncm91bmQgPSBlbGVtZW50X3JlY3QoZmlsbCA9ICIjMDAwMDAwIiwgY29sb3VyID0gIiMwNTA1MGYiKSwKICAgICAgICBwYW5lbC5ncmlkLm1ham9yID0gZWxlbWVudF9ibGFuaygpLAogICAgICAgIHBhbmVsLmdyaWQubWlub3IgPSBlbGVtZW50X2JsYW5rKCksCiAgICAgICAgYXhpcy50aXRsZSA9IGVsZW1lbnRfYmxhbmsoKSwKICAgICAgICBheGlzLnRleHQgPSBlbGVtZW50X2JsYW5rKCksCiAgICAgICAgYXhpcy50aWNrcy5sZW5ndGggPSB1bml0KDAsICJjbSIpLAogICAgICAgIGxlZ2VuZC5wb3NpdGlvbiA9ICJub25lIiwKICAgICAgICBwbG90Lm1hcmdpbiA9IHVuaXQoYygwLDAsMCwwKSwgImNtIiksCiAgICAgICAgcGxvdC5iYWNrZ3JvdW5kPWVsZW1lbnRfcmVjdChmaWxsID0gIiMwMDAwMDAiLCBjb2xvdXIgPSAiIzA1MDUwZiIpKQoKY2l0eV9uYW1lcyA9IGxpc3QoSEFWPSdIYXZhbmEnLCBWUkE9J1ZhcmFkZXJvJywgU05VPSdTYW50YSBDbGFyYScsIENNVz0nQ2FtYWd1ZXknLCBIT0c9J0hvbGd1aW4nLCBTQ1U9J1NhbnRpYWdvIGRlIEN1YmEnKQoKbWFwcyA9IGRhdGEkY3VfY29kZSAlPiUgdW5pcXVlICU+JQogIGxhcHBseShmdW5jdGlvbihjdXJyZW50X2NvZGUpIHsKICAgIGRhdGFfcmVhZHlfcGxvdCA9IGRhdGFfZm9yX3Bsb3QoZmlsdGVyKGRhdGEsIGN1X2NvZGU9PWN1cnJlbnRfY29kZSksIGN1cnJlbnRfY29kZSkKICAgIGdncGxvdCh3b3JsZF9kYXRhLCBhZXMobG9uZywgbGF0LCBncm91cCA9IHBhc3RlKHJlZ2lvbiwgZ3JvdXApKSkgKwogICAgICBnZW9tX3BvbHlnb24oZmlsbD0nIzI2MjUzNycsIGNvbG91cj0nIzFCMUIyOCcpICsKICAgICAgY29vcmRfZml4ZWQoKSArCiAgICAgIGdlb21fbGluZShkYXRhPWRhdGFfcmVhZHlfcGxvdCwgc2l6ZT0wLjQsIGFscGhhPTAuNCwgYWVzKHg9bG9uLCB5PWxhdCwgZ3JvdXA9Z3JvdXAsIGNvbG91cj1jYW5jZWwpKSArCiAgICAgIGFubm90YXRlKCJ0ZXh0IiwgeCA9IC0xNTAsIHkgPSAtNDQsIGhqdXN0ID0gMCwgc2l6ZT0gNCwgbGFiZWwgPSBwYXN0ZShjaXR5X25hbWVzW1tjdXJyZW50X2NvZGVdXSksIGNvbG9yID0gIndoaXRlIikgKwogICAgICBzY2FsZV9jb2xvcl9tYW51YWwodmFsdWVzID0gYygnI2ZmZmZiMicsICdyZWQnKSkgKwogICAgICB4bGltKC0xNTAsIDcwKSArIHlsaW0oLTU1LCA4MCkgKwogICAgICBtYXBfdGhlbWUKICB9KQoKcG5nKGJnID0gIiMwMDAwMDAiKQpncmlkLmFycmFuZ2UobWFwc1tbMV1dLCBtYXBzW1syXV0sIG1hcHNbWzVdXSwgbWFwc1tbM11dLCBtYXBzW1s2XV0sIG1hcHNbWzRdXSwgbmNvbCA9IDIsIHBhZGRpbmc9MCkKYGBgCgpTYXZlIHRoZSBwbG90cwoKYGBge3J9Cmdnc2F2ZSgiSU1HL2N1YmEtZmxpZ2h0cy5wbmciLCB3aWR0aCA9IDI0LCBoZWlnaHQgPSAyNCo0MDUvNDQwLCB1bml0cyA9ICJpbiIsIGRwaSA9IDEwMCkKYGBgCgojIyMgSW5zcGlyYXRpb24KCkkgdG9vayBpbnNwaXJhdGlvbiBmcm9tIHNldmVyYWwgc291cmNlcyB0byBnZW5lcmF0ZSB0aGVzZS4KCi0gVGhlIGNvbG9yIHNjaGVtZSBjYW1lIGZyb20gTkFTQSdzIHdvcmxkIHBob3RvLiBodHRwczovL2VhcnRob2JzZXJ2YXRvcnkubmFzYS5nb3YvaW1hZ2VzLzc5NzY1L25pZ2h0LWxpZ2h0cy0yMDEyLW1hcAotIFRoaXMgYXJ0aWNsZSBnYXZlIG1lIHRoZSBpbml0aWFsIGlkZWEuIGh0dHBzOi8vbHVjaWRtYW5hZ2VyLm9yZy9jcmVhdGUtYWlyLXRyYXZlbC1yb3V0ZS1tYXBzLwo=

Flights out of Cuba

Setup

The plot

Inspiration