index.Rmd

---
title: "top 2000 vs top 50"
author: "Laurens de Vries"
date: "29/3/2021"
output: flexdashboard::flex_dashboard
---

```{r setup, include=FALSE}
library(tidyverse)
library(tidymodels)
library(spotifyr)
library(plotly)
library(compmus)
library(ggplot2)
library(dplyr)
library(ggthemes)
library(flexdashboard)
library(ggdendro)
library(heatmaply)
library(gridExtra)
library(grid)
library(lattice)



get_conf_mat <- function(fit) {
  outcome <- .get_tune_outcome_names(fit)
  fit %>% 
    collect_predictions() %>% 
    conf_mat(truth = outcome, estimate = .pred_class)
}  

get_pr <- function(fit) {
  fit %>% 
    conf_mat_resampled() %>% 
    group_by(Prediction) %>% mutate(precision = Freq / sum(Freq)) %>% 
    group_by(Truth) %>% mutate(recall = Freq / sum(Freq)) %>% 
    ungroup() %>% filter(Prediction == Truth) %>% 
    select(class = Prediction, precision, recall)
}  
```

Introduction
=========================================

Row
-------------------------------------

### 

The Top 2000 is an annual Dutch marathon radio program, that plays the 2,000 most popular songs of all time determined by a public vote. The highest ranking songs do not vary much from year to year but there sometimes new songs. I am interested in what makes new popular songs suitable for top 50, meaning short term hits, and what makes new songs suited for the top 2000.


As for the corpus I will be using a playlist of the 50 newest songs from latest edition of the top 2000 and comparing to the spotify Dutch top 50 playlist. When comparing the playlist on a track level basis, both the #1 will be used as I think they reflect the differences very well. The highest ranked song of the new top 2000 tracks is also the current #1, Rollercoaster by Danny Vera. The current number one song on the top 50 is Sea Shanty by Wellerman, remixed by 220 KID and Billen Ted. These song were chosen as they sound very different and fit the playlists well. Wellerman incorperates a recent trend from social media, a sea shanty and mixes it with Electronic Dance Music. This makes it a good song to represent top 50 which is more targeted on trends. Rollercoaster is more suited to be a long term popular song with its focus on vocal and instrumentals.

In this storyboard we will firstly gain insight in the correlations of the playlist based on spotify features such as loudness, acousticness and energy. The chromagrams of the number one songs and self similarity will be analysed. Furthermore we will look into the difficulty of categorizing the tempo of songs in the playlist. Lastly we will train and analyse a classifier which predicts the playlist of a song based on features. 

Row
-------------------------------------

### 


```{=html}
<div>
<object data="https://open.spotify.com/embed/playlist/0t20WVodhAy6RHa2yrMty8" width="300" height="380" style="display:block;margin:auto;width:25%;min-width:300px">
    <embed src="https://open.spotify.com/embed/playlist/0t20WVodhAy6RHa2yrMty8" width="300" height="380"></embed>
</object>
<object data="https://open.spotify.com/embed/playlist/2oBIu2PZIRU8H1XnZXt0LJ" width="300" height="380" style="display:block;margin:auto;width:25%;min-width:300px">
    <embed src="https://open.spotify.com/embed/playlist/2oBIu2PZIRU8H1XnZXt0LJ" width="300" height="380"></embed>
</object>
</div>
```

Visualization  {.storyboard}
=========================================


### Spotify feature analysis

```{r}
top2000 <- get_playlist_audio_features("", "2oBIu2PZIRU8H1XnZXt0LJ")
top50 <- get_playlist_audio_features("", "0t20WVodhAy6RHa2yrMty8")

hits <-
  bind_rows(
    top2000 %>% mutate(category = "Top 2000"),
    top50 %>% mutate(category = "Top 50")
  )

plot <- hits %>%
  ggplot(aes(x = valence, y = energy, size = loudness, label = track.name)) +
  geom_point(color = 'blue', alpha = 0.6) +
  geom_rug(size = 0.1) +
  scale_x_continuous(         # Fine-tune the x axis.
    limits = c(0, 1),
    breaks = c(0, 0.50, 1),   # Use grid-lines for quadrants only.
    minor_breaks = NULL       # Remove 'minor' grid-lines.
  ) +
  scale_y_continuous(         # Fine-tune the y axis in the same way.
    limits = c(0, 1),
    breaks = c(0, 0.50, 1),
    minor_breaks = NULL
  ) +
  scale_colour_brewer(        # Use the Color Brewer to choose a palette.
    type = "qual",            # Qualitative set.
    palette = "Paired"        # Name of the palette is 'Paired'.
  ) +
  scale_size_continuous(      # Fine-tune the sizes of each point.
    trans = "exp",            # Use an exp transformation to emphasise loud.
    guide = "none"            # Remove the legend for size.
  ) +
  facet_wrap(~category) +
  theme_light() + 
  labs(                       # Make the titles nice.
    x = "Valence",
    y = "Energy",
    size = "Loudness"
  )


ggplotly(plot)

```

***

Looking at the **Valence, Energy** and **loudness** of the playlist there are some differences.Songs from the top 50 playlist generally are more energetic and louder. The valence is also on higher on average for top 50 songs, but it is still quite spread out whereas few songs from the top 2000 playlist exceed a valence of 0.7.

### Acousticness

```{r}
violinPlot2 <- hits %>%
  ggplot(aes(x = category, y = acousticness)) +
  geom_violin()

ggplotly(violinPlot2)
```

***
The acousticness is also an interesting feature. I originally thought that this would be one of the biggest differences in the playlists as top 50 is in my mind has a lot of electronic music and the new top 2000 songs are more acoustic. In reality this is not the case and there are also more songs with lower acousticness in the new top 2000 songs than the top 50. The proportion of songs with lower acousticness is higher however in the top 50.

###  Distribution of the key in songs 

```{r}
hits %>% mutate(mode=ifelse(mode==0,"Major", "Minor")) %>%
  ggplot(aes(x=key_name, fill=mode)) +
  geom_bar() + facet_wrap(~category) +
  labs(x="Key", y="Count")
```

***
The new top 2000 songs are more in the minor key on average, and the top 50 songs have more major key on average. This correlates with the intuition, the top 50 songs feel happier.

### Chromagrams

```{r}
wellerman <-
  get_tidy_audio_analysis("3iw6V4LH7yPj1ESORX9RIN") %>%
  select(segments) %>%
  unnest(segments) %>%
  select(start, duration, pitches)

rollercoaster <-
  get_tidy_audio_analysis("5B5YKjgne3TZzNpMsN9aj1") %>%
  select(segments) %>%
  unnest(segments) %>%
  select(start, duration, pitches)

rc <- rollercoaster %>%
  mutate(pitches = map(pitches, compmus_normalise, "euclidean")) %>%
  compmus_gather_chroma() %>% 
  ggplot(
    aes(
      x = start + duration / 2,
      width = duration,
      y = pitch_class,
      fill = value
    )
  ) +
  ggtitle("Chromagram of Rollercoaster by Danny Vera") +
  geom_tile() +
  labs(x = "Time (s)", y = NULL, fill = "Magnitude") +
  theme_minimal() +
  scale_fill_viridis_c()

 wm <- wellerman %>%
  mutate(pitches = map(pitches, compmus_normalise, "euclidean")) %>%
  compmus_gather_chroma() %>% 
  ggplot(
    aes(
      x = start + duration / 2,
      width = duration,
      y = pitch_class,
      fill = value
    )
  ) +
  ggtitle("Chromagram Wellerman remix by 220 KID") +
  geom_tile() +
  labs(x = "Time (s)", y = NULL, fill = "Magnitude") +
  theme_minimal() +
  scale_fill_viridis_c()

grid.arrange(
  arrangeGrob(
    rc,
    wm))

```

***


The chromagram of rollercoaster shows that the song is written in the A pitch class. There is no 
overlap visible between the pitch classes. The melody is not clearly visible as the song is quite long with a short melody.

The chromagram of Wellerman Remix by 220 KID and Billen Ted shows that the song is written in the C pitch class. Not much more can be deduced from it however.


### Structure of #1 songs of top 50 and top 2000

```{r, fig.width=8, fig.height=4}
rollercoaster <-
  get_tidy_audio_analysis("5B5YKjgne3TZzNpMsN9aj1") %>% 
  compmus_align(bars, segments) %>%
  select(bars) %>%
  unnest(bars) %>%
  mutate(
    pitches =
      map(segments,
        compmus_summarise, pitches,
        method = "rms", norm = "euclidean"
      )
  ) %>%
  mutate(
    timbre =
      map(segments,
        compmus_summarise, timbre,
        method = "rms", norm = "euclidean"
      )
  )


wellerman <-
  get_tidy_audio_analysis("3iw6V4LH7yPj1ESORX9RIN") %>% 
  compmus_align(bars, segments) %>%
  select(bars) %>%
  unnest(bars) %>%
  mutate(
    pitches =
      map(segments,
        compmus_summarise, pitches,
        method = "rms", norm = "euclidean"
      )
  ) %>%
  mutate(
    timbre =
      map(segments,
        compmus_summarise, timbre,
        method = "rms", norm = "euclidean"
      )
  )



rc <- bind_rows(
  rollercoaster %>%
    compmus_self_similarity(pitches, "aitchison") %>%
    mutate(d = d / max(d), type = "Chroma"),
  rollercoaster %>%
    compmus_self_similarity(timbre, "euclidean") %>%
    mutate(d = d / max(d), type = "Timbre")
) %>%
  mutate() %>%
  ggplot(
    aes(
      x = xstart + xduration / 2,
      width = xduration,
      y = ystart + yduration / 2,
      height = yduration,
      fill = d
    )
  ) +
  ggtitle("Danny Vera - Rollercoaster") +
  geom_tile() +
  coord_fixed() +
  facet_wrap(~type) +
  scale_fill_viridis_c(guide = "none") +
  theme_classic() +
  labs(x = "", y = "")

wm <- bind_rows(
  wellerman %>%
    compmus_self_similarity(pitches, "aitchison") %>%
    mutate(d = d / max(d), type = "Chroma"),
  wellerman %>%
    compmus_self_similarity(timbre, "euclidean") %>%
    mutate(d = d / max(d), type = "Timbre")
) %>%
  mutate() %>%
  ggplot(
    aes(
      x = xstart + xduration / 2,
      width = xduration,
      y = ystart + yduration / 2,
      height = yduration,
      fill = d
    )
  ) +
  ggtitle("Nathan Evans - Wellerman (Sea Shanty / 220 KID x Billen Ted Remix)") +
  geom_tile() +
  coord_fixed() +
  facet_wrap(~type) +
  scale_fill_viridis_c(guide = "none") +
  theme_classic() +
  labs(x = "", y = "")

grid.arrange(
    rc,
    wm, nrow = 1)
```

***

The differences between the songs are also visible on the self similarity matrices.
Rollercoaster results in a much more uniform plot, while the Sea Shanty, has yellow lines 
at around 30 and 80 seconds. This correlates when you listen to the songs, Sea Shanty can be classified as an EDM song with "drops". These drops result in a drastic change in timbre, rollercoaster is a pop song with more gradual timbre changes. Looking at the pitches, it is the same case the drops also result in big changes in pitch. 

These matrices make it visible that a song is 'trendier' by showing EDM-like features.

### Tempogram of Danny Vera - Rollercoaster

```{r}
rolco <- get_tidy_audio_analysis("5B5YKjgne3TZzNpMsN9aj1")

rolco %>%
   tempogram(window_size = 8, hop_size = 1, cyclic = FALSE) %>%
   ggplot(aes(x = time, y = bpm, fill = power)) +
   geom_raster() +
   scale_fill_viridis_c(guide = "none") +
   labs(x = "Time (s)", y = "Tempo (BPM)") +
   theme_classic()
```

***

The tempogram of rollercoaster is very unclear, the song primarily features a guitar melody and vocals.
Tempograms seem to be more unclear on songs with these characteristics.

### Tempogram of Nathan Evans - Wellerman (Sea Shanty / 220 KID x Billen Ted Remix)

```{r}
well <- get_tidy_audio_analysis("3iw6V4LH7yPj1ESORX9RIN")

well %>%
   tempogram(window_size = 8, hop_size = 1, cyclic = TRUE) %>%
   ggplot(aes(x = time, y = bpm, fill = power)) +
  geom_raster() +
   scale_fill_viridis_c(guide = "none") +
   labs(x = "Time (s)", y = "Tempo (BPM)") +
   theme_classic()
```

*** 

The tempogram of wellerman is very clear, the song has a very constant tempo of around 120 bpm. 
This is also the case for more songs in the top 50, the tempograms are clearer than most of the new songs from the top 2000.


```{r, include = FALSE}


hits <-
  bind_rows(
    top2000 %>% mutate(playlist = "Top 2000"),
    top50 %>% mutate(playlist = "Top 50")
  )

hits_features <-
  hits %>%  # For your portfolio, change this to the name of your corpus.
  add_audio_analysis() %>% 
  mutate(
    playlist = factor(playlist),
    segments = map2(segments, key, compmus_c_transpose),
    pitches =
      map(
        segments,
        compmus_summarise, pitches,
        method = "mean", norm = "manhattan"
      ),
    timbre =
      map(
        segments,
        compmus_summarise, timbre,
        method = "mean",
      )
  ) %>%
  mutate(pitches = map(pitches, compmus_normalise, "clr")) %>%
  mutate_at(vars(pitches, timbre), map, bind_rows) %>%
  unnest(cols = c(pitches, timbre))

hits_recipe <-
  recipe(
    playlist ~
      danceability +
      energy +
      loudness +
      speechiness +
      acousticness +
      instrumentalness +
      liveness +
      valence +
      tempo +
      duration +
      C + `C#|Db` + D + `D#|Eb` +
      E + `F` + `F#|Gb` + G +
      `G#|Ab` + A + `A#|Bb` + B +
      c01 + c02 + c03 + c04 + c05 + c06 +
      c07 + c08 + c09 + c10 + c11 + c12,
    data = hits_features,          # Use the same name as the previous block.
  ) %>%
  step_center(all_predictors()) %>%
  step_scale(all_predictors())      # Converts to z-scores.
  # step_range(all_predictors())    # Sets range to [0, 1].

hits_cv <- hits_features %>% vfold_cv(5)

knn_model <-
  nearest_neighbor(neighbors = 1) %>%
  set_mode("classification") %>% 
  set_engine("kknn")

hits_knn <- 
  workflow() %>% 
  add_recipe(hits_recipe) %>% 
  add_model(knn_model) %>% 
  fit_resamples(
    hits_cv, 
    control = control_resamples(save_pred = TRUE)
  )

forest_model <-
  rand_forest() %>%
  set_mode("classification") %>% 
  set_engine("ranger", importance = "impurity")


hits_forest <- 
  workflow() %>% 
  add_recipe(hits_recipe) %>% 
  add_model(forest_model) %>% 
  fit_resamples(
    hits_cv, 
    control = control_resamples(save_pred = TRUE)
  )

```

### Classification of top 2000 and top 50

```{r}
henk <- hits_forest %>% get_conf_mat() %>% autoplot(type = "mosaic")

geert <- hits_forest %>% get_conf_mat() %>% autoplot(type = "heatmap")


grid.arrange(
    henk,
    geert, nrow = 1)

```

***

A random forests classifier was trained to predict the playlist of a song, the mosaic on the left shows the performance of this classifier as a barplot. The matrix on the right shows the counts. The classifier was able to predict top 2000 with an accuracy of 35/(35+15) = 70% and top 50 with an accuracy of 32/(32+18) = 60%. These scores are not very good but I think they are correct in showing the feature importance.


### Feature importance

```{r}
workflow() %>% 
  add_recipe(hits_recipe) %>% 
  add_model(forest_model) %>% 
  fit(hits_features) %>% 
  pluck("fit", "fit", "fit") %>%
  ranger::importance() %>% 
  enframe() %>% 
  mutate(name = fct_reorder(name, value)) %>% 
  ggplot(aes(name, value)) + 
  geom_col() + 
  coord_flip() +
  theme_minimal() +
  labs(x = NULL, y = "Importance")

```

***

The most important features from the random forest classifier are spotify features, the most significant one is the track length as top 2000 songs are generally longer than top 50 songs. The danceability is also an important feature with the top 50 having a higher danceability on average. The differences in valence also has some importance, which we also saw in the Spotify feature exploration. Interesting is that the acousticness is one of the lowest ranked features while it did show difference on the violin plot.


### Visualizing the most important features

```{r}
henk <- hits_features %>%
  ggplot(aes(x = duration, y = danceability, colour = playlist, size = valence)) +
  geom_point(alpha = 0.8) +

  labs(
    x = "Duration",
    y = "Danceability",
    size = "Valence",
    colour = "Playlist"
  )

ggplotly(henk)
```

***

Plotting the features also makes it clear why the classifier ranked these features as the most important. 
Most of the outliers are top 2000 songs. The difference in the average length is clearly visible. The danceability is also higher and more clustered for the top 50 songs. The differences in valence is less clear by plotting it as the size.









Conclusion
=========================================

The differences between the new songs from the top 2000 and the current top 50 are more subtle than expected. There are differences on a lot of metrics, but they are not very significant. The differences in spotify features do show clearly on the visualizations. The chromagrams did not provide interesting insight in the differences. The self similarity matrices provided a useful comparison per song, and looking at the structure of two songs you can see patterns that make it top 50 or top 2000. However I do think that these differences between the matrices are too subtle to be useful for prediction. 

The random forest classifier provided interesting results, I think that using more top 50 playlists will result in better performance. The classifier also showed which features were interesting and this showed up on the plots of these features.

In conclusion, what makes a new song fit the top 2000 instead of the top 50 is a combination of the length of the track, the danceability, the valence, energy and whether it is a major key or minor key. These factors in combination will not give a definitive results but an indication. 

Finally, maybe it is good that it is difficult to predict, considering that music is a form of artistic expression and unpredictability or creativity is also a part of art which makes art interesting.