Travel map using icons from font awesome and the ggmap package

a map of travel over the years as an animated gif:

Earlier I’d built a shiny app travel map using the same data with sliders controlling the year range. This time wanted something a bit more portable showing the data points individually by year, otherwise it gets a bit crowded. The R code to build the image is below.

require(ggmap); require(ggplot2); require(dplyr); require(png); require(emojifont)

Starting from a spreadsheet of residential and travel locations by year and type of travel - residence, project, meeting (more than 3 weeks of meetings on the same trip got tagged as a project) and general travel for pleasure. Reading the file to show the first rows from the spreadsheet:

myLocs <- read.csv("Locs.csv", header = TRUE, stringsAsFactors = FALSE)
myLocs$LocType <- as.factor(myLocs$LocType)
head(myLocs)
##              town LocType Year
## 1    Acapulco, MX  Travel 1997
## 2 Albaquerque, NM  Travel 2015
## 3   Amsterdam, NL Meeting 2012
## 4   Amsterdam, NL Project 1986
## 5   Amsterdam, NL  Travel 2013
## 6   Amsterdam, NL Meeting 2013

The Google geocode API provides latitude, longitude values from the location names

geoCodes <- geocode(unique(myLocs$town), messaging=FALSE) #Issues LOTS of messages when left on for testing
geoCodes$town <- unique(myLocs$town)
myLocs <- merge(myLocs, geoCodes)
names(myLocs) <- c("town", "LocType", "Year", "Long", "Lat")
head(myLocs)
##              town LocType Year        Long      Lat
## 1    Acapulco, MX  Travel 1997  -99.823653 16.85311
## 2 Albaquerque, NM  Travel 2015 -106.605553 35.08533
## 3   Amsterdam, NL Meeting 2012    4.895168 52.37022
## 4   Amsterdam, NL Project 1986    4.895168 52.37022
## 5   Amsterdam, NL  Travel 2013    4.895168 52.37022
## 6   Amsterdam, NL Meeting 2013    4.895168 52.37022
summary(myLocs)
##      town              LocType         Year           Long         
##  Length:422         Home   : 49   Min.   :1965   Min.   :-123.121  
##  Class :character   Meeting:120   1st Qu.:1987   1st Qu.: -88.107  
##  Mode  :character   Project: 34   Median :1995   Median : -66.360  
##                     Travel :219   Mean   :1996   Mean   : -31.143  
##                                   3rd Qu.:2008   3rd Qu.:   4.895  
##                                   Max.   :2016   Max.   : 151.209  
##       Lat        
##  Min.   :-37.81  
##  1st Qu.: 35.17  
##  Median : 41.87  
##  Mean   : 38.48  
##  3rd Qu.: 48.86  
##  Max.   : 63.43
saveRDS(myLocs, file = "myLocs.RDS")
inp <- gzfile("myLocs.RDS")
myLocs <- readRDS(inp)
close(inp)

To prepare the data for a world map (arbitrarily) set a starting year of ’77, choose an icon from font awesome for each type of travel location and prepared a base world map. For available font awesome icons see link

myLocs <- 
    arrange(myLocs, Year, LocType, town) %>% 
    filter(Year > 1976)

load.fontawesome() #icons for the different travel types
fa <- data.frame(LocType=c("Home", "Project", "Meeting", "Travel"),
                 fnt=fontawesome(c('fa-home', 'fa-coffee', 'fa-plane', 'fa-child')))
myColors <- c("#e7298a", "#1b9e77", "#8c510a", "#3288bd")

myLocs <- inner_join(myLocs, fa) #link location list to geocodes
mbound <- c(min(myLocs$Long), #min/max longitude/latitude to display on the map
        min(myLocs$Lat),
        max(myLocs$Long),
        max(myLocs$Lat))
worldmap <- get_stamenmap(bbox=mbound, zoom = 3, maptype="watercolor") #get the base map from stamen maps

A function is created to plot the map for each year. Decided to plot an extra frame in years where the home location moved just to emphasize that, otherwise calls for a given year - passed as a parameter will plot one frame for the year saved as a .png file

map_year <- function(y, file=FALSE){
    t <- filter(myLocs, Year == y & LocType == "Travel")
    m <- filter(myLocs, Year == y & LocType == "Meeting")
    p <- filter(myLocs, Year == y & LocType == "Project")
    h <- filter(myLocs, Year == y & LocType == "Home")
    b <- rbind(h,h,h) #b makes sure all types are used each year for consistent legend
    b$LocType <- c("Travel", "Meeting", "Project")

    if(length(h$LocType)> 1){ #extra plot in years home changed
        if (file){
            png(paste0(y,"-0.png"), width=970, height=600)
        }

    #    windows() #only necessary if using RStudio display
        print({
            ggmap(worldmap) + 
                geom_point(data=b, aes(x=Long, y=Lat, color=LocType), size=2, alpha=0.1) +
                geom_text(data=h,  aes(x=Long, y=Lat, color=LocType, label=fnt), family='fontawesome-webfont') +
                scale_color_manual(values=myColors) +
                labs(title=paste0("Year= ", y)) + 
                theme(axis.line=element_blank(),axis.text.x=element_blank(),
                      axis.text.y=element_blank(),axis.ticks=element_blank(),
                      axis.title.x=element_blank(), axis.title.y=element_blank()
                ) 
        })
        if (file){
            dev.off()
        }
    }    
    
    if (file){
        png(paste0(y,"-1.png"), width=970, height=600)
    }
#    windows() #only necessary if using RStudio display
    
    print({
        ggmap(worldmap) + 
        geom_point(data=b, aes(x=Long, y=Lat, color=LocType), size=2, alpha=0.1) +
        geom_text(data=t, aes(x=Long, y=Lat, color=LocType, label=fnt), position="jitter", family='fontawesome-webfont') +
        geom_text(data=m, aes(x=Long, y=Lat, color=LocType, label=fnt), position="jitter", family='fontawesome-webfont') +
        geom_text(data=p,  aes(x=Long, y=Lat, color=LocType, label=fnt), family='fontawesome-webfont') +
        geom_text(data=h,  aes(x=Long, y=Lat, color=LocType, label=fnt), family='fontawesome-webfont') +
        scale_color_manual(values=myColors) +
        labs(title=paste0("Year= ", y)) + 
        theme(axis.line=element_blank(),axis.text.x=element_blank(),
              axis.text.y=element_blank(),axis.ticks=element_blank(),
              axis.title.x=element_blank(), axis.title.y=element_blank()
              ) 
    })
    if (file){
        dev.off()
    }
    y
}

and a loop to create the image for each year as .png output

for (i in unique(myLocs$Year)){
    print(i) #see progress
    map_year(i, file=TRUE)
}