Crea tu propio festival

R Viz

Generación de un flyer de un festival a partir de datos de Spotify personales (artistas más escuchados)

true
11-29-2022

Instafest

Hace unos días se difundió el uso de una aplicación para generar un flyer de un festival ficticio a partir de datos de tus artistas más escuchados en Spotify. Esto me llevó a querer reproducir el análisis en R.

A continuación se presentan los pasos para generar el flyer de tu festival:

1. Librerías y definiciones

library(spotifyr)
library(tidyverse)
library(tibble)
library(tidymodels)
library(gt)
library(broom)
library(ggimage)
library(ggwordcloud)
library(showtext)
library(ggtext)
library(rjson)

Definición de fuente a utilizar para el texto:

Show code 
font_add_google(name = "Slackey", family = "custom_font")
showtext_auto()

Para poder acceder a datos de Spotify, se utilizará el paquete {spotifyr} 📦. Realizamos un taller desde RladiesBA sobre el tema: Creando tablas en {gt} con Spotify API & Bad Bunny e incluimos un Documento de configuración de credenciales

Definición de credenciales para la conexión a la API de Spotify:

Show code 
credentials <- fromJSON(file = "credentials.json")

Sys.setenv(SPOTIFY_CLIENT_ID = credentials$SPOTIFY_CLIENT_ID)
Sys.setenv(SPOTIFY_CLIENT_SECRET = credentials$SPOTIFY_CLIENT_SECRET)

access_token <- get_spotify_access_token(
  client_id = Sys.getenv("SPOTIFY_CLIENT_ID"),
  client_secret = Sys.getenv("SPOTIFY_CLIENT_SECRET")
)

Data

Se obtiendn datos de los 50 artistas más escuchados en el mediano plazo:

df <- get_my_top_artists_or_tracks(type = 'artists',
                                   time_range = 'medium_term',
                                   limit = 50)

Los artistas aparecen en orden de más a menos escuchado. Se visualizan los 🎶 5 artistas más escuchados 🎶 :

Show code 
df %>%
  select(name, genres, followers.total) %>%
  janitor::clean_names() %>% 
  head(5) %>% 
  rowwise() %>%
  mutate(genres = paste(genres, collapse = ', ')) %>%
  ungroup %>%
  gt() %>% 
  tab_header(title=md('**Artistas más escuchados** en el mediano plazo')) %>% 
  opt_align_table_header('left') %>% 
  fmt_number(all_numeric(), decimals=2)
Artistas más escuchados en el mediano plazo
name genres followers_total
Placebo alternative rock, britpop, permanent wave, pop rock, rock 1683878
Las Ligas Menores argentine alternative rock, argentine indie, latin rock 78188
Intoxicados argentine rock, latin alternative, latin rock, rock en espanol, rock nacional, ska argentino 920220
The Smiths madchester, new wave, permanent wave, rock, uk post-punk 3669665
La Dispute alternative emo, emo, grand rapids indie, progressive post-hardcore, screamo 311203

Transformaciones

Para poder generar el flyer, se busca clusterizar a los artistas en 3 grupos (días del festival). Se realizan algunas transformaciones iniciales para poder utilizar estos datos para generar la clusterización.

EL primer paso consiste en generar variables a partir de cada una de las listas de géneros incluidas en cada artista. Luego, se pivotean los datos para obtener un registro por artista. Habiendo obtenido la tabla en formato correcto, se imputan los valores faltantes con 0. De esta forma, se cuenta con una matriz, en donde cada columna es un genero y cada fila es un artista. Si el artista pertenece a un género aparece un 1, y un 0 en caso contrario.

df_clusters <- df %>%
  
  select(artist = name, genres) %>%
  
  unnest_longer(genres) %>%
  
  mutate(value = 1) %>%
  
  pivot_wider(id_cols = artist,
              names_from = genres,
              values_from = value) %>%
  
  mutate(across(where(is.numeric), ~ ifelse(is.na(.), 0, 1))) %>%
  
  left_join(df %>% select(followers.total, artist = name) %>%
              rownames_to_column('relevance')) %>%
  
  janitor::clean_names()

Visualizando las primeras 2 observaciones:

Show code 
df_clusters %>% head(2) %>% gt()
artist alternative_rock britpop permanent_wave pop_rock rock argentine_alternative_rock argentine_indie latin_rock argentine_rock latin_alternative rock_en_espanol rock_nacional ska_argentino madchester new_wave uk_post_punk alternative_emo emo grand_rapids_indie progressive_post_hardcore screamo candy_pop pixie pop_emo pop_punk anti_folk folk_punk olympia_wa_indie garage_rock modern_rock sheffield_indie alternative_dance art_pop chamber_psych chillwave dream_pop electronica indie_rock la_indie modern_alternative_rock modern_dream_pop new_rave argentine_indie_rock indie_platense argentine_punk latincore art_rock melancholia oxford_indie eau_claire_indie indie_folk baroque_pop chamber_pop indie_pop scottish_indie scottish_rock singer_songwriter twee_pop post_punk pop argentine_hardcore alternative_metal grunge spacegrunge nu_gaze reading_indie shoegaze rock_uruguayo nu_metal post_grunge rap_metal post_punk_argentina chilean_indie canadian_pop dance_pop post_teen_pop electronica_argentina latin_pop pop_electronico electropop classical_tenor italian_tenor operatic_pop slam_poetry classic_rock folk_rock protopunk psychedelic_rock reggae_uruguayo noise_pop deep_latin_alternative irish_rock dance_rock new_romantic new_wave_pop synthpop metropopolis nz_pop garage_rock_revival relevance followers_total
Placebo 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1683878
Las Ligas Menores 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 78188

Se observa que el dataframe final cuenta con 102 variables para las 50 observaciones que se intentará clusterizar:

dim(df_clusters)
[1]  50 102

Modelado

Preprocesamiento

Se utiliza {tidymodels} 📦 para generar una receta simple de preprocesamiento de datos. En este caso, eliminando variables con varianza cercana a 0:

preproc <- recipe( ~ ., data = df_clusters) %>%
  
  update_role(artist, new_role = 'id') %>%
  
  step_rm(followers_total, relevance) %>%
  
  step_nzv(all_numeric())

Se transforman los datos con la receta de preproecsamiento:

df_processed <- preproc %>%
  prep() %>%
  juice()

Ahora se cuenta con solo 27 variables para las 50 observaciones:

dim(df_processed)
[1] 50 27

Clustering

Se utiliza el algoritmo kmeans para segmentar a los artistas en 3 grupos (3 centroides):

set.seed(1234)
artists_clusters <- df_processed %>%
  column_to_rownames('artist') %>%
  kmeans(centers = 3)

Se utiliza la función augment() del paquete {broom} 📦, incluido en tidymodels, para concatenar la columna de cluster al df original:

df_final <- broom::augment(artists_clusters, df_clusters)
df_final %>% 
  group_by(.cluster) %>% 
  summarise(n=n())
# A tibble: 3 × 2
  .cluster     n
  <fct>    <int>
1 1           14
2 2           17
3 3           19

Flyer

Para la generación del flyer se utiliza {ggplot2} 📦. Antes de generar el gráfico, es necesario realizar ciertas transformaciones iniciales:

  1. Se obtienen los ids de relevancia del artista en cada uno de los clusters:
df_flyer <- df_final %>% 
  
  select(artist, .cluster, relevance) %>%
  
  group_by(.cluster) %>% 
  
  mutate(relevance = match(artist, unique(artist))) %>%
  
  ungroup()

Notar que, por ejemplo, Las Ligas Menores es el segundo artista más escuchado pero aparecen con relevance = 1. Esto se da porque es el artista más escuchado dentro del cluster=2 (al cual se asignó la banda en el momento de la clusterización).

Show code 
df_flyer %>% 
  DT::datatable()

Luego de haber generado el orden de relevancia de cada artista en cada cluster, se definen los labels (tamaños del texto de cada artista en el flyer). Para ello, se considera que los artistas con relevance==1 serán los que aparezcan arriba de todo, con un tamaño mayor. Luego vendrá una fila con los siguientes 3 artistas más relevantes por clusters. Luego otra fila y así hasta incluir a todos. Dentro de esta sección, se utiliza html para generar los labels que correspondan.

df_flyer <- df_flyer %>% 
  
  mutate(label = case_when(
    relevance==1~paste0(artist,'<br>'),
    relevance==4~paste0(artist,'<br>'),
    relevance==9~paste0(artist,'<br>'),
    TRUE ~ paste0(artist,' ◇ '))
  ) %>% 
  
  mutate(label = case_when(
    relevance<=1~paste0("<span style = 'color: white; font-size: 30px'>", label,' </span>'),
    relevance<=4~paste0("<span style = 'color: white; font-size: 20px'>", label,' </span>'),
    relevance<=9~paste0("<span style = 'color: white; font-size: 15px'>", label,' </span>'),
    TRUE ~ paste0("<span style = 'color: white; font-size: 10px'>", label,' </span>'))  
  )

Finalmente, se agrupa por artista para colapsar los labels en un único registro por día (cluster):

df_flyer <- df_flyer %>% 
  
  group_by(dia=.cluster) %>% 
  
  summarise(label=paste(label, collapse=' ')) %>% 
  
  ungroup()

Ahora sí, teniendo el dataframe en el formato necesario para el Flyer se crea el ggplot final ✨:

font_color = 'white'

p <- df_flyer %>%
  
  ggplot(aes(x = 0.5, y = 0.5, label = label)) +
    geom_richtext(label.color = NA, fill = NA) +
    facet_wrap( ~ paste0('Día ', dia), nrow = 3) +
    ylim(c(0, 1)) +
    labs(title = 'GGFEST 2023',
         caption = 'Invita R')

Se añaden ciertos aspectos de estilo al plot:

Show code 
p <- p +
  theme_void() +
  theme(
    plot.margin = unit(c(7, 0, 12, 0), "cm"),
    strip.text = element_text(
      colour = font_color, size = 20,
      family = 'custom_font'
    ),
    text = element_text(),
    plot.title = element_text(
      family = 'custom_font',
      hjust = 0.5,
      size = 40,
      color = font_color,
      margin = margin(0, 0, 30, 0)
    ),
    plot.caption = element_text(
      hjust = 0.8,
      size = 10,
      color = font_color
    ),
    panel.spacing.y = unit(0, "lines")
  )

Para visualizarlo, se colorea el fondo (dado que el color del texto es blanco):

Show code 
p + theme(plot.background = element_rect(fill='#53358f'))

Se añade una imagen como fondo del gráfico:

plot_with_background <- p %>% 
  ggbackground(background='https://raw.githubusercontent.com/karbartolome/instafest/main/ggfest_blank.png')

Save flyer

Para guardar el flyer, se utiliza la funcíón ggsave() de {ggplot2} 📦:

showtext_auto(enable = TRUE)
showtext_opts(dpi=1000)
ggsave('ggfest.png', 
       plot=plot_with_background, 
       height=25, width=25, scale=1
)

Comentarios finales

En este post se mostró una alternativa de clusterización para generar el flyer. Opciones de clusterización más avanzadas podrían llevar a una mejor segmentación. Cualquier comentario es bienvenido!

Contacto ✉

Karina Bartolome, Linkedin, Twitter, Github, Blogpost

SessionInfo()

sessioninfo::package_info() %>% 
  filter(attached==TRUE) %>% 
  select(package, loadedversion, date, source) %>% 
  gt() %>% 
  tab_header(title='Paquetes utilizados',
             subtitle='Versiones') %>% 
  opt_align_table_header('left')
Paquetes utilizados
Versiones
package loadedversion date source
broom 1.0.4 2023-03-11 CRAN (R 4.2.3)
dials 0.1.1 2022-04-06 CRAN (R 4.2.0)
dplyr 1.1.1 2023-03-22 CRAN (R 4.2.3)
forcats 1.0.0 2023-01-29 CRAN (R 4.2.3)
ggimage 0.3.1 2022-04-25 CRAN (R 4.2.0)
ggplot2 3.4.2 2023-04-03 CRAN (R 4.2.0)
ggtext 0.1.2 2022-09-16 CRAN (R 4.2.2)
ggwordcloud 0.5.0 2019-06-02 CRAN (R 4.2.2)
gt 0.9.0 2023-03-31 CRAN (R 4.2.3)
infer 1.0.0 2021-08-13 CRAN (R 4.2.0)
lubridate 1.9.2 2023-02-10 CRAN (R 4.2.3)
modeldata 0.1.1 2021-07-14 CRAN (R 4.2.0)
parsnip 1.0.3 2022-11-11 CRAN (R 4.2.2)
purrr 1.0.1 2023-01-10 CRAN (R 4.2.3)
readr 2.1.4 2023-02-10 CRAN (R 4.2.3)
recipes 1.0.3 2022-11-09 CRAN (R 4.2.2)
rjson 0.2.21 2022-01-09 CRAN (R 4.2.0)
rsample 0.1.1 2021-11-08 CRAN (R 4.2.0)
scales 1.2.1 2022-08-20 CRAN (R 4.2.3)
showtext 0.9-5 2022-02-09 CRAN (R 4.2.0)
showtextdb 3.0 2020-06-04 CRAN (R 4.2.0)
spotifyr 2.2.3 2021-11-02 CRAN (R 4.2.1)
stringr 1.5.0 2022-12-02 CRAN (R 4.2.3)
sysfonts 0.8.8 2022-03-13 CRAN (R 4.2.0)
tibble 3.2.1 2023-03-20 CRAN (R 4.2.3)
tidymodels 0.2.0 2022-03-19 CRAN (R 4.2.0)
tidyr 1.3.0 2023-01-24 CRAN (R 4.2.3)
tidyverse 2.0.0 2023-02-22 CRAN (R 4.2.3)
tune 0.2.0 2022-03-19 CRAN (R 4.2.0)
workflows 0.2.6 2022-03-18 CRAN (R 4.2.0)
workflowsets 0.2.1 2022-03-15 CRAN (R 4.2.0)
yardstick 1.0.0 2022-06-06 CRAN (R 4.2.0)

Citation

For attribution, please cite this work as

Bartolomé (2022, Nov. 29). Karina Bartolome: Crea tu propio festival. Retrieved from https://karbartolome-blog.netlify.app/posts/ggfestival/

BibTeX citation

@misc{bartolomé2022crea,
  author = {Bartolomé, Karina},
  title = {Karina Bartolome: Crea tu propio festival},
  url = {https://karbartolome-blog.netlify.app/posts/ggfestival/},
  year = {2022}
}