Análisis multivariado de base de datos de canciones

Primero cargo las librerías necesarias, cargo la base de datos y convierto las variables categóricas a factor.

library(FactoMineR)
library(factoextra)
library(tidyverse)
library(psych)
library(corrplot)
library(ggpubr)
library(ggpointdensity)
library(NbClust)
library(GPArotation)
library(hrbrthemes)
library(kableExtra)
library(viridis)
library(gridExtra)
library(ggforce)

#Cargo la base de datos
data <- read.csv("~/Downloads/music_genre.csv")

#convierto variables
data$artist_name <- as.factor(data$artist_name)
data$music_genre <- as.factor(data$music_genre)

Vemos qué niveles tiene la variable categórica de género musical:

levels(data$music_genre)

##  [1] ""            "Alternative" "Anime"       "Blues"       "Classical"  
##  [6] "Country"     "Electronic"  "Hip-Hop"     "Jazz"        "Rap"        
## [11] "Rock"

Elijo las variables numericas de interes, y armamos un dataframe agregandole tambien genero, popularidad y nombre de artista y cancion. Luego descarto las observaciones con NAs:

data_num <- data%>%
  select(acousticness, danceability, energy,
         instrumentalness, loudness, 
         speechiness, valence, music_genre, popularity, artist_name, track_name)
data_num_compl <- na.omit(data_num)

dim(data_num_compl)

## [1] 50000    11

Vemos que nos queda una base de datos de 50000 canciones. Cuan correlacionadas estan las variables numericas elegidas? Realizo primero un corrplot para analizarlo:

corrplot(cor(data_num_compl[,1:7]), method="ellipse", order="AOE", type="upper")

Y complementamos esto con los tests para analizar correlacion: Test de esfericidad de Bartlett y el determinante indican alta correlacion entre variables.

cortest.bartlett(cor(data_num_compl[,1:7]), n=nrow(data_num_compl))

## $chisq
## [1] 165493.4
## 
## $p.value
## [1] 0
## 
## $df
## [1] 21

det(cor(data_num_compl[,1:7]))

## [1] 0.0365109

Principal Component Analysis (PCA)

Primero vamos a reducir dimensiones realizando Análisis de Componentes Principales (Principal component analysis, PCA)

pca <- princomp(data_num_compl[,1:7],cor=T)

Realizando el screeplot, vemos que los 2 primeros componentes explican aproximadamente el 64% de la variabilidad (PC1 el 48.4%):

fviz_screeplot(pca, addlabels=T)

Intentemos interpretar los componentes; para ello, veamos los loadings y realicemos un biplot:

pca$loadings

## 
## Loadings:
##                  Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
## acousticness      0.452  0.275  0.153  0.242  0.173  0.737  0.256
## danceability     -0.315  0.545  0.277 -0.133 -0.686         0.182
## energy           -0.472 -0.322        -0.231  0.192  0.202  0.733
## instrumentalness  0.346         0.107 -0.907         0.149 -0.126
## loudness         -0.486 -0.225                       0.614 -0.567
## speechiness      -0.169  0.633 -0.634 -0.207  0.351              
## valence          -0.299  0.252  0.687         0.577 -0.110 -0.156
## 
##                Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
## SS loadings     1.000  1.000  1.000  1.000  1.000  1.000  1.000
## Proportion Var  0.143  0.143  0.143  0.143  0.143  0.143  0.143
## Cumulative Var  0.143  0.286  0.429  0.571  0.714  0.857  1.000

fviz_pca_var(pca)

Vemos que en el componente 1, contribuyen la “acusticidad” e “instrumentalidad” (y negativamente, el volumen y la energía). Es decir, de alguna forma refleja cuán “tranquila” es una canción. En cuanto al componente 2, contribuyen positivamente la “bailabilidad”, “speechiness” y la valencia. O sea, cuán “alegre” y cuán “rapeada” es la canción.

Hecho ésto, podemos empezar a comparar géneros. Realicemos un gráfico de dispersión de PC1 vs PC2 comparando música clásica y rock:

data_num_compl$PC1 <- pca$scores[,1]
data_num_compl$PC2 <- pca$scores[,2]

data_num_compl %>% filter(music_genre%in%c("Classical", "Rock"))%>%
ggplot(aes(PC1,PC2, col=music_genre))+geom_point(alpha=0.6)+
  ggtitle("PCA: música por género: Clásica y Rock")+
  scale_color_discrete("Género", labels=c("Clasica", "Rock"), type=c("dodgerblue", "red"))+
  theme_ipsum()

Vemos que parecen separarse bastante los dos géneros, sobre todo en PC1: el rock es más energético y fuerte que la música clásica, que al mismo tiempo tiende a ser más instrumental y acústica que el rock. Hay un grupo de temas de “música clásica” que tienen PC1 muy bajo, enseguida los analizaremos. Escuchemos algunos ejemplos extremos:

#Vemos los PC1 más altos en Clásica:
data_num_compl %>%filter(music_genre=="Classical")%>%
  arrange(-PC1)%>%select(PC1, artist_name,track_name)%>%head()

El 2do PC1 más alto entre las obras clásicas es el archiconocido “Claro de Luna” de Beethoven: acústico, instrumental, para nada alegre!

knitr::include_url("https://open.spotify.com/embed/track/630zE7N1xPxdK2Zz4S3rPA", height = "380")

Veamos ahora las obras clásicas con menor score en PC1:

data_num_compl %>% filter(music_genre=="Classical")%>%
  arrange(PC1)%>%select(PC1, artist_name,track_name)%>%head()

knitr::include_url("https://open.spotify.com/embed/track/2oQmcRQwiaijDjxCGe1YqL", height = "380")

Momento! No son obras de música clásica!!! La etiqueta de género en estos casos está mal aplicada, con lo que se explican los valores bajos en PC1. Veamos una lista de todos los temas de “música clásica” con un score de PC1 menor a 0:

data_num_compl %>% filter(music_genre=="Classical"&PC1<0)%>%
  arrange(PC1)%>%select(PC1, artist_name,track_name)

Todos temas de hard rock o metal. Tendremos en cuenta esto para más adelante. Veamos extremos en PC1 en Rock:

data_num_compl %>%filter(music_genre=="Rock")%>%
  arrange(PC1)%>%select(PC1, artist_name, track_name)%>%head()

data_num_compl %>%filter(music_genre=="Rock")%>%
  arrange(-PC1)%>%select(PC1, artist_name, track_name)%>%head()

2 ejemplos claros: PC1 bajo, New Sensation de INXS (fuerte, para nada acústica, energética, alegre):

knitr::include_url("https://open.spotify.com/embed/track/2xcrseImDFEf8Urommws03", height = "380")

PC1 alto, Finding it There de Goldmund (instrumental de piano, lento):

knitr::include_url("https://open.spotify.com/embed/track/5G9rra29bm2HtXcyDtRf1y", height = "380")

Y PC2?

data_num_compl %>%filter(music_genre=="Classical")%>%
  arrange(-PC2)%>%select(PC2, artist_name, track_name)%>%head()

2do score de PC2 más alto en clásica es un fragmento hablado de una opereta de Mozart:

data_num_compl %>%filter(music_genre=="Classical")%>%
  arrange(-PC2)%>%select(PC2, artist_name, track_name)%>%head()

knitr::include_url("https://open.spotify.com/embed/track/3gQo5jtJoBOQJNjdTZsuBr", height = "380")

El menor PC2 en “Clásica” es de nuevo un tema de rock, For the Love of God de Steve Vai: instrumental, nada bailable y no muy alegre.

data_num_compl %>%filter(music_genre=="Classical")%>%
  arrange(PC2)%>%select(PC2, artist_name, track_name)%>%head()

knitr::include_url("https://open.spotify.com/embed/track/5m5I3KcV83zf2p2qbsnr3y", height = "380")

Los dos temas con mayor score en PC2 de “rock” son en realidad temas de reggae: alegres, bailables.

data_num_compl %>%filter(music_genre=="Rock")%>%
  arrange(-PC2)%>%select(PC2, artist_name, track_name)%>%head()

knitr::include_url("https://open.spotify.com/embed/track/7vp89zcbYncoBCbX5HA3tZ", height = "380")

Temas de rock con PC2 más bajos:

data_num_compl %>%filter(music_genre=="Rock")%>%
  arrange(PC2)%>%select(PC2, artist_name, track_name)%>%head()

Holy Mountains de System of a Down: claramente de valencia baja y nada bailable!!!

knitr::include_url("https://open.spotify.com/embed/track/4mj2UMyJTBTaO7pffAK29j", height = "380")

Ahora analicemos los dos primeros componentes de PCA en canciones de Jazz vs Hip Hop:

data_num_compl%>%filter(music_genre%in%c("Hip-Hop", "Jazz"))%>%
ggplot(aes(PC1,PC2, col=music_genre))+geom_point(alpha=0.6)+
  ggtitle("PCA: música por género: Hip-Hop y Jazz")+
scale_color_discrete("Género", labels=c("Hip-Hop", "Jazz"), type=c("violet", "darkgreen"))+
  theme_ipsum()

Pasa algo muy parecido que entre Rock y Clásica: los temas de Jazz se acumulan en valores altos de PC1, los temas de Hip Hop en valores bajos de PC1 y altos de PC2 (rapeados, bailables, nada acústicos!) Veamos ejemplos:

data_num_compl %>%filter(music_genre=="Jazz")%>%
  arrange(-PC1)%>%select(PC1, artist_name, track_name)%>%head()

Nada más representativo del “jazz tranquilo” que Bill Evans!

knitr::include_url("https://open.spotify.com/embed/track/1qTNMWo0Al8AfAX6aPGo6k", height = "380")

Vamos a la otra punta de PC1: busquemos un hip-hop bien “hiphopero”:

data_num_compl %>%filter(music_genre=="Hip-Hop")%>%
  arrange(PC1)%>%select(PC1, artist_name, track_name)%>%head()

knitr::include_url("https://open.spotify.com/embed/track/1xMPwgmLHVXkIFYL0rvGiZ", height = "380")

Busquemos ahora algo no tan definido: Jazz con scores bajos de PC1…

data_num_compl %>%filter(music_genre=="Jazz")%>%
  arrange(PC1)%>%select(PC1, artist_name, track_name)%>%head()

Bambous de Caravan Palace, para nada acústico (electrónico!), muy energético, casi que no parece Jazz, tiene el menor valor de PC1.

knitr::include_url("https://open.spotify.com/embed/track/3UQ4lYxFMVf31oLCkhI8dB", height = "380")

Comparemos ahora Blues y Electrónica… Deberían ser muy diferentes no?

data_num_compl%>%filter(music_genre%in%c("Electronic", "Blues"))%>%
ggplot(aes(PC1,PC2, col=music_genre))+geom_point(alpha=0.3)+
  ggtitle("PCA: música por género: Electrónica y Blues")+
scale_color_discrete("Género", labels=c("Blues", "Electronica"), type=c("yellowgreen", "black"))+
  theme_ipsum()

Vemos como ahora es mucho más dificil diferenciar un tema entre Blues y Electrónica por estos dos primeros componentes del PCA (están “amontonados” en valores medios de ambos componentes con mucha superposición de sus valores). Analicemos algunos “outliers”; hay un conjunto de 7 “temas” de Blues con altísimo score de PC2:

data_num_compl %>%filter(music_genre=="Blues")%>%
  arrange(-PC2)%>%select(PC2, speechiness, artist_name, track_name)%>%head(7)

Son todos tracks hablados! Altísimo score en PC2 por altos valores de “speechiness”.

knitr::include_url("https://open.spotify.com/embed/track/5P90rwxH5I7LiwOg3cD7Yc", height = "380")

También hay algunos temas de Electrónica con valores extremadamente altos en PC1:

data_num_compl %>%filter(music_genre=="Electronic")%>%
  arrange(-PC1)%>%select(PC1, artist_name, track_name)%>%head()

El tema con valor más alto de PC1 es música orquestal, instrumental, acústica, para nada la típica música electrónica..

knitr::include_url("https://open.spotify.com/embed/track/5OfjcALT0C7eVbauM0iB3e", height = "380")

Veamos ahora en el mismo gráfico de dispersión todos los géneros que analizamos hasta ahora:

data_num_compl%>%filter(music_genre%in%c("Classical", "Rock", "Jazz", "Hip-Hop", "Blues", "Electronic"))%>%
ggplot(aes(PC1,PC2, col=music_genre))+geom_point(alpha=0.4)+
  ggtitle("PCA: música por género: (casi) todos")+
  scale_color_discrete("Género", 
                       labels=c("Blues", "Clasica", "Electronica", 
                                "Hip-Hop", "Jazz", "Rock"), 
                       type=c("yellowgreen","dodgerblue", "black", "violet", "darkgreen", "red"))+
  theme_ipsum()

Veamos en el siguiente gráfico que representa la densidad de observaciones en el scatterplot de los 2 primeros componentes principales de la base de datos, la notoria acumulación de datos alrededor de aproximadamente PC1=-1 y PC2=-1.

data_num_compl%>%filter(music_genre%in%c("Classical", "Rock", "Jazz", "Hip-Hop", "Blues", "Electronic"))%>%
ggplot(aes(PC1,PC2))+geom_pointdensity()+
  scale_color_viridis("Puntos vecinos", direction=1)+
  ggtitle("PCA: densidad de observaciones")+
  theme_ipsum()

Pero ¿qué ocurre con la popularidad de estas canciones?¿Está la popularidad de la música relacionada con sus características musicales? Probemos con un modelo lineal múltiple:

modelo_pop <- lm(popularity~acousticness+danceability+energy+instrumentalness+loudness+speechiness+valence, data_num_compl)
summary(modelo_pop)

## 
## Call:
## lm(formula = popularity ~ acousticness + danceability + energy + 
##     instrumentalness + loudness + speechiness + valence, data = data_num_compl)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -55.708  -8.257   0.687   9.284  48.869 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       46.07544    0.57732   79.81   <2e-16 ***
## acousticness      -6.59749    0.30886  -21.36   <2e-16 ***
## danceability      19.68755    0.43268   45.50   <2e-16 ***
## energy            -8.69907    0.52929  -16.43   <2e-16 ***
## instrumentalness -10.78063    0.22774  -47.34   <2e-16 ***
## loudness           0.34098    0.02093   16.29   <2e-16 ***
## speechiness       14.94027    0.63916   23.38   <2e-16 ***
## valence           -4.23608    0.30082  -14.08   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 13.64 on 49992 degrees of freedom
## Multiple R-squared:  0.2295, Adjusted R-squared:  0.2294 
## F-statistic:  2127 on 7 and 49992 DF,  p-value: < 2.2e-16

Todas las variables resultan estadísticamente significativas con p-valores cercanos a 0 (es esperable por el tamaño de la base de datos), con un modelo que explica el 23% de la variabilidad. Y si en lugar de usar las variables usamos los scores de los dos primeros componentes principales como variables explicativas de la regresion?

modelo_pop_pca <- lm(popularity~PC1+PC2, data_num_compl)
summary(modelo_pop_pca)

## 
## Call:
## lm(formula = popularity ~ PC1 + PC2, data = data_num_compl)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.817  -8.749   0.790   9.698  49.396 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 44.22042    0.06313  700.46   <2e-16 ***
## PC1         -3.21573    0.03428  -93.80   <2e-16 ***
## PC2          2.58180    0.06065   42.56   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 14.12 on 49997 degrees of freedom
## Multiple R-squared:  0.1751, Adjusted R-squared:  0.175 
## F-statistic:  5305 on 2 and 49997 DF,  p-value: < 2.2e-16

Ambas variables también significativas, con un ligero descenso del R cuadrado ajustado a 17.5%. Veamos un scatterplot de popularidad según PC1 y PC2:

ggplot(data_num_compl, aes(PC1, PC2, col=popularity))+geom_point(alpha=0.6)+
  ggtitle("PCA: popularidad de las canciones según PC1 y PC2")+
  scale_color_continuous("Popularidad", type="viridis")+
  theme_ipsum()

Se observa que los temas más populares tienden a a acumularse en valores bajos de PC1 y medios de PC2 (la zona donde habiamos visto se acumulan la mayoría de los casos de Rock y Hip Hop).

Esta diferencia en la popularidad ¿está determinada por el género o por las características musicales de cada canción?

ggplot(data_num_compl, aes(reorder(music_genre, -popularity), popularity, col=music_genre))+geom_violin(show.legend = F)+geom_jitter(alpha=0.01, show.legend = F)+
  ggtitle("Popularidad según género musical")+
  xlab("Género musical")+
  ylab("Popularidad")+
  theme_ipsum()+
  theme(axis.text.x = element_text(angle = 30))

mod_pop_genero <- lm(popularity~music_genre, data_num_compl)
summary(mod_pop_genero)

## 
## Call:
## lm(formula = popularity ~ music_genre, data = data_num_compl)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -59.641  -6.010  -0.804   5.503  57.888 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            50.2242     0.1353  371.12   <2e-16 ***
## music_genreAnime      -25.9526     0.1914 -135.60   <2e-16 ***
## music_genreBlues      -15.4202     0.1914  -80.57   <2e-16 ***
## music_genreClassical  -20.9084     0.1914 -109.25   <2e-16 ***
## music_genreCountry     -4.2142     0.1914  -22.02   <2e-16 ***
## music_genreElectronic -12.1124     0.1914  -63.29   <2e-16 ***
## music_genreHip-Hop      8.1754     0.1914   42.72   <2e-16 ***
## music_genreJazz        -9.2956     0.1914  -48.57   <2e-16 ***
## music_genreRap         10.2732     0.1914   53.68   <2e-16 ***
## music_genreRock         9.4170     0.1914   49.20   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.569 on 49990 degrees of freedom
## Multiple R-squared:  0.621,  Adjusted R-squared:  0.6209 
## F-statistic:  9100 on 9 and 49990 DF,  p-value: < 2.2e-16

mod_pop_generoycaract <- lm(popularity~music_genre+acousticness+danceability+energy+instrumentalness+loudness+speechiness+valence, data_num_compl)
summary(mod_pop_generoycaract)

## 
## Call:
## lm(formula = popularity ~ music_genre + acousticness + danceability + 
##     energy + instrumentalness + loudness + speechiness + valence, 
##     data = data_num_compl)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -58.833  -5.951  -0.742   5.439  57.506 
## 
## Coefficients:
##                        Estimate Std. Error  t value Pr(>|t|)    
## (Intercept)            51.34531    0.42371  121.182  < 2e-16 ***
## music_genreAnime      -25.45092    0.19572 -130.037  < 2e-16 ***
## music_genreBlues      -15.13869    0.19627  -77.130  < 2e-16 ***
## music_genreClassical  -17.98042    0.25479  -70.569  < 2e-16 ***
## music_genreCountry     -4.47326    0.19397  -23.061  < 2e-16 ***
## music_genreElectronic -11.76955    0.20032  -58.754  < 2e-16 ***
## music_genreHip-Hop      8.49867    0.20741   40.974  < 2e-16 ***
## music_genreJazz        -8.43350    0.20413  -41.315  < 2e-16 ***
## music_genreRap         10.48076    0.20338   51.533  < 2e-16 ***
## music_genreRock         9.30622    0.19227   48.401  < 2e-16 ***
## acousticness           -0.50286    0.22137   -2.272   0.0231 *  
## danceability            1.97178    0.34259    5.755 8.69e-09 ***
## energy                 -0.68859    0.37813   -1.821   0.0686 .  
## instrumentalness       -1.32633    0.17409   -7.619 2.61e-14 ***
## loudness                0.13586    0.01577    8.616  < 2e-16 ***
## speechiness            -6.12435    0.50397  -12.152  < 2e-16 ***
## valence                -0.23574    0.22435   -1.051   0.2934    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.524 on 49983 degrees of freedom
## Multiple R-squared:  0.6246, Adjusted R-squared:  0.6245 
## F-statistic:  5198 on 16 and 49983 DF,  p-value: < 2.2e-16

Vemos cómo en el gráfico de violín de popularidad según género se evidencia una marcada diferencia entre géneros (Rap, Rock, y Hip Hop dominando). En cuanto al modelo lineal, al considerar solamente el género como variable explicativa se explica el 62% de la variabilidad. Al controlar por la variable género e incluir como explicativas las características musicales, las variables “energía” y “valencia” dejan de ser significativas. Entonces, las tendencias en la relación de PC1 y PC2 con la popularidad de las canciones parecerían estar más determinadas por el género musical que por los “features musicales” específicos.

Clustering

Si realizamos un clustering por k-medias teniendo en cuenta solamente las variables “musicales”, cuánto se corresponden estos clusters con los géneros de la muestra? Veamos primero Hip-Hop y música clásica:

set.seed(123)
library(gridExtra)
data_hip_clas <- data_num_compl%>%
  filter(music_genre %in% c("Hip-Hop", "Classical"))
#fviz_nbclust(data_hip_clas[1:7], kmeans, method="silhouette")
clust_hip_clas <- kmeans(data_hip_clas[1:7],2)
data_hip_clas$claseskm <- as.factor(clust_hip_clas$cluster)
p1 <-ggplot(data_hip_clas, aes(PC1,PC2, col=claseskm))+
  geom_point(alpha=0.4)+
  scale_color_discrete("Clusters", labels=c("Cluster 1", "Cluster 2"), type=c("dodgerblue", "violet"))+
  ggtitle("Clustering por K-medias")+
  theme_pubr()
p2 <-ggplot(data_hip_clas, aes(PC1,PC2, col=music_genre))+
  geom_point(alpha=0.4)+
  scale_color_discrete("Género musical", labels=c("Clásica", "Hip-Hop"), type=c("dodgerblue", "violet"))+
  ggtitle("Hip-hop vs Música Clásica")+
  theme_pubr()
grid.arrange(p1,p2, ncol=2)

data_hip_clas$music_genre <- droplevels(data_hip_clas$music_genre)
tabla_hip_clas<-table(data_hip_clas$music_genre, data_hip_clas$claseskm)
kbl(tabla_hip_clas, caption="K-means clustering: Clásica y Hip Hop")%>%kable_classic()

K-means clustering: Clásica y Hip Hop

	1	2
Classical	4021	979
Hip-Hop	23	4977

accuracy_hip_clas <- (tabla_hip_clas[1,1]+tabla_hip_clas[2,2])/nrow(data_hip_clas)
print(accuracy_hip_clas*100)

## [1] 89.98

El clustering efectuado por k-medias (con k=2) tiene un 90% de coincidencia con la clasificación por género entre Hip-Hop y música Clásica. Recordemos que había observaciones (casi todas con PC1 menor a 0) que eran temas de rock mal clasificados en la base de datos; repitamos este último clustering retirando esas canciones mal clasificadas:

set.seed(123)
library(ggforce)
data_hip_clas2 <- data_num_compl%>%
  filter(music_genre=="Hip-Hop"|music_genre=="Classical"&PC1>0)
clust_hip_clas2 <- kmeans(data_hip_clas2[1:7],2)
data_hip_clas2$claseskm <- as.factor(clust_hip_clas2$cluster)
p1<-ggplot(data_hip_clas2, aes(PC1,PC2, col=claseskm))+
  geom_point(alpha=0.4)+
  scale_color_discrete("Clusters", labels=c("Cluster 2", "Cluster 1"), type=c("violet", "dodgerblue"))+
  ggtitle("Clustering por K-medias 2.0")+
  theme_pubr()
p2<- ggplot(data_hip_clas2, aes(PC1,PC2, col=music_genre))+
  geom_point(alpha=0.4)+
geom_circle(aes(x0 = -0.8, y0 = -1.4, r = 0.7),
              inherit.aes = FALSE, linetype=3, linewidth=0.05)+ 
scale_color_discrete("Género", labels=c("Clásica", "Hip-Hop"), type=c("dodgerblue", "violet"))+
  ggtitle("Hip hop vs música clásica")+
  theme_pubr()
grid.arrange(p1,p2, ncol=2)

data_hip_clas2$music_genre <- droplevels(data_hip_clas2$music_genre)
tabla_hip_clas2<-table(data_hip_clas2$music_genre, data_hip_clas2$claseskm)
kbl(tabla_hip_clas2, caption="K-means clustering: Clásica y Hip Hop (versión 2)")%>%kable_classic()

K-means clustering: Clásica y Hip Hop (versión 2)

	1	2
Classical	687	4005
Hip-Hop	4977	23

accuracy_hip_clas2 <- (tabla_hip_clas2[1,2]+tabla_hip_clas2[2,1])/nrow(data_hip_clas2)
print(accuracy_hip_clas2*100)

## [1] 92.67437

Vemos que al retirar las observaciones “incorrectas” (temas de Rock mal clasificados como Clásica), el clustering coincide con el género en un 93% (diferenciando Hip-Hop de Clásica). Pero, ¿qué pasaría si usamos la información de los 2 primeros componentes principales para realizar este clustering?

set.seed(123)
clust_hip_clas_pca <- kmeans(pca$scores[data_num_compl$music_genre=="Hip-Hop"|data_num_compl$music_genre=="Classical"&data_num_compl$PC1>0,1:2],2)
data_hip_clas2$claseskmpca <- as.factor(clust_hip_clas_pca$cluster)
p1<-ggplot(data_hip_clas2, aes(PC1,PC2, col=claseskmpca))+
  geom_point(alpha=0.4)+
  geom_circle(aes(x0 = 2.2, y0 = -1.3, r = 1),
              inherit.aes = FALSE, linetype=3, linewidth=0.05)+ 
  scale_color_discrete("Clusters", labels=c("Cluster 2", "Cluster 1"), type=c("violet","dodgerblue"))+
  ggtitle("Clustering por K-medias/PCA")+
  theme_pubr()
p2<- ggplot(data_hip_clas2, aes(PC1,PC2, col=music_genre))+
  geom_point(alpha=0.4)+
scale_color_discrete("Género", labels=c("Clásica", "Hip-Hop"), type=c("dodgerblue", "violet"))+
  ggtitle("Hip hop vs música clásica")+
  theme_pubr()
grid.arrange(p1,p2, ncol=2)

data_hip_clas2$music_genre <- droplevels(data_hip_clas2$music_genre)
tabla_hip_clas2<-table(data_hip_clas2$music_genre, data_hip_clas2$claseskmpca)
kbl(tabla_hip_clas2, caption="K-means clustering: Clásica y Hip Hop (versión 2)")%>%kable_classic()

K-means clustering: Clásica y Hip Hop (versión 2)

	1	2
Classical	175	4517
Hip-Hop	4989	11

accuracy_hip_clas2 <- (tabla_hip_clas2[1,2]+tabla_hip_clas2[2,1])/nrow(data_hip_clas2)
print(accuracy_hip_clas2*100)

## [1] 98.08089

Vemos que la accuracy de este clustering con respecto a las etiquetas de géneros aumenta al 98%! Esto se puede deber a la buena separación que estos géneros en particular presentan en los 2 primeros componentes principales.

Y si probamos dos géneros no tan distintos? Veamos Jazz y Blues:

data_jazz_blues <- data_num_compl%>%
  filter(music_genre %in% c("Jazz", "Blues"))
clust_jazz_blues <- kmeans(data_jazz_blues[1:7],2)
data_jazz_blues$claseskm <- as.factor(clust_jazz_blues$cluster)
p1<-ggplot(data_jazz_blues, aes(PC1,PC2, col=claseskm))+
  geom_point(alpha=0.4)+
  scale_color_discrete("Clusters", labels=c("Cluster 1", "Cluster 2"), type=c("yellowgreen", "darkgreen"))+
  ggtitle("Clustering por K-medias")+
  theme_pubr()
p2<-ggplot(data_jazz_blues, aes(PC1,PC2, col=music_genre))+
  geom_point(alpha=0.4)+
  scale_color_discrete("Género", labels=c("Blues", "Jazz"), type=c("yellowgreen", "darkgreen"))+
  ggtitle("Blues vs Jazz")+
  theme_pubr()
grid.arrange(p1,p2,ncol=2)

data_jazz_blues$music_genre <- droplevels(data_jazz_blues$music_genre)
tabla_jazz_blues<-table(data_jazz_blues$music_genre, data_jazz_blues$claseskm)
kbl(tabla_jazz_blues, caption="K-means clustering: Blues y Jazz")%>%kable_classic()

K-means clustering: Blues y Jazz

	1	2
Blues	3791	1209
Jazz	2995	2005

accuracy_jazz_blues <- (tabla_jazz_blues[1,1]+tabla_jazz_blues[2,2])/nrow(data_hip_clas)
print(accuracy_jazz_blues*100)

## [1] 57.96

Vemos que la capacidad de discriminar entre géneros en este caso es mucho menor (58%). Probemos nuevamente clusterizar con los datos de PC1 y PC2, esta vez con Jazz y Blues:

set.seed(123)
data_jazz_blues <- data_num_compl%>%
  filter(music_genre %in% c("Jazz", "Blues"))
clust_jazz_blues_pca <- kmeans(pca$scores[data_num_compl$music_genre%in%c("Jazz","Blues"),1:2],2)
data_jazz_blues$claseskmpca <- as.factor(clust_jazz_blues_pca$cluster)
p1<-ggplot(data_jazz_blues, aes(PC1,PC2, col=claseskmpca))+
  geom_point(alpha=0.4)+
  scale_color_discrete("Clusters", labels=c("Cluster 1", "Cluster 2"), type=c("yellowgreen", "darkgreen"))+
  ggtitle("Clustering por K-medias/PCA")+
  theme_pubr()
p2<-ggplot(data_jazz_blues, aes(PC1,PC2, col=music_genre))+
  geom_point(alpha=0.3)+
  scale_color_discrete("Género", labels=c("Blues", "Jazz"), type=c("yellowgreen", "darkgreen"))+
  ggtitle("Blues vs Jazz")+
  theme_pubr()
grid.arrange(p1,p2,ncol=2)

data_jazz_blues$music_genre <- droplevels(data_jazz_blues$music_genre)
tabla_jazz_blues<-table(data_jazz_blues$music_genre, data_jazz_blues$claseskmpca)
kbl(tabla_jazz_blues, caption="K-means clustering: Blues y Jazz")%>%kable_classic()

K-means clustering: Blues y Jazz

	1	2
Blues	3862	1138
Jazz	2502	2498

accuracy_jazz_blues <- (tabla_jazz_blues[1,1]+tabla_jazz_blues[2,2])/nrow(data_hip_clas)
print(accuracy_jazz_blues*100)

## [1] 63.6

La accuracy sigue siendo mala, si bien mejora ligeramente. Llama la atención el límite neto entre ambos clusters, observable ya que el clustering se calculó con los componentes principales graficados.

Probemos clusterizar la totalidad de los géneros analizados, con k=nro de generos musicales:

data_generos <- data_num_compl%>%
  filter(music_genre%in%c("Classical", "Rock", "Jazz", "Hip-Hop", "Blues", "Electronic"))
clust_todo <- kmeans(data_generos[1:7],6)
data_generos$claseskm <- as.factor(clust_todo$cluster)
ggplot(data_generos, aes(PC1,PC2, col=music_genre, shape=claseskm))+
  geom_point(alpha=0.4)+
  scale_shape_discrete("Cluster")+
  scale_color_discrete("Género musical")+
  ggtitle("Clustering por K-medias: Todos los géneros")+
  theme_ipsum()

data_generos$music_genre <- droplevels(data_generos$music_genre)
tabla_todo<-table(data_generos$music_genre, data_generos$claseskm)
kbl(tabla_todo, caption="K-means clustering: todos los géneros (6 clusters)")%>%kable_classic()

K-means clustering: todos los géneros (6 clusters)

	1	2	3	4	5	6
Blues	1862	6	1433	443	38	1218
Classical	183	990	308	1270	2007	242
Electronic	1589	0	932	178	19	2282
Hip-Hop	2280	0	570	51	3	2096
Jazz	1626	22	1776	846	225	505
Rock	1695	1	842	181	11	2270

Vemos que casi todos los clusters contienen muchos géneros y casi todos los géneros están dispersos en distintos clusters (la música clásica parecería diferenciarse más). Y si probamos con un k menor, por ejemplo 3? (nota: no tratamos de encontrar el k ideal mediante método de silueta u otros ya que todos los métodos son demasiado intensivos para la memoria de una computadora personal debido al tamaño del dataset):

clust_todo <- kmeans(data_generos[1:7],3)
data_generos$claseskm <- as.factor(clust_todo$cluster)
ggplot(data_generos, aes(PC1,PC2, col=music_genre, shape=claseskm))+
  geom_point(alpha=0.6)+
  scale_shape_discrete("Cluster")+
  scale_color_discrete("Género musical")+
  ggtitle("Clustering por K-medias: Todos los géneros (3 clusters)")+
  theme_ipsum()

data_generos$music_genre <- droplevels(data_generos$music_genre)
tabla_todo<-table(data_generos$music_genre, data_generos$claseskm)
kbl(tabla_todo, caption="K-means clustering: todos los géneros (3 clusters)")%>%kable_classic()

K-means clustering: todos los géneros (3 clusters)

	1	2	3
Blues	67	1884	3049
Classical	3261	1315	424
Electronic	33	1110	3857
Hip-Hop	4	640	4356
Jazz	319	2581	2100
Rock	20	1030	3950

data_generos %>%
  group_by(claseskm)%>%
  summarize(mean(PC1), mean(danceability), mean(loudness), mean(instrumentalness))%>%
  kbl()%>% kable_classic()

claseskm	mean(PC1)	mean(danceability)	mean(loudness)	mean(instrumentalness)
1	4.3944685	0.3068765	-25.523067	0.6531998
2	1.1401327	0.5421978	-12.983341	0.3039185
3	-0.8660341	0.6035143	-6.133267	0.1292650

Vemos un cluster con alto valor de PC1, baja “bailabilidad” y “loudness”, y alta “instrumentalidad”, cuya amplia mayoría son temas de música clásica; otro cluster con valores inversos que incluye a la mayoría de los temas de Hip Hop, Rock, Electronica y Blues; y un tercer cluster con valores intermedios donde predomina el Jazz.