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.

Carregando os Dados

library(readr)
song_data <- read_csv("song_data.csv")

# Estrutura dos dados
# str(song_data)

# Dimensão
dim(song_data)
## [1] 18835    15
# Verificar missing values
sum(is.na(song_data))
## [1] 0

Apó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.

set.seed(123)

library(caret)

ind.tr <- createDataPartition(song_data$popular,p=0.7,list=FALSE)

song.tr <- song_data[ind.tr,]
song.te <- song_data[-ind.tr,]

Preparação das matrizes

library(glmnet)

x.tr <- data.matrix(song.tr[ , !(names(song.tr) %in% "popular")])
t.tr <- song.tr$popular

x.te <- data.matrix(song.te[ , !(names(song.te) %in% "popular")])
t.te <- song.te$popular

Malha de hiperparâmetros

O hiperparâmetro principal é \(\lambda\), que controla a intensidade da penalização.

lambda.grid <- 10^seq(-10,10,length.out=30)

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

model_log = glm(popular~.,data = song.tr, family = "binomial")
summary(model_log)
## 
## 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: 6

Para 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   38

3.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)

song.ridge.cv$lambda.min
## [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)

song.lasso.cv$lambda.min
## [1] 0.0001610262

3.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   36

A 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   36

4.2 Matrizes de confusão

library(caret)
confusionMatrix(pred_log_class,t.te)
## 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               
## 
confusionMatrix(as.factor(pred_ridge), t.te,  mode="everything",
                positive="1"
                )
## 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               
## 
confusionMatrix(as.factor(pred_lasso), t.te,  mode="everything",
                positive="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

library(pROC)
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

Nestes gráficos é possível constactar algumas variáveis com coeficiente zero, indicando que não são relevantes.

library(ggplot2)

# Extrair coeficientes do modelo logístico
coef_log <- coef(model_log)

# Transformar em data frame
coef_df <- data.frame(
  variable = names(coef_log),    # usar names() e não rownames()
  coef = as.numeric(coef_log)
)

# Remover intercepto
coef_df <- coef_df[coef_df$variable != "(Intercept)", ]

# Gráfico de barras horizontal
ggplot(coef_df, aes(x = reorder(variable, coef), y = coef)) +
  geom_bar(stat="identity") +
  coord_flip() +
  labs(
    title = "Importância das Variáveis (Modelo Logístico)",
    x = "Variável",
    y = "Coeficiente"
  ) +
  theme_minimal()

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.