Animating the UK’s Lockdown Tier Maps in R

How to use Twitter, R and creativity to download and build an evolving map GIF!

if(!require("rtweet")) install.packages("rtweet")
if(!require("httpuv")) install.packages("httpuv")
if(!require("tidyverse")) install.packages("tidyverse")
if(!require("magick")) install.packages("magick")
if(!require("magrittr")) install.packages("magrittr")

Scraping Twitter with rtweet

# First let's pull the last 2,000 tweets of data
electionmap_tweets <- get_timeline("ElectionMapsUK", n = 2000)
# After you input these things or use the get_timeline() function a browser window should appear and you can authenticate your twitter account. If you have trouble try registering your token through R
# token <-
# rtweet::create_token(
# app = "Application Name",
# api_key = [your_api_key],
# api_secret = [your_api_secret_key],
# access_token = [your_access_token],
# access_secret = [your_access_secret]
# )
# Because I want to make this as easy for you as possible, I have also saved the data in a rdata file that you can download at my Github and I will call in now
#https://github.com/danderson222/animated-tier-maps
load("tweets.rds")
# Then let's subset the tweets with photos in them in a new dataframe
em_photo_tweets <- electionmap_tweets %>%
subset(media_type=="photo")
# We then subset for the url we see in many different photos that we want to use
# "https://electionmaps.uk/covid19-tier-map"
em_tier_tweets <- em_photo_tweets %>%
mutate(urls_expanded_url = sapply(urls_expanded_url, toString)) %>% # need to turn it from a list to a character vector in order to filter
filter(urls_expanded_url=="https://electionmaps.uk/covid19-tier-map")
# Filter all the tweets that include Tier in it
em_tier_tweets <- filter(em_tier_tweets, grepl("Tier",text))
# When we create the new data frame we have to unlist the media_url column, turning
# it from list to character
images <- data.frame(Date = em_tier_tweets$created_at,
Image = unlist(em_tier_tweets$media_url))
# Cut the timing on the Date column
images$Date <- substr(images$Date, 1, 10)
# Create a folder for the images
dir.create("images")
for (i in 1:nrow(images)) {
row <- images[i,]
download.file(images[i,2], destfile = paste0('images/TierMap_',images[i,1],'.jpg'),
mode="wb")
}
# This downloads 20 images, so be aware!
# We notice that four images are not Tier Maps or have text over the maps, so let's just go ahead and delete those manually
file.remove(c("images/TierMap_2020-12-01.jpg", "images/TierMap_2020-12-15.jpg",
"images/TierMap_2020-11-28.jpg", "images/TierMap_2020-12-22.jpg"))

Editing & Animating the Maps

# Read in all the image names from your folder
# Create a vector with all the dates to be read onto each image
dates <- list.files("images") %>%
substr(9,18)
listOfFiles <- list.files(path = "images",
full.names = TRUE)
# Resize the images in bulk thanks to a function found here https://www.ben-johnston.co.uk/bulk-resizing-images-with-r/
imageResizeR <- function(z, a){
listOfFiles <- list.files(path = z,
full.names = TRUE)
imageResizing <- for(i in 1:length(listOfFiles)){
imFile <- image_read(listOfFiles[i])
resized <- image_scale(imFile, a)
dated <- image_annotate(resized, dates[i], gravity = "northwest", size = 40,
color = "black", boxcolor = "lightgrey")
image_write(dated,
paste(listOfFiles[i]))
}
}
imageResizeR("images", "500x750")
list.files(path="images", pattern = '*.jpg', full.names = TRUE) %>% 
image_read() %>% # reads each path file
image_join() %>% # joins image
image_animate(fps=4, delay = 200) %>% # animates, can opt for number of loops
image_write("TierMaps.gif") # write to current dir
Image created by the author, edited with permission from ElectionMapsUK

--

--

Get the Medium app

A button that says 'Download on the App Store', and if clicked it will lead you to the iOS App store
A button that says 'Get it on, Google Play', and if clicked it will lead you to the Google Play store
Dylan Anderson

Data Strategy Lead at Redkite. Code in R & blog about politics using data. Connect on LinkedIn, Twitter or at my blog policyinnumbers.com