Análise de Regressão Múltipla: Avaliações de séries ao longo das temporadas

library(ggplot2)
library(tidyverse)
library(readr)

Introdução

Depois do lançamento da última temporada de Game of Thrones, surgiu a discussão na internet sobre séries que marcaram os telespectadores por seus finais decepcionantes. Tendo isso em vista, tivemos a curiosidade de descobrir se séries conforme o passar das temporadas decaem sua qualidade na opinião do público.

Para isso, tivemos acesso ao dataset do IMDB com os dados de 889 séries lançadas até o início de 2018 e obtivemos as seguintes variáveis:

data_series <- read.csv("series_from_imdb.csv", header = T, stringsAsFactors = F)

data_series %>% glimpse()

## Observations: 64,018
## Variables: 18
## $ series_name <chr> "Breaking Bad", "Breaking Bad", "Breaking Bad", "Bre…
## $ episode     <chr> "Pilot", "Cat's in the Bag...", "...And the Bag's in…
## $ series_ep   <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1…
## $ season      <int> 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2…
## $ season_ep   <int> 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, …
## $ url         <chr> "http://www.imdb.com/title/tt0959621/?ref_=ttep_ep1"…
## $ user_rating <dbl> 8.9, 8.7, 8.7, 8.2, 8.3, 9.2, 8.8, 8.7, 9.2, 8.3, 8.…
## $ user_votes  <int> 18483, 12890, 12499, 12172, 11896, 13716, 12123, 107…
## $ r1          <dbl> 0.06432938, 0.03289372, 0.04088327, 0.07484390, 0.07…
## $ r2          <dbl> 0.001677217, 0.001396431, 0.002480198, 0.002546829, …
## $ r3          <dbl> 0.002055943, 0.002482545, 0.002160173, 0.002300361, …
## $ r4          <dbl> 0.002813396, 0.004344453, 0.003600288, 0.005093658, …
## $ r5          <dbl> 0.007304009, 0.011171451, 0.010400832, 0.013720013, …
## $ r6          <dbl> 0.013039009, 0.018929403, 0.020401632, 0.032533684, …
## $ r7          <dbl> 0.04723259, 0.07866563, 0.06968557, 0.12520539, 0.11…
## $ r8          <dbl> 0.13991235, 0.23840186, 0.20737659, 0.28738087, 0.27…
## $ r9          <dbl> 0.2596981, 0.2604344, 0.2615409, 0.1485376, 0.162491…
## $ r10         <dbl> 0.4619380, 0.3512801, 0.3814705, 0.3078377, 0.316324…

Abaixo temos o significado de cada uma das 18 variáveis:

* series_name <chr> Nome da série
* series_ep   <int> Índice geral do episódio
* season      <int> Número da temporada
* season_ep   <int> Índice do episódio na temporada
* url         <chr> url do IMDB para o episódio (eg "http://www.imdb.com/title/tt5174246/")
* episode    <chr> Título do episódio
* user_rating  <dbl> Avaliação do usuário com base no cálculo do IMDB [tal qual explicado em](http://www.imdb.com/help/show_leaf?votestopfaq).
* user_votes  <dbl> Quantidade de votos no episódio
* r1          <dbl> Proporção de usuários que avaliaram esse episódio com nota 1
* r2          <dbl> Proporção de usuários que avaliaram esse episódio com nota 2
* ...
* r10         <dbl> Proporção de usuários que avaliaram esse episódio com nota 10

Através da discussão online, observamos uma grande ocorrência de comentários acerca de determinadas séries. Para visualizarmos se era, de fato, uma opinião geral, exemplificamos através de um gráfico de linha as avaliações por temporada de algumas das séries mais comentadas nas redes sociais. Foram elas:

Dr. House

data_series %>% # 
  filter(series_name %in% "Dr. House") %>%
  group_by(season) %>%
  summarise(mediana_votos = median(user_rating)) %>%
  ggplot(aes(x = season, y = mediana_votos)) + geom_line()

Prison Break

data_series %>% # 
  filter(series_name %in% "Prison Break") %>%
  group_by(season) %>%
  summarise(mediana_votos = median(user_rating)) %>%
  ggplot(aes(x = season, y = mediana_votos)) + geom_line()

Vikings

data_series %>% # 
  filter(series_name %in% "Vikings") %>%
  group_by(season) %>%
  summarise(mediana_votos = median(user_rating)) %>%
  ggplot(aes(x = season, y = mediana_votos)) + geom_line()

É possível notar nos exemplos que houve uma queda na qualidade das temporadas, segundo os usuários, conforme passaram as temporadas. Entretanto, é necessário estudar outras variáveis antes de tomar conclusões sobre a correlação.

Distribuição

Para melhor verificarmos a nossa hipótese e criar uma noção intuitiva de como os dados se comportam, analisamos a distribuição das avalições para cada temporada nas séries exemplificadas.

House

data_series %>% filter(series_name == "Dr. House") %>% 
  ggplot(mapping = aes(x = season, y = user_rating, group = season)) +
  geom_boxplot()

Prison Break

data_series %>% filter(series_name == "Prison Break") %>% 
  ggplot(mapping = aes(x = season, y = user_rating, group = season)) +
  geom_boxplot()

Vikings

data_series %>% filter(series_name == "Vikings") %>% 
  ggplot(mapping = aes(x = season, y = user_rating, group = season)) +
  geom_boxplot()

Podemos perceber que, apesar de a avaliação ainda aparentar decrescer conforme as temporadas avançam, observar a distribuição mostra que esse decaimento é menos acentuado quando comparado com os gráficos de linha. Além disso, é possível notar um aumento na dispersão das avaliações a partir da 5 temporada das séries exemplificadas, possivelmente indicando uma maior divergência de opiniões quanto mais longa a série.

Correlação

Prosseguindo a análise descritiva dos exemplos de séries escolhidas (Dr. House, Prison Break e Vikings), verificamos também a correlação entre o número da temporada (season) de cada episódio e sua avaliação.

House

house <- data_series %>% filter(series_name == "Dr. House")
cor(house$season, house$user_rating)

## [1] -0.1848147

Prison Break

pb <- data_series %>% filter(series_name == "Prison Break")
cor(pb$season, pb$user_rating)

## [1] -0.5915697

Vikings

pb <- data_series %>% filter(series_name == "Vikings")
cor(pb$season, pb$user_rating)

## [1] -0.1993758

A partir da análise de correlação, podemos ver que para essas 3 séries a correlação entre as variáveis escolhidas de fato ocorre. Nos três exemplos, a tendência da avaliação dos episódios é diminuir conforme o número da temporada cresce. A série Prison Break possui a correlação mais acentuada dentre os exemplos: o coeficiente de correlação entre o número da temporada e a avaliação do episódio tem valor -0.5915, ou seja, os episódios têm uma forte tendência a caírem a avaliação com o passar das temporadas.

Distribuição geral

Com intuição e hipótese prontas, podemos começar a analisar o comportamento das variáveis citadas para todo o banco de dados. Primeiramente verificamos como se comporta a distribuição de avaliações por número de temporada:

data_series %>% filter(season > 0) %>%
  ggplot(mapping = aes(x = season, y = user_rating, group = season)) +
  geom_boxplot()

Podemos perceber visualmente que as avaliações são extremamente dispersas, principalmente entre as 10 primeiras temporadas. Também é plausivel dizer que existe um suave queda nas notas dos usuários quando observamos o comportamento das medianas, mas ainda são necessárias mais estatísticas que relacionem numericamente a temporada com a avaliação.

Correlação geral

Calculamos em seguida a correlação entre o número da temporada e as notas dadas pelos usuários para todo o banco de dados:

pb <- data_series %>% filter(season > 0)
cor(pb$season, pb$user_rating)

## [1] -0.1500418

Com um coeficiente de correlação de aproximadamente -0.15 verificamos que existe uma relação inversamente proporcional entre as variáveis analisadas, ainda que não tão acentuada como nos exemplos discutidos, tal qual Prison Break com seu coeficiente de -0.5915.

Regressão Linear com uma variável

A partir da análise descritiva feita nos passos anteriores, testamos se há regressão linear se tratando do número de temporada e avaliação de um episódio.

dados_uteis <- data_series %>% filter(season > 0) %>% select(season, user_rating)

modelo <- lm(data = dados_uteis, user_rating ~ season, na.action = na.omit)

modelo

## 
## Call:
## lm(formula = user_rating ~ season, data = dados_uteis, na.action = na.omit)
## 
## Coefficients:
## (Intercept)       season  
##      7.8999      -0.0268

Com o resultado obtido, podemos verificar que a função que determinaria/preveria a nota de um episódio com base em sua temporada, dada a regressão, seria (y = -0.0265 * x + 7.8975); ou seja, a previsão é de que a nota dos episódios caia (ainda que pouco), a cada temporada que se passa, e suas notas iniciais sejam algo próximo de 7.9.

Regressão Linear com múltiplas variáveis

Para realizar a regressão linear com múltiplas variáveis, desconsideramos aquelas variáveis cujo tipo não é numérico, pois necessitaríamos de processamento de linguagem natural, o que não faz parte do escopo da pesquisa. Além disso, também desconsideramos o atributo season_ep, já que o atributo series_ep já nos é suficiente.

atributos_uteis <- data_series %>% select(series_ep, season, user_rating, user_votes, r1, r2, r3, r4, r5, r6, r7, r8, r9, r10)

summary(atributos_uteis)

##    series_ep          season        user_rating      user_votes      
##  Min.   :  1.00   Min.   :-1.000   Min.   :1.600   Min.   :     6.0  
##  1st Qu.: 20.00   1st Qu.: 2.000   1st Qu.:7.400   1st Qu.:    65.0  
##  Median : 49.00   Median : 3.000   Median :7.800   Median :   150.0  
##  Mean   : 67.94   Mean   : 4.201   Mean   :7.786   Mean   :   473.7  
##  3rd Qu.: 93.00   3rd Qu.: 5.000   3rd Qu.:8.300   3rd Qu.:   394.0  
##  Max.   :875.00   Max.   :44.000   Max.   :9.900   Max.   :159456.0  
##        r1                 r2                 r3          
##  Min.   :0.000000   Min.   :0.000000   Min.   :0.000000  
##  1st Qu.:0.007853   1st Qu.:0.000000   1st Qu.:0.000000  
##  Median :0.020054   Median :0.003017   Median :0.005618  
##  Mean   :0.034721   Mean   :0.008504   Mean   :0.011304  
##  3rd Qu.:0.042305   3rd Qu.:0.010695   3rd Qu.:0.014706  
##  Max.   :0.772455   Max.   :0.488636   Max.   :0.360000  
##        r4                 r5                r6                r7        
##  Min.   :0.000000   Min.   :0.00000   Min.   :0.00000   Min.   :0.0000  
##  1st Qu.:0.002703   1st Qu.:0.01550   1st Qu.:0.04103   1st Qu.:0.1159  
##  Median :0.010101   Median :0.03030   Median :0.07071   Median :0.1765  
##  Mean   :0.017032   Mean   :0.04207   Mean   :0.08553   Mean   :0.1827  
##  3rd Qu.:0.022727   3rd Qu.:0.05556   3rd Qu.:0.11429   3rd Qu.:0.2437  
##  Max.   :0.294118   Max.   :0.41667   Max.   :0.50000   Max.   :0.6667  
##        r8               r9              r10        
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.1627   1st Qu.:0.0750   1st Qu.:0.1667  
##  Median :0.2307   Median :0.1212   Median :0.2306  
##  Mean   :0.2250   Mean   :0.1331   Mean   :0.2600  
##  3rd Qu.:0.2903   3rd Qu.:0.1830   3rd Qu.:0.3221  
##  Max.   :0.6562   Max.   :0.5212   Max.   :0.9244

modelo2 <- lm(data = atributos_uteis, user_rating ~ .)
modelo2

## 
## Call:
## lm(formula = user_rating ~ ., data = atributos_uteis)
## 
## Coefficients:
## (Intercept)    series_ep       season   user_votes           r1  
##   9.830e+00    4.857e-05    1.740e-03    7.295e-06   -8.189e+00  
##          r2           r3           r4           r5           r6  
##  -7.527e+00   -6.877e+00   -5.886e+00   -4.926e+00   -3.979e+00  
##          r7           r8           r9          r10  
##  -2.857e+00   -1.772e+00   -4.739e-01           NA

summary(modelo2)

## 
## Call:
## lm(formula = user_rating ~ ., data = atributos_uteis)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.51935 -0.05182 -0.00084  0.05271  2.31135 
## 
## Coefficients: (1 not defined because of singularities)
##               Estimate Std. Error  t value Pr(>|t|)    
## (Intercept)  9.830e+00  3.706e-03 2652.566  < 2e-16 ***
## series_ep    4.857e-05  7.362e-06    6.597 4.22e-11 ***
## season       1.740e-03  1.298e-04   13.403  < 2e-16 ***
## user_votes   7.295e-06  3.222e-07   22.644  < 2e-16 ***
## r1          -8.189e+00  1.179e-02 -694.423  < 2e-16 ***
## r2          -7.527e+00  3.506e-02 -214.683  < 2e-16 ***
## r3          -6.877e+00  3.597e-02 -191.164  < 2e-16 ***
## r4          -5.886e+00  2.849e-02 -206.611  < 2e-16 ***
## r5          -4.926e+00  1.737e-02 -283.603  < 2e-16 ***
## r6          -3.979e+00  1.254e-02 -317.379  < 2e-16 ***
## r7          -2.857e+00  8.202e-03 -348.344  < 2e-16 ***
## r8          -1.772e+00  7.299e-03 -242.735  < 2e-16 ***
## r9          -4.739e-01  1.064e-02  -44.550  < 2e-16 ***
## r10                 NA         NA       NA       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1347 on 64005 degrees of freedom
## Multiple R-squared:  0.9694, Adjusted R-squared:  0.9694 
## F-statistic: 1.69e+05 on 12 and 64005 DF,  p-value: < 2.2e-16

Com o resultado obtido, podemos ver que o nosso modelo de regressão parece se adequar à nossa base de dados e variáveis escolhidas, já que o seu coeficiente de determinação possui valor elevado (próximo de 100%), e seu erro residual padrão é baixo. A partir dele, podemos verificar que a variável que possui maior correlação com a avaliação dos episódios são as notas dadas pelos usuários (r1, r2, r3… o que já era esperado), e, depois disso, a segunda variável que possui maior correlação é o número da temporada à qual o episódio pertence; mesmo sendo a variável a possuir a segunda maior correlação, podemos perceber que o nível de correlação dela é relativamente baixo quando comparado à correlação das variáveis que representam as notas dadas pelos usuários (o número da temporada quando comparado à variável r8 tem em torno de 2300 vezes menos impacto na avaliação do episódio, por exemplo).

Conclusão

Diante do que foi visto, pudemos perceber que, apesar de haver certa correlação, esta ainda é muito baixa para que possamos confirmar nossa previsão de que séries de uma grande quantidade de temporadas sempre decaem sua qualidade de acordo com a opinião do público conforme o passar do tempo. É possível notar que até mesmo as avaliações positivas, mostradas por r9 e r8, não deixam de indicar que a série continuará decaindo sua performance segundo o público. Em outras palavras, boas avaliações podem até desacelerar o processo, mas, segundo os dados apresentados, toda série tende a uma menor avaliação dos usuários com o passar do tempo. Ou seja, todo cuidado é pouco, roteiristas.