Dupla:
Daniel Rodrigues Coura
Daniele Aparecida de Melo Silva Coura

library(tidyverse)
library(here)
library(knitr)
theme_set(theme_bw())

Geração dos dados

Os dados foram gerados em Março de 2019 a partir das classificações fornecidas no IMDB para episódios de séries populares de TV e streaming. Cada linha no dataset é um episódio de uma série. As séries foram selecionadas manualmente. As variáveis são as seguintes:

series = read_csv(
  here("data/series_from_imdb.csv"),
  col_types = cols(
    series_name = col_character(),
    episode = col_character(),
    series_ep = col_double(),
    season = col_double(),
    season_ep = col_double(),
    url = col_character(),
    user_rating = col_double(),
    user_votes = col_double(),
    r1 = col_double(),
    r2 = col_double(),
    r3 = col_double(),
    r4 = col_double(),
    r5 = col_double(),
    r6 = col_double(),
    r7 = col_double(),
    r8 = col_double(),
    r9 = col_double(),
    r10 = col_double()
  )
)

Análise exploratória das variáveis

Votos dos usuários

Após aplicar a escala logarítmica sobre os votos, temos que:

  • A mediana dos votos dos episódios é 150;
  • 80% do episódios tiveram até 536 votos;
  • A distribuição dos votos possui cauda longa à direita;
  • Há alguns pontos extremos, o episódio mais votado possui mais de 150.000 votos, isso é mais de 1000 vezes mais que a mediana.
series %>%
  ggplot(aes(x = user_votes, y = "")) +
  geom_jitter(alpha = 0.4,
              height = 0.1,
              color = "darkgoldenrod1") +
  geom_boxplot(color = "darkgoldenrod4",
               fill = "transparent",
               outlier.color = "transparent") +
  scale_x_log10() +
  labs(x = "Votos", y = "", title = "Distribuição dos votos dos usuários")

series %>% 
  ggplot(aes(x = user_votes)) +
  geom_density(color="darkgoldenrod4", fill="darkgoldenrod1") +
  geom_rug(color = "darkgoldenrod4") +
  labs(x = "Votos", y = "Densidade", title = "Densidade dos votos dos usuários")

series %>% 
  summarise(
    Mediana = median(user_votes, na.rm = TRUE),
    `80 percentil` = quantile(user_votes, probs = 0.80),
    Máximo = max(user_votes)
  ) %>% 
  kable(align = "l")
Mediana 80 percentil Máximo
150 536 159456

Rating dos usuários

Os ratings dos usuários têm distribuição simétrica, com pico em torno de 8.
Além disso, 86% dos episódios têm rating acima de 7.

series %>% 
  ggplot(aes(x = user_rating, y = "")) +
  geom_jitter(alpha=0.3, height = 0.1, color = "cyan2") +
  geom_boxplot(color="darkcyan", fill="transparent", outlier.color = "transparent") +
  scale_x_log10() +
  labs(x = "Rating", y = "", title = "Distribuição dos ratings dos usuários")

series %>% 
  ggplot(aes(x = user_rating)) +
  geom_density(color="darkcyan", fill="cyan2", alpha = 0.5) + 
  geom_rug(color = "darkcyan") +
  labs(x = "Rating", y = "Densidade", title = "Densidade dos ratings dos usuários")

series %>% 
  summarise(
    Mediana = median(user_rating, na.rm = TRUE),
    `14 percentil` = quantile(user_rating, probs = 0.14)
  ) %>%
  kable(align = "l")
Mediana 14 percentil
7.8 7

Interpretações dos resultados

Como se comporta o rating dos episódios das séries mais votadas?

Primeiramente, selecionamos um top 5 utilizando a média de votos dos episódios de cada série.

As séries mais votadas foram:

top_five <-
  series %>%
  group_by(series_name) %>%
  summarise(
    mean_votes = mean(user_votes),
    mean_rating = mean(user_rating),
    episodes = max(series_ep),
    .groups = "drop"
  ) %>%
  arrange(-mean_votes) %>%
  head(5)

top_five %>%
  select(
    "Série" = series_name,
    "Média de votos" = mean_votes,
    "Média de rating" = mean_rating,
    "Episódios" = episodes
  ) %>% kable(align = "l")
Série Média de votos Média de rating Episódios
Black Mirror 30370.47 8.094737 19
Game of Thrones 29257.01 9.111940 67
Sherlock 22368.00 8.820000 15
Breaking Bad 15304.87 8.911290 62
Stranger Things 12064.00 8.705882 17

Após calcular as medianas, temos que todas as séries possuem boas avaliações, entre 8,2 e 9,0.

Black Mirror é a série com mais avaliações abaixo de 8.

Stranger Things possui a menor distância interquartil (0,5), o que significa que os episódios têm avaliações muito próximas. Além disso, possui um único valor extremo, de rating 6.

top_series <-
  series %>% 
  filter(series_name %in% top_five$series_name)

top_series %>%  
  ggplot(aes(x = user_rating, y = series_name, color = series_name)) + 
  geom_violin(color = "transparent", fill = "grey90") +
  geom_jitter(height = 0.1, alpha = 0.4) +
  stat_summary(
    geom = "point",
    color = "blue",
    size = 3,
    fun = median
  ) +
  labs(
        x = "Rating",
        y = "",
        title = "Distribuição do rating dos episódios das 5 séries mais votadas",
        subtitle = "Dados de Março de 2019. O ponto azul representa a mediana.",
        color = ""
  ) + theme(legend.position = "none")

top_series %>%
  group_by(series_name) %>%
  summarise(
    Mediana = median(user_rating, na.rm = TRUE),
    Média = mean(user_rating, na.rm = TRUE),
    `Distância Interquartil` = IQR(user_rating, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  rename(Séries = series_name) %>%
  kable(align = "l")
Séries Mediana Média Distância Interquartil
Black Mirror 8.2 8.094737 0.85
Breaking Bad 8.8 8.911290 0.65
Game of Thrones 9.0 9.111940 0.70
Sherlock 9.0 8.820000 0.75
Stranger Things 8.8 8.705882 0.50

As temporadas mais votadas são as mais bem avaliadas?

Para essa análise, foi calculada a média dos ratings e dos votos dos episódios para representar o rating e os votos da temporada.

Nossa expectativa era de que as variáveis teriam uma correlação forte. Como muita gente votou, provavelmente muita gente assistiu, logo deve ser uma boa série.

A partir do gráfico abaixo, podemos observar que, depois da aplicação da escala logarítmica no eixo dos votos, a correlação é positiva e não linear. Também é possível ver que não é uma correlação tão forte quanto esperado, existem muitas avaliações diferentes para a mesma quantidade de votos. O coeficiente de Spearman foi 0,44.

series %>% 
  group_by(series_name, season) %>% 
  summarise(
    votes_season = mean(user_votes),
    rating_season = mean(user_rating),
    .groups = "drop"
  ) %>% 
  ggplot(aes(x = votes_season, y = rating_season)) +
  geom_point(color = "salmon", alpha = 0.4) +
  scale_x_log10() +
  labs(
        x = "Votos",
        y = "Rating",
        title = "Distribuição dos ratings pela quantidade de votos das temporadas",
        subtitle = "Dados de Março de 2019."
  )

series %>%
  summarise(
    `Coeficiente de Spearman` = cor(user_rating, user_votes, method = "spearman", use =
                                      "complete.obs"),
  ) %>%
  kable(align = "l")
Coeficiente de Spearman
0.4395897

As séries que começaram boas, também agradaram o público na última temporada?

Para essa análise, foi calculada a média dos ratings dos episódios para representar o rating da temporada. Utilizamos somente as séries com mais de uma temporada.

A partir do gráfico abaixo, observamos uma correlação forte, positiva e linear. O coeficiente de Pearson foi de 0,69. Sobre os pontos extremos, podemos observar que há séries que começaram muito boas e terminaram ruins, como também o contrário.

ratings <- series %>% 
  group_by(series_name) %>%
  filter((season == 1 | season == max(season)) & max(season) != 1) %>%
  group_by(series_name, season) %>%
  summarize(rating_season = mean(user_rating), .groups = "drop")

start <- ratings %>% filter(season == 1)
finish <- ratings %>% filter(season != 1)


ratings <- inner_join(start, finish, by = c("series_name"), copy = FALSE, suffix = c(".s", ".f"))

ratings %>% 
  ggplot(aes(x = rating_season.s, y = rating_season.f)) + 
  geom_point(color = "deepskyblue", alpha = 0.5) + 
  labs(
        x = "Rating da primeira temporada",
        y = "Rating da última temporada",
        title = "Distribuição do rating da primeira temporada com a da última",
        subtitle = "Dados de Março de 2019."
  )

ratings %>%
  summarise(
    `Coeficiente de Pearson` = cor(
      rating_season.s,
      rating_season.f,
      method = "pearson",
      use = "complete.obs"
    ),
  ) %>%
  kable(align = "l")
Coeficiente de Pearson
0.6934308