Modelos de Regressão Logística para Previsão de Popularidade Musical
Trabalho de Grupo
Civania Garcia, Wadiley Nascimento e William Nascimento
1. Contextualização do Problema e dos Dados
A indústria musical utiliza cada vez mais análise de dados e aprendizagem automática para compreender os fatores que influenciam o sucesso de uma música.
Neste trabalho utilizamos o conjunto de dados Song Popularity Dataset, disponível na plataforma Kaggle, contendo características acústicas de músicas extraídas do Spotify.
O objetivo é prever se uma música será popular ou não, utilizando:
- Regressão Logística Clássica
- Regressão Logística com Regularização Ridge
- Regressão Logística com Regularização LASSO
Variável Dependente
Como a regressão logística exige uma variável binária, a variável original song_popularity é transformada numa variável binária:
- 1 → Música Popular (popularidade ≥ 70)
- 0 → Música Não Popular (popularidade < 70)
Assim, o problema torna-se um problema de classificação binária.
2. Procedimento Experimental
Bibliotecas utilizadas
## [1] "LC_COLLATE=Portuguese_Portugal.utf8;LC_CTYPE=Portuguese_Portugal.utf8;LC_MONETARY=Portuguese_Portugal.utf8;LC_NUMERIC=C;LC_TIME=Portuguese_Portugal.utf8"Carregando os Dados
## spc_tbl_ [18,835 × 15] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ song_name : chr [1:18835] "Boulevard of Broken Dreams" "In The End" "Seven Nation Army" "By The Way" ...
## $ song_popularity : num [1:18835] 73 66 76 74 56 80 81 76 80 81 ...
## $ song_duration_ms: num [1:18835] 262333 216933 231733 216933 223826 ...
## $ acousticness : num [1:18835] 0.00552 0.0103 0.00817 0.0264 0.000954 ...
## $ danceability : num [1:18835] 0.496 0.542 0.737 0.451 0.447 0.316 0.581 0.613 0.33 0.542 ...
## $ energy : num [1:18835] 0.682 0.853 0.463 0.97 0.766 0.945 0.887 0.953 0.936 0.905 ...
## $ instrumentalness: num [1:18835] 2.94e-05 0.00 4.47e-01 3.55e-03 0.00 ...
## $ key : num [1:18835] 8 3 0 0 10 4 4 2 1 9 ...
## $ liveness : num [1:18835] 0.0589 0.108 0.255 0.102 0.113 0.396 0.268 0.152 0.0926 0.136 ...
## $ loudness : num [1:18835] -4.09 -6.41 -7.83 -4.94 -5.07 ...
## $ audio_mode : num [1:18835] 1 0 1 1 1 0 0 1 1 1 ...
## $ speechiness : num [1:18835] 0.0294 0.0498 0.0792 0.107 0.0313 0.124 0.0624 0.0855 0.0917 0.054 ...
## $ tempo : num [1:18835] 167 105 124 122 172 ...
## $ time_signature : num [1:18835] 4 4 4 4 4 4 4 4 4 4 ...
## $ audio_valence : num [1:18835] 0.474 0.37 0.324 0.198 0.574 0.32 0.724 0.537 0.234 0.374 ...
## - attr(*, "spec")=
## .. cols(
## .. song_name = col_character(),
## .. song_popularity = col_double(),
## .. song_duration_ms = col_double(),
## .. acousticness = col_double(),
## .. danceability = col_double(),
## .. energy = col_double(),
## .. instrumentalness = col_double(),
## .. key = col_double(),
## .. liveness = col_double(),
## .. loudness = col_double(),
## .. audio_mode = col_double(),
## .. speechiness = col_double(),
## .. tempo = col_double(),
## .. time_signature = col_double(),
## .. audio_valence = col_double()
## .. )
## - attr(*, "problems")=<externalptr>## [1] 18835 15## [1] 0Após a inspeção inicial, verificou-se que o conjunto de dados contém aproximadamente 18 835 observações e 15 variáveis, representando características acústicas extraídas da plataforma Spotify.
Após isso, foi necessário eliminar algumas variáveis irrelevantes para o estudo, após a codificação da variável categórica binária.
# Criar variável binária
song_data$popular <- ifelse(song_data$song_popularity >= 70,1,0)
# Remover variáveis não relevantes
song_data <- song_data[ , !(names(song_data) %in% c("song_name","song_popularity"))]
# Converter para factor
song_data$popular <- as.factor(song_data$popular)
# Visualizar o conjunto de Dados
View(song_data)Separação Treino/Teste
Utilizamos divisão 70% treino / 30% teste.
Preparação das matrizes
3. Treino dos Modelos
A Função logística modela a probabilidade de uma música ser popular é definida por:
\[ P(Y = 1) = \frac{1}{1 + e^{-(\beta_0 + \beta_1 X_1 + \cdots + \beta_p X_p)}} \]
3.1 Regressão Logística Clássica
##
## Call:
## glm(formula = popular ~ ., family = "binomial", data = song.tr)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 6.510e-01 4.348e-01 1.497 0.13431
## song_duration_ms 1.082e-06 3.946e-07 2.743 0.00609 **
## acousticness -7.920e-01 1.099e-01 -7.204 5.83e-13 ***
## danceability 1.498e+00 1.672e-01 8.961 < 2e-16 ***
## energy -1.835e+00 2.002e-01 -9.165 < 2e-16 ***
## instrumentalness -2.852e+00 2.311e-01 -12.340 < 2e-16 ***
## key -1.484e-02 5.965e-03 -2.488 0.01285 *
## liveness -7.337e-01 1.622e-01 -4.523 6.10e-06 ***
## loudness 1.556e-01 1.146e-02 13.580 < 2e-16 ***
## audio_mode -8.447e-02 4.485e-02 -1.883 0.05963 .
## speechiness -2.425e-01 2.155e-01 -1.125 0.26045
## tempo -5.545e-04 7.867e-04 -0.705 0.48094
## time_signature 5.620e-02 8.693e-02 0.646 0.51796
## audio_valence -5.941e-01 1.034e-01 -5.745 9.20e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 14419 on 13184 degrees of freedom
## Residual deviance: 13391 on 13171 degrees of freedom
## AIC: 13419
##
## Number of Fisher Scoring iterations: 6Para verificar o modelo contruído, realizou-se a previsão no conjunto de teste, como a seguir se indica:
pred_log_prob = predict(model_log, newdata = song.te, type = "response")
# Converter probabilidade em classe
pred_log_class <- ifelse(pred_log_prob>0.5,1,0)
pred_log_class <- as.factor(pred_log_class); table(pred_log_class)## pred_log_class
## 0 1
## 5612 383.2 Treino com validação cruzada
# Regressão Ridge
song.ridge.cv <- cv.glmnet(
x.tr,
t.tr,
alpha=0,
family="binomial",
lambda=lambda.grid,
nfolds=10
)
plot(song.ridge.cv)
## [1] 0.0007880463# Regressão LASSO
song.lasso.cv <- cv.glmnet(
x.tr,
t.tr,
alpha=1,
family="binomial",
lambda=lambda.grid,
nfolds=10
)
plot(song.lasso.cv)
## [1] 0.00016102623.3 Modelo Final
Treinamos novamente usando o melhor \(λ\).
# Ridge Final
song.ridge.final <- glmnet(
x.tr,
t.tr,
alpha=0,
family="binomial",
lambda=song.ridge.cv$lambda.min
)
pred_ridge <- predict(song.ridge.final,newx=x.te,type="class") # retorna a classe
table(pred_ridge)## pred_ridge
## 0 1
## 5616 34# Lasso Final
song.lasso.final <- glmnet(
x.tr,
t.tr,
alpha=1,
family="binomial",
lambda=song.lasso.cv$lambda.min
)
pred_lasso <- predict(song.lasso.final,newx=x.te,type="class") # retorna a classe
table(pred_lasso)## pred_lasso
## 0 1
## 5614 36A partir dos resultados podemos observar: i) quais coeficientes ficaram zero e ii) quais variáveis foram selecionadas pelo modelo.
4. Apresentação e Comparação de Resultados
4.1 Previsões no conjunto de teste
# Ridge Final
pred.probr <- predict(song.ridge.final,
newx=x.te,
type="response" # retorna a probabilidade
)
pred.classr <- ifelse(pred.probr > 0.5,1,0)
pred.classr <- as.factor(pred.classr)
table(pred.classr)## pred.classr
## 0 1
## 5616 34# Lasso Final
pred.probl <- predict(song.lasso.final,
newx=x.te,
type="response" # retorna a probabilidade
)
pred.classl <- ifelse(pred.probl > 0.5,1,0)
pred.classl <- as.factor(pred.classl)
table(pred.classl)## pred.classl
## 0 1
## 5614 36Matrizes de confusão
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 4289 1323
## 1 26 12
##
## Accuracy : 0.7612
## 95% CI : (0.7499, 0.7723)
## No Information Rate : 0.7637
## P-Value [Acc > NIR] : 0.6759
##
## Kappa : 0.0045
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.993975
## Specificity : 0.008989
## Pos Pred Value : 0.764255
## Neg Pred Value : 0.315789
## Prevalence : 0.763717
## Detection Rate : 0.759115
## Detection Prevalence : 0.993274
## Balanced Accuracy : 0.501482
##
## 'Positive' Class : 0
## ## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 4291 1325
## 1 24 10
##
## Accuracy : 0.7612
## 95% CI : (0.7499, 0.7723)
## No Information Rate : 0.7637
## P-Value [Acc > NIR] : 0.6759
##
## Kappa : 0.0029
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.007491
## Specificity : 0.994438
## Pos Pred Value : 0.294118
## Neg Pred Value : 0.764067
## Precision : 0.294118
## Recall : 0.007491
## F1 : 0.014609
## Prevalence : 0.236283
## Detection Rate : 0.001770
## Detection Prevalence : 0.006018
## Balanced Accuracy : 0.500964
##
## 'Positive' Class : 1
## ## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 4289 1325
## 1 26 10
##
## Accuracy : 0.7609
## 95% CI : (0.7495, 0.772)
## No Information Rate : 0.7637
## P-Value [Acc > NIR] : 0.698
##
## Kappa : 0.0022
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.007491
## Specificity : 0.993975
## Pos Pred Value : 0.277778
## Neg Pred Value : 0.763983
## Precision : 0.277778
## Recall : 0.007491
## F1 : 0.014588
## Prevalence : 0.236283
## Detection Rate : 0.001770
## Detection Prevalence : 0.006372
## Balanced Accuracy : 0.500733
##
## 'Positive' Class : 1
## 5. Curva ROC
roc_log <- roc(t.te,pred_log_prob)
roc_ridge <- roc(t.te,pred.probr)
roc_lasso <- roc(t.te,pred.probl)
plot(roc_log,col="blue",legacy.axes=TRUE)
plot(roc_ridge,col="red", add=TRUE)
plot(roc_lasso,col="darkgreen",add=TRUE)
legend("bottomright",
legend=c("Logístico","Ridge","LASSO"),
col=c("blue","red","darkgreen"),
lwd=2)
6. Importância das Variáveis
No LASSO algumas variáveis recebem coeficiente zero, indicando que não são relevantes.
coef_lasso <- coef(song.lasso.final)
coef_df <- data.frame(
variable = rownames(coef_lasso),
coef = as.numeric(coef_lasso)
)
coef_df <- coef_df[coef_df$variable!="(Intercept)",]
ggplot(coef_df,aes(x=reorder(variable,coef),y=coef)) +
geom_bar(stat="identity") +
coord_flip() +
labs(title="Importância das Variáveis (LASSO)",
x="Variável",
y="Coeficiente")
coef_ridge <- coef(song.ridge.final)
coef_df <- data.frame(
variable = rownames(coef_ridge),
coef = as.numeric(coef_ridge)
)
coef_df <- coef_df[coef_df$variable!="(Intercept)",]
ggplot(coef_df,
aes(x=reorder(variable,abs(coef)),
y=coef)) +
geom_bar(stat="identity") +
coord_flip() +
labs(title="Importância das Variáveis (LASSO)",
x="Variável",
y="Coeficiente")
7. Discussão
Os resultados obtidos mostram que algumas características acústicas exercem influência relevante na popularidade das músicas.
Entre as variáveis com maior contribuição destacam-se:
- danceability – indica o quão adequada a música é para dançar;
- loudness – nível médio de intensidade sonora;
- time_signature – estrutura rítmica da música.
Observa-se ainda que os modelos LASSO e RIDGE tende a selecionar um subconjunto reduzido de variáveis, eliminando automaticamente aquelas com menor relevância estatística.
Este comportamento torna o modelo particularmente útil em cenários com elevado número de preditores.
8. Conclusões
Os resultados deste estudo demonstram que modelos de regressão logística são capazes de capturar relações relevantes entre características acústicas e popularidade musical.
A introdução de regularização, permiteu melhorar a capacidade de generalização do modelo e simultaneamente realizar seleção automática de variáveis.
Dessa forma, técnicas de aprendizagem estatística podem constituir ferramentas importantes para a indústria musical, permitindo identificar padrões associados ao sucesso de uma música.