Thom Yorke GIFs, spotifyr, and ggplot2

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)
## Warning in eval_bare(f[[3]], env): NAs introduced by coercion

## Warning in eval_bare(f[[3]], env): NAs introduced by coercion

## Warning in eval_bare(f[[3]], env): NAs introduced by coercion
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.8900 2013
Default AMOK 0.7930 2013
A Brain in a Bottle Tomorrow’s Modern Boxes 0.7870 2014
Guess Again! Tomorrow’s Modern Boxes 0.7250 2014
Lotus Flower The King Of Limbs 0.7210 2011
Backdrifts Hail To the Thief 0.7180 2003
Skip Divided The Eraser 0.7110 2006
House Of Cards In Rainbows 0.7100 2007
Harrowdown Hill The Eraser 0.7050 2006
Separator The King Of Limbs 0.6930 2011
Identikit A Moon Shaped Pool 0.6920 2016
Ingenue AMOK 0.6840 2013
All I Need In Rainbows 0.6680 2007
Packt Like Sardines In a Crushed Tin Box Amnesiac 0.6670 2001
Morning Mr Magpie The King Of Limbs 0.6480 2011
Morning Bell Kid A 0.6450 2000
Stuck Together Pieces AMOK 0.6430 2013
Atoms For Peace The Eraser 0.6430 2006
There Is No Ice (For My Drink) Tomorrow’s Modern Boxes 0.6410 2014
Kid A Kid A 0.6300 2000
The Eraser The Eraser 0.6290 2006
Little By Little The King Of Limbs 0.6190 2011
Amok AMOK 0.6180 2013
Idioteque Kid A 0.6150 2000
There, There Hail To the Thief 0.6140 2003
Black Swan The Eraser 0.6130 2006
Dropped AMOK 0.6110 2013
A Punch Up At a Wedding Hail To the Thief 0.6030 2003
I Might Be Wrong Amnesiac 0.6010 2001
15 Step In Rainbows 0.6000 2007
Cymbal Rush The Eraser 0.5940 2006
The Mother Lode Tomorrow’s Modern Boxes 0.5890 2014
Videotape In Rainbows 0.5810 2007
Unless AMOK 0.5810 2013
Pulk/Pull Revolving Doors Amnesiac 0.5800 2001
The Clock The Eraser 0.5720 2006
Desert Island Disk A Moon Shaped Pool 0.5610 2016
Decks Dark A Moon Shaped Pool 0.5600 2016
Analyse The Eraser 0.5600 2006
Before Your Very Eyes… AMOK 0.5520 2013
Burn the Witch A Moon Shaped Pool 0.5410 2016
Has Ended Suspiria (Music for the Luca Guadagnino Film) 0.5400 2018
Weird Fishes/ Arpeggi In Rainbows 0.5380 2007
Nude In Rainbows 0.5370 2007
Bloom The King Of Limbs 0.5180 2011
Reckoner In Rainbows 0.5180 2007
Nose Grows Some Tomorrow’s Modern Boxes 0.5170 2014
Creep Pablo Honey 0.5150 1993
Myxomatosis Hail To the Thief 0.4990 2003
Like Spinning Plates Amnesiac 0.4930 2001
Scatterbrain Hail To the Thief 0.4920 2003
Feral The King Of Limbs 0.4900 2011
Street Spirit (Fade Out) The Bends 0.4880 1995
The National Anthem Kid A 0.4860 2000
Sit Down. Stand Up Hail To the Thief 0.4830 2003
A Wolf At the Door Hail To the Thief 0.4800 2003
Present Tense A Moon Shaped Pool 0.4790 2016
Suspirium Suspiria (Music for the Luca Guadagnino Film) 0.4730 2018
Jigsaw Falling Into Place In Rainbows 0.4610 2007
Fake Plastic Trees The Bends 0.4540 1995
Bullet Proof … I Wish I Was The Bends 0.4480 1995
2 + 2 = 5 Hail To the Thief 0.4430 2003
The Gloaming Hail To the Thief 0.4400 2003
Knives Out Amnesiac 0.4330 2001
Fitter Happier OK Computer 0.4320 1997
Planet Telex The Bends 0.4290 1995
Ful Stop A Moon Shaped Pool 0.4260 2016
Lurgee Pablo Honey 0.4200 1993
Reverse Running AMOK 0.4190 2013
High And Dry The Bends 0.4180 1995
Optimistic Kid A 0.4030 2000
Vegetable Pablo Honey 0.3840 1993
In Limbo Kid A 0.3750 2000
Sail To The Moon Hail To the Thief 0.3720 2003
Thinking About You Pablo Honey 0.3640 1993
Karma Police OK Computer 0.3600 1997
Bones The Bends 0.3580 1995
Let Down OK Computer 0.3520 1997
Interference Tomorrow’s Modern Boxes 0.3490 2014
Bodysnatchers In Rainbows 0.3430 2007
The Hooks Suspiria (Music for the Luca Guadagnino Film) 0.3410 2018
Faust Arp In Rainbows 0.3380 2007
Tinker Tailor Soldier Sailor Rich Man Poor Man Beggar Man Thief A Moon Shaped Pool 0.3360 2016
Open Again Suspiria (Music for the Luca Guadagnino Film) 0.3350 2018
Codex The King Of Limbs 0.3270 2011
Untitled Kid A 0.3270 2000
Morning Bell/Amnesiac Amnesiac 0.3250 2001
Dollars & Cents Amnesiac 0.3250 2001
Subterranean Homesick Alien OK Computer 0.3160 1997
Truth Ray Tomorrow’s Modern Boxes 0.3110 2014
Airbag OK Computer 0.3060 1997
And It Rained All Night The Eraser 0.3060 2006
Olga’s Destruction (Volk tape) Suspiria (Music for the Luca Guadagnino Film) 0.3050 2018
Hunting Bears Amnesiac 0.3020 2001
Daydreaming A Moon Shaped Pool 0.2990 2016
Where I End and You Begin Hail To the Thief 0.2970 2003
You And Whose Army? Amnesiac 0.2950 2001
Anyone Can Play Guitar Pablo Honey 0.2940 1993
Everything In Its Right Place Kid A 0.2930 2000
Exit Music (For a Film) OK Computer 0.2930 1997
Just The Bends 0.2910 1995
Go To Sleep Hail To the Thief 0.2880 2003
The Bends The Bends 0.2880 1995
Black Star The Bends 0.2880 1995
I Can’t Pablo Honey 0.2840 1993
Blow Out Pablo Honey 0.2840 1993
The Numbers A Moon Shaped Pool 0.2820 2016
True Love Waits A Moon Shaped Pool 0.2820 2016
Volk Suspiria (Music for the Luca Guadagnino Film) 0.2810 2018
(Nice Dream) The Bends 0.2620 1995
Give Up The Ghost The King Of Limbs 0.2600 2011
Ripcord Pablo Honey 0.2560 1993
No Surprises OK Computer 0.2550 1997
I Will Hail To the Thief 0.2540 2003
A Light Green Suspiria (Music for the Luca Guadagnino Film) 0.2540 2018
Paranoid Android OK Computer 0.2520 1997
The Jumps Suspiria (Music for the Luca Guadagnino Film) 0.2520 2018
Prove Yourself Pablo Honey 0.2500 1993
My Iron Lung The Bends 0.2420 1995
The Tourist OK Computer 0.2410 1997
You Pablo Honey 0.2230 1993
Sabbath Incantation Suspiria (Music for the Luca Guadagnino Film) 0.2220 2018
Glass Eyes A Moon Shaped Pool 0.2180 2016
Klemperer Walks Suspiria (Music for the Luca Guadagnino Film) 0.2130 2018
Stop Whispering Pablo Honey 0.2120 1993
Belongings Thrown in a River Suspiria (Music for the Luca Guadagnino Film) 0.2080 2018
Lucky OK Computer 0.2060 1997
Unmade Suspiria (Music for the Luca Guadagnino Film) 0.1860 2018
Electioneering OK Computer 0.1850 1997
How Do You? Pablo Honey 0.1850 1993
A Choir of One Suspiria (Music for the Luca Guadagnino Film) 0.1850 2018
The Conjuring of Anke Suspiria (Music for the Luca Guadagnino Film) 0.1820 2018
Suspirium Finale Suspiria (Music for the Luca Guadagnino Film) 0.1730 2018
Climbing Up the Walls OK Computer 0.1720 1997
Life In a Glasshouse Amnesiac 0.1680 2001
How To Disappear Completely Kid A 0.1680 2000
Sulk The Bends 0.1670 1995
A Soft Hand Across Your Face Suspiria (Music for the Luca Guadagnino Film) 0.1590 2018
Treefingers Kid A 0.1570 2000
Pink Section Tomorrow’s Modern Boxes 0.1530 2014
The Inevitable Pull Suspiria (Music for the Luca Guadagnino Film) 0.1480 2018
We Suck Young Blood Hail To the Thief 0.1350 2003
Motion Picture Soundtrack Kid A 0.1340 2000
The Balance of Things Suspiria (Music for the Luca Guadagnino Film) 0.1310 2018
Pyramid Song Amnesiac 0.1270 2001
A Storm That Took Everything Suspiria (Music for the Luca Guadagnino Film) 0.1190 2018
The Universe is Indifferent Suspiria (Music for the Luca Guadagnino Film) 0.0915 2018


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} ({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 (except for his score for the 2018 horror film, Suspiria)
  • The King of Limbs (led by Lotus Flower) was peak Radiohead danceability
Avatar
RCharlie
Data Scientist

Related

comments powered by Disqus