Thom Yorke GIFs, spotifyr, and ggplot2

The other day I found a really cool post on adding GIFs to ggplots, so I thought I’d give it a shot. Using spotifyr and ggplot2, I set out to plot Thom Yorke dancing across a plot describing Thom Yorke dancing. For those who have no idea who Thom Yorke is, he’s the frontman of Radiohead and Atoms for Peace, and he dances like this: Mr. Yorke’s dance moves are already well GIF-ified, but finding a transparent GIF to add to a plot proved difficult. After some Googling, I decided to take these images of an animated Thom Yorke doing the Lotus Flower dance. I made them transparent with Preview for Mac and combined them into a GIF with imagemagick. I then read the GIF into R with the magick library.

library(tidyverse)
library(magick)

img_dir <- '../../static/img/projects/thom-yorke/'

mini_thom <- image_read(str_glue('{img_dir}/thom_dance_og.gif'))
mini_thom

To get data on danceability, I used spotifyr to pull track audio features for all albums by Radiohead, Atoms for Peace, and Thom Yorke’s self-titled solo act. I then filtered out non-studio albums and kept only danceability and track/album information.

“Danceability describes how suitable a track is for dancing based on a combination of musical elements including tempo, rhythm stability, beat strength, and overall regularity. A value of 0.0 is least danceable and 1.0 is most danceable.”

library(spotifyr)
library(tidyverse)

tots_thom <- map_df(c('radiohead', 'atoms for peace', 'thom yorke'), get_artist_audio_features)

non_studio_albums <- c('OK Computer OKNOTOK 1997 2017', 'TKOL RMX 1234567', 'In Rainbows Disk 2', 
                       'Com Lag: 2+2=5', 'I Might Be Wrong', 'The Eraser Rmxs')

tots_thom <- filter(tots_thom, !album_name %in% non_studio_albums) %>% 
    select(track_name, album_name, danceability, album_release_year) %>% 
    arrange(-danceability)

library(knitr)
library(kableExtra)
tots_thom %>% 
    kable() %>% 
    kable_styling() %>% 
    scroll_box(height = '500px')
track_name album_name danceability album_release_year
Judge Jury And Executioner AMOK 0.890 2013-02-25
Default AMOK 0.793 2013-02-25
A Brain in a Bottle Tomorrows Modern Boxes 0.787 2014-01-01
Guess Again! Tomorrows Modern Boxes 0.725 2014-01-01
Lotus Flower The King Of Limbs 0.721 2011-02-18
Backdrifts Hail To the Thief 0.718 2003-01-01
Skip Divided The Eraser 0.711 2006-07-10
House Of Cards In Rainbows 0.710 2007-12-28
Harrowdown Hill The Eraser 0.705 2006-07-10
Separator The King Of Limbs 0.693 2011-02-18
Identikit A Moon Shaped Pool 0.692 2016-05-08
Ingenue AMOK 0.684 2013-02-25
All I Need In Rainbows 0.668 2007-12-28
Packt Like Sardines In a Crushed Tin Box Amnesiac 0.667 2001-03-12
Morning Mr Magpie The King Of Limbs 0.648 2011-02-18
Morning Bell Kid A 0.645 2000-10-01
Stuck Together Pieces AMOK 0.643 2013-02-25
Atoms For Peace The Eraser 0.643 2006-07-10
There Is No Ice (For My Drink) Tomorrows Modern Boxes 0.641 2014-01-01
Kid A Kid A 0.630 2000-10-01
The Eraser The Eraser 0.629 2006-07-10
Little By Little The King Of Limbs 0.619 2011-02-18
Amok AMOK 0.618 2013-02-25
Idioteque Kid A 0.615 2000-10-01
There, There Hail To the Thief 0.614 2003-01-01
Black Swan The Eraser 0.613 2006-07-10
Dropped AMOK 0.611 2013-02-25
A Punch Up At a Wedding Hail To the Thief 0.603 2003-01-01
I Might Be Wrong Amnesiac 0.601 2001-03-12
15 Step In Rainbows 0.600 2007-12-28
Cymbal Rush The Eraser 0.594 2006-07-10
The Mother Lode Tomorrows Modern Boxes 0.589 2014-01-01
Videotape In Rainbows 0.581 2007-12-28
Unless AMOK 0.581 2013-02-25
Pulk/Pull Revolving Doors Amnesiac 0.580 2001-03-12
The Clock The Eraser 0.572 2006-07-10
Desert Island Disk A Moon Shaped Pool 0.561 2016-05-08
Decks Dark A Moon Shaped Pool 0.560 2016-05-08
Analyse The Eraser 0.560 2006-07-10
Before Your Very Eyes… AMOK 0.552 2013-02-25
Burn the Witch A Moon Shaped Pool 0.541 2016-05-08
Weird Fishes/ Arpeggi In Rainbows 0.538 2007-12-28
Nude In Rainbows 0.537 2007-12-28
Reckoner In Rainbows 0.518 2007-12-28
Bloom The King Of Limbs 0.518 2011-02-18
Nose Grows Some Tomorrows Modern Boxes 0.517 2014-01-01
Creep Pablo Honey 0.515 1993-02-22
Myxomatosis Hail To the Thief 0.499 2003-01-01
Like Spinning Plates Amnesiac 0.493 2001-03-12
Scatterbrain Hail To the Thief 0.492 2003-01-01
Feral The King Of Limbs 0.490 2011-02-18
Street Spirit (Fade Out) The Bends 0.488 1995-03-28
The National Anthem Kid A 0.486 2000-10-01
Sit Down. Stand Up Hail To the Thief 0.483 2003-01-01
A Wolf At the Door Hail To the Thief 0.480 2003-01-01
Present Tense A Moon Shaped Pool 0.479 2016-05-08
Jigsaw Falling Into Place In Rainbows 0.461 2007-12-28
Fake Plastic Trees The Bends 0.454 1995-03-28
Bullet Proof … I Wish I Was The Bends 0.448 1995-03-28
2 + 2 = 5 Hail To the Thief 0.443 2003-01-01
The Gloaming Hail To the Thief 0.440 2003-01-01
Knives Out Amnesiac 0.433 2001-03-12
Fitter Happier OK Computer 0.432 1997-05-28
Planet Telex The Bends 0.429 1995-03-28
Ful Stop A Moon Shaped Pool 0.426 2016-05-08
Lurgee Pablo Honey 0.420 1993-02-22
Reverse Running AMOK 0.419 2013-02-25
High And Dry The Bends 0.418 1995-03-28
Optimistic Kid A 0.403 2000-10-01
Vegetable Pablo Honey 0.384 1993-02-22
In Limbo Kid A 0.375 2000-10-01
Sail To The Moon Hail To the Thief 0.372 2003-01-01
Thinking About You Pablo Honey 0.364 1993-02-22
Karma Police OK Computer 0.360 1997-05-28
Bones The Bends 0.358 1995-03-28
Let Down OK Computer 0.352 1997-05-28
Interference Tomorrows Modern Boxes 0.349 2014-01-01
Bodysnatchers In Rainbows 0.343 2007-12-28
Faust Arp In Rainbows 0.338 2007-12-28
Tinker Tailor Soldier Sailor Rich Man Poor Man Beggar Man Thief A Moon Shaped Pool 0.336 2016-05-08
Untitled Kid A 0.327 2000-10-01
Codex The King Of Limbs 0.327 2011-02-18
Morning Bell/Amnesiac Amnesiac 0.325 2001-03-12
Dollars & Cents Amnesiac 0.325 2001-03-12
Subterranean Homesick Alien OK Computer 0.316 1997-05-28
Truth Ray Tomorrows Modern Boxes 0.311 2014-01-01
Airbag OK Computer 0.306 1997-05-28
And It Rained All Night The Eraser 0.306 2006-07-10
Hunting Bears Amnesiac 0.302 2001-03-12
Daydreaming A Moon Shaped Pool 0.299 2016-05-08
Where I End and You Begin Hail To the Thief 0.297 2003-01-01
You And Whose Army? Amnesiac 0.295 2001-03-12
Anyone Can Play Guitar Pablo Honey 0.294 1993-02-22
Everything In Its Right Place Kid A 0.293 2000-10-01
Exit Music (For a Film) OK Computer 0.293 1997-05-28
Just The Bends 0.291 1995-03-28
Go To Sleep Hail To the Thief 0.288 2003-01-01
The Bends The Bends 0.288 1995-03-28
Black Star The Bends 0.288 1995-03-28
I Can’t Pablo Honey 0.284 1993-02-22
Blow Out Pablo Honey 0.284 1993-02-22
The Numbers A Moon Shaped Pool 0.282 2016-05-08
True Love Waits A Moon Shaped Pool 0.282 2016-05-08
(Nice Dream) The Bends 0.262 1995-03-28
Give Up The Ghost The King Of Limbs 0.260 2011-02-18
Ripcord Pablo Honey 0.256 1993-02-22
No Surprises OK Computer 0.255 1997-05-28
I Will Hail To the Thief 0.254 2003-01-01
Paranoid Android OK Computer 0.252 1997-05-28
Prove Yourself Pablo Honey 0.250 1993-02-22
My Iron Lung The Bends 0.242 1995-03-28
The Tourist OK Computer 0.241 1997-05-28
You Pablo Honey 0.223 1993-02-22
Glass Eyes A Moon Shaped Pool 0.218 2016-05-08
Stop Whispering Pablo Honey 0.212 1993-02-22
Lucky OK Computer 0.206 1997-05-28
Electioneering OK Computer 0.185 1997-05-28
How Do You? Pablo Honey 0.185 1993-02-22
Climbing Up the Walls OK Computer 0.172 1997-05-28
Life In a Glasshouse Amnesiac 0.168 2001-03-12
How To Disappear Completely Kid A 0.168 2000-10-01
Sulk The Bends 0.167 1995-03-28
Treefingers Kid A 0.157 2000-10-01
Pink Section Tomorrows Modern Boxes 0.153 2014-01-01
We Suck Young Blood Hail To the Thief 0.135 2003-01-01
Motion Picture Soundtrack Kid A 0.134 2000-10-01
Pyramid Song Amnesiac 0.127 2001-03-12


Next I made a ridgeplot to show the danceability distributions by album, ordered by release date. I then saved the plot as a png for the GIF background.

library(ggridges)
library(lubridate)

# make label for plot
album_names_label <- tots_thom %>% 
    arrange(album_release_year) %>% 
    mutate(label = str_glue('{album_name} ({year(album_release_year)})')) %>% 
    pull(label) %>% 
    unique

p <- ggplot(tots_thom, aes(x = danceability, y = as.character(album_release_year))) + 
    geom_density_ridges() +
    theme_ridges(center_axis_labels = TRUE, grid = FALSE, font_size = 6) +
    theme(plot.title = element_text(face = 'bold', size = 14, hjust = 1.25),
          plot.subtitle = element_text(size = 10, hjust = 1.1)) +
    ggtitle('Have we reached peak Thom Yorke danceability?', 'Song danceability by album - Radiohead, Thom Yorke, and Atoms for Peace') +
    labs(x = 'Song danceability', y = '') +
    scale_x_continuous(breaks = c(0,.25,.5,.75,1)) +
    scale_y_discrete(labels = album_names_label)

ggsave(p, filename = str_glue('{img_dir}/danceplot.png'), width = 5, height = 3)
background <- image_read(str_glue('{img_dir}/danceplot.png'))
background

Frame by frame, I then added each individual image of my animated Thom GIF to the plot with image_composite(). To get him to dance across the x-axis, I moved the offset to the right by 100 pixels each frame.

frames <- map(1:length(mini_thom), function(frame) {
    hjust <- 200+(100*frame) # <- this makes him move along the x axis
    image_composite(background, mini_thom[frame], offset = str_glue('+{hjust}+400'))
})

Bringing it all together, I used image_animate(), setting loop = 0 for infinite looping.

image_animate(image_join(frames), fps = 5, loop = 0)

Arrest this man, he talks in maths

Despite my best efforts to make a plot about nothing, this chart actually highlights three things:

  • Radiohead has gotten more danceable over time
  • Thom Yorke’s danceability is higher outside of Radiohead
  • The King of Limbs (led by Lotus Flower) was peak Radiohead danceability

Related

comments powered by Disqus