Trabalho Final da Disciplina de Modelos Lineares
Amanda, Arthur, Gabriel e Karina
30/09/2023
Carregando pacotes
library(tidyverse)
library(car)
library(lme4)
library(rmarkdown)Importando os dados
# 1 oasso é setar o diretórtio.
setwd("C:/Users/barro/OneDrive/Documentos/Rodrigo_aula")
read.csv("dataset_Spotify.csv", sep = ";", encoding = "UTF-8") %>%
dplyr::select(1, 36, 30, 7, 9:18) %>%
dplyr::filter(!grepl("Melody_Lake", artist_name)) %>%
dplyr::rename(artista = artist_name,
adequada_para_danca = danceability,
energia = energy,
tom = key,
intensidade_sonora = loudness,
modo = mode,
fala = speechiness,
acustica = acousticness,
instrumentalizacao = instrumentalness,
ao_vivo = liveness,
qualidade_emocional = valence,
ano_do_album= album_release_year,
nome_da_musica=track_name,
nome_do_album=album_name) %>%
mutate(across(.cols = c("artista", "nome_da_musica", "nome_do_album"), .fns = as.factor )) -> clear_data
paged_table(clear_data)summary(clear_data)## artista
## Gilberto_Gil :1021
## Caetano_Veloso: 958
## Taylor_Swift : 476
## Linkin_Park : 460
## Dead_Fish : 370
## Beyoncé : 259
## (Other) : 269
## nome_do_album
## Meteora 20th Anniversary Edition : 88
## Hybrid Theory (20th Anniversary Edition) : 80
## Dois Amigos, um Século de Música (Ao Vivo) : 56
## reputation Stadium Tour Surprise Song Playlist : 46
## HOMECOMING: THE LIVE ALBUM : 40
## folklore: the long pond studio sessions (from the Disney+ special) [deluxe edition]: 34
## (Other) :3469
## nome_da_musica ano_do_album adequada_para_danca energia
## Molotov : 6 Min. :1962 Min. :0.0000 Min. :4.21e-05
## Mulheres Negras: 6 1st Qu.:1997 1st Qu.:0.4590 1st Qu.:3.66e-01
## Sonho Médio : 6 Median :2009 Median :0.5650 Median :6.30e-01
## Tango : 6 Mean :2005 Mean :0.5573 Mean :6.02e-01
## Terra : 6 3rd Qu.:2018 3rd Qu.:0.6640 3rd Qu.:8.56e-01
## Afasia : 5 Max. :2023 Max. :0.9660 Max. :9.99e-01
## (Other) :3778
## tom intensidade_sonora modo fala
## Min. : 0.000 Min. :-33.617 Min. :0.0000 Min. :0.00000
## 1st Qu.: 2.000 1st Qu.:-11.970 1st Qu.:0.0000 1st Qu.:0.03970
## Median : 5.000 Median : -8.322 Median :1.0000 Median :0.05810
## Mean : 5.149 Mean : -9.257 Mean :0.6793 Mean :0.09521
## 3rd Qu.: 8.000 3rd Qu.: -5.676 3rd Qu.:1.0000 3rd Qu.:0.10800
## Max. :11.000 Max. : -1.084 Max. :1.0000 Max. :0.94000
##
## acustica instrumentalizacao ao_vivo qualidade_emocional
## Min. :4.60e-06 Min. :0.0000000 Min. :0.0182 Min. :0.0000
## 1st Qu.:3.45e-02 1st Qu.:0.0000000 1st Qu.:0.1100 1st Qu.:0.2960
## Median :3.67e-01 Median :0.0000551 Median :0.2360 Median :0.4790
## Mean :4.05e-01 Mean :0.0586514 Mean :0.3743 Mean :0.4955
## 3rd Qu.:7.63e-01 3rd Qu.:0.0048600 3rd Qu.:0.6830 3rd Qu.:0.6930
## Max. :9.95e-01 Max. :0.9890000 Max. :0.9990 Max. :0.9830
## Há diferença nos índices de qualidade emocional dos álbuns da Taylor Swift ao longo dos anos?
Hipótese: Existe uma diferença nos índices de qualidade emocional dos álbuns mais recentes da Taylor Swift quando comparado aos álbuns mais antigos
Predição: Álbuns mais recentes apresentam maior índice de qualidade emocional
Análise
Remodelando o dado para criar o modelo
Processos:
Filtrar os dados pela artista
filter(artista=="Taylor_Swift")
Filtrar o nome dos álbuns pois eles tem diferentes versões. Peguei sempre que possível o álbum mais antigo.
filter(!grepl("Live", nome_do_album)) %>%filter(!grepl("eluxe", nome_do_album)) %>%filter(!grepl("dition", nome_do_album)) %>%Criamos uma columa dummy para ajudar nessa filtragem através do código:
mutate(dummy_col_album= case_when(...)) %>%
Selecionamos somente as colunas importantes
select(1:4, 14) %>%select(-dummy_col_album)
clear_data %>%
filter(artista=="Taylor_Swift") %>%
filter(!grepl("Live", nome_do_album)) %>%
filter(!grepl("eluxe", nome_do_album)) %>%
filter(!grepl("dition", nome_do_album)) %>%
select(1:4, 14) %>%
mutate(dummy_col_album= case_when(
nome_do_album=="Fearless (Taylor's Version)" ~ "exclude",
nome_do_album=="reputation Stadium Tour Surprise Song Playlist" ~ "exclude",
nome_do_album=="Speak Now (Taylor's Version)" ~ "exclude",
.default = "ok"
),
nome_do_album=as.factor(nome_do_album),
class_album_by_year=case_when(
ano_do_album == 2019 | ano_do_album == 2020 | ano_do_album == 2021 | ano_do_album == 2022 ~ "recente",
ano_do_album == 2014 | ano_do_album == 2010 | ano_do_album == 2008 | ano_do_album == 2006 | ano_do_album == 2017 ~ "antigo"
),
class_album_by_year=as.factor(class_album_by_year)) %>%
filter(dummy_col_album!="exclude") %>%
select(-dummy_col_album) %>%
glimpse-> data_model## Rows: 165
## Columns: 6
## $ artista <fct> Taylor_Swift, Taylor_Swift, Taylor_Swift, Taylor_S…
## $ nome_do_album <fct> "Midnights", "Midnights", "Midnights", "Midnights"…
## $ nome_da_musica <fct> "Lavender Haze", "Maroon", "Anti-Hero", "Snow On T…
## $ ano_do_album <int> 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2022, 20…
## $ qualidade_emocional <dbl> 0.0976, 0.0374, 0.5330, 0.1930, 0.3800, 0.2300, 0.…
## $ class_album_by_year <fct> recente, recente, recente, recente, recente, recen…summary(data_model)## artista nome_do_album
## Taylor_Swift :165 Red (Taylor's Version) :30
## Beyoncé : 0 Lover :18
## Caetano_Veloso: 0 Fearless (International Version):16
## Dead_Fish : 0 folklore :16
## Gilberto_Gil : 0 evermore :15
## Linkin_Park : 0 reputation :15
## (Other) : 0 (Other) :55
## nome_da_musica ano_do_album qualidade_emocional
## ...Ready For It? : 1 Min. :2006 Min. :0.0374
## ‘tis the damn season : 1 1st Qu.:2010 1st Qu.:0.2480
## 22 (Taylor's Version) : 1 Median :2019 Median :0.4030
## A Perfectly Good Heart: 1 Mean :2016 Mean :0.4001
## A Place in this World : 1 3rd Qu.:2021 3rd Qu.:0.5180
## Afterglow : 1 Max. :2022 Max. :0.9430
## (Other) :159
## class_album_by_year
## antigo :73
## recente:92
##
##
##
##
## paged_table(data_model)Modelo e seus pressupostos
data_model %>%
glimpse## Rows: 165
## Columns: 6
## $ artista <fct> Taylor_Swift, Taylor_Swift, Taylor_Swift, Taylor_S…
## $ nome_do_album <fct> "Midnights", "Midnights", "Midnights", "Midnights"…
## $ nome_da_musica <fct> "Lavender Haze", "Maroon", "Anti-Hero", "Snow On T…
## $ ano_do_album <int> 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2022, 20…
## $ qualidade_emocional <dbl> 0.0976, 0.0374, 0.5330, 0.1930, 0.3800, 0.2300, 0.…
## $ class_album_by_year <fct> recente, recente, recente, recente, recente, recen…lm(formula = qualidade_emocional ~ class_album_by_year, data = data_model) -> modelo_1
summary(modelo_1)##
## Call:
## lm(formula = qualidade_emocional ~ class_album_by_year, data = data_model)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.36172 -0.15112 0.00388 0.11663 0.54163
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.401367 0.022804 17.601 <2e-16 ***
## class_album_by_yearrecente -0.002249 0.030539 -0.074 0.941
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1948 on 163 degrees of freedom
## Multiple R-squared: 3.326e-05, Adjusted R-squared: -0.006102
## F-statistic: 0.005421 on 1 and 163 DF, p-value: 0.9414#normalidade
shapiro.test(residuals(modelo_1)) ## Não normais##
## Shapiro-Wilk normality test
##
## data: residuals(modelo_1)
## W = 0.97808, p-value = 0.01018#homocedasticidade (homogeneidade das variâncias)
leveneTest(modelo_1) ## variância são homogêneas ## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 1 0.0712 0.7899
## 163# Refazendo o modelo
lm(formula = sqrt(qualidade_emocional) ~ class_album_by_year, data = data_model) -> modelo_2
summary(modelo_2)##
## Call:
## lm(formula = sqrt(qualidade_emocional) ~ class_album_by_year,
## data = data_model)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.41760 -0.11300 0.02383 0.10662 0.35798
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.613100 0.018863 32.503 <2e-16 ***
## class_album_by_yearrecente -0.002105 0.025261 -0.083 0.934
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1612 on 163 degrees of freedom
## Multiple R-squared: 4.259e-05, Adjusted R-squared: -0.006092
## F-statistic: 0.006943 on 1 and 163 DF, p-value: 0.9337shapiro.test(residuals(modelo_2)) # são normais##
## Shapiro-Wilk normality test
##
## data: residuals(modelo_2)
## W = 0.98913, p-value = 0.2351# Anova
anova1<-aov(sqrt(qualidade_emocional) ~ class_album_by_year, data = data_model)
summary(anova1)## Df Sum Sq Mean Sq F value Pr(>F)
## class_album_by_year 1 0.000 0.00018 0.007 0.934
## Residuals 163 4.234 0.02597Rejeitamos a hipótese alternativa de que existia diferença da qualidade emocional entre os anos para os álbuns da Taylor.
Resultado e Gráficos
data_model %>%
ggplot(aes(class_album_by_year, sqrt(qualidade_emocional), col=class_album_by_year)) +
geom_boxplot(alpha=0.5)+
theme_classic()+
scale_color_discrete(name = "Categoria") +
labs(x = "Categoria dos Álbuns", y = "Qualidade Emocional")