knitr::opts_chunk$set(echo=TRUE, warning=FALSE, message=FALSE, fig.width=12, fig.height=6)
library(dplyr)
library(ggplot2)
library(resample)

library(gridExtra)

# install.packages("dplyr")
# install.packages("ggplot2")
# install.packages("resample")
# install.packages("gridExtra")
#library(reshape2)

Parte 3 - Eu no rock

Neste checkpoint utilizaremos dados sobre filmes do IMDB e dados do OCA (Observatório Brasileiro do Cinema e do Audiovisual), aos quais trataremos como dataset imdb e dataset nacional, respectivamente, com o objetivo de responder perguntas feitas por nós.

No dataset sobre o IMDB do checkpoint anterior tínhamos uma granularidade de dados diferente, visto que o objetivos já estavam especificados, então buscamos mais dados que pudessem complementar nossa análise, como a tamanho do filme e bilheteria. Foram acrescentados dados também dados de 1928 até 1995, visto que o outro dataset englobava apenas de 1996 a 2016.

Utilizaremos dados de filmes disponíveis como amostra, para população consideraremos todos os filmes já lançados até então.

dados <- read.csv("movies.csv", header = TRUE, sep = ",")

dados$X <- NULL
dados$mpaa <- NULL
# dados$budget <- NULL

No dataset IMDB, estão presentes os seguintes atributos:

head(dados, 5)
##                      title year duracao budget rating votes   r1   r2  r3
## 1                        $ 1971     121     NA    6.4   348  4.5  4.5 4.5
## 2        $1000 a Touchdown 1939      71     NA    6.0    20  0.0 14.5 4.5
## 3   $21 a Day Once a Month 1941       7     NA    8.2     5  0.0  0.0 0.0
## 4                  $40,000 1996      70     NA    8.2     6 14.5  0.0 0.0
## 5 $50,000 Climax Show, The 1975      71     NA    3.4    17 24.5  4.5 0.0
##     r4   r5   r6   r7   r8   r9  r10 Action Animation Comedy Drama
## 1  4.5 14.5 24.5 24.5 14.5  4.5  4.5      0         0      1     1
## 2 24.5 14.5 14.5 14.5  4.5  4.5 14.5      0         0      1     0
## 3  0.0  0.0 24.5  0.0 44.5 24.5 24.5      0         1      0     0
## 4  0.0  0.0  0.0  0.0  0.0 34.5 45.5      0         0      1     0
## 5 14.5 14.5  4.5  0.0  0.0  0.0 24.5      0         0      0     0
##   Documentary Romance Short
## 1           0       0     0
## 2           0       0     0
## 3           0       0     1
## 4           0       0     0
## 5           0       0     0

Antes das perguntas, vejamos uma breve análise descritiva dos dados, visto que alguns dados não estavam presentes no checkpoint anterior.

# Algumas verificações de integridade
any(is.null(dados$title))
## [1] FALSE
any(is.null(dados$year))
## [1] FALSE
any(is.null(dados$rating))
## [1] FALSE
any(is.null(dados$votes))
## [1] FALSE

Vemos que os atributos essenciais para a análise não possuem valores faltantes, no caso da bilheteria já sabemos que para alguns filmes essa informação está ausente.

Para o atributo year, temos:

summary(dados$year)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1893    1958    1983    1976    1997    2005
ggplot(dados, aes(year)) + geom_bar(fill="blue") + 
  ggtitle("Dist Filmes") + xlab("Anos") + ylab("Quantidade - Filmes / Ano") +
  scale_x_continuous(breaks=seq(1893, 2005, 5))

cor(dados$year, dados$rating)
## [1] -0.06986958
b1 <- qplot(rating, year, data = dados, geom = "boxplot")
b2 <- qplot(rating, year, data = dados, geom = "violin")

grid.arrange(b1, b2, ncol = 2)

No gráfico vemos a distribuição da quantidade de filmes ao longo dos anos. É visível o grande crescimento da quantidade de lançamentos a partir de meados de 1925, visto que 50% dos filmes presentes no dataset foram lançados entre 1997 e 2005. A correlação calculada nos leva a acreditar que não há uma relação linear entre o ano de lançamento e a avaliação média dos filmes.

Para o atributo duração, em minutos temos:

summary(dados$duracao)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00   74.00   90.00   82.34  100.00 5220.00
cor(dados$duracao, dados$rating)
## [1] -0.03073441
b3 <- qplot(rating, duracao, data = dados, geom = "boxplot")
b4 <- qplot(rating, duracao, data = dados, geom = "violin")

grid.arrange(b3, b4, ncol = 2)

75% dos filmes possuem duração de até 100 minutos e podemos também notar valores extremos como 5220. Tentaremos validar esse valor.

out <- subset(dados, dados$duracao == max(dados$duracao))
out
##                        title year duracao budget rating votes   r1  r2  r3
## 11937 Cure for Insomnia, The 1987    5220     NA    3.8    59 44.5 4.5 4.5
##        r4 r5 r6 r7  r8  r9  r10 Action Animation Comedy Drama Documentary
## 11937 4.5  0  0  0 4.5 4.5 44.5      0         0      0     0           0
##       Romance Short
## 11937       0     0

“O filme tem duração de 5.220 minutos, isto é, 87 horas (três dias e 15 horas). Nele aparece o poeta L.D. Groban lendo um poema seu de 4.080 páginas com pequenos cortes de heavy metal e cenas pornográficas.”

Para o atributo rating, em minutos temos:

range(dados$rating)
## [1]  1 10
summary(dados$rating)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   5.000   6.100   5.933   7.000  10.000
ggplot(dados, aes(rating)) + geom_bar(fill="blue") + 
  ggtitle("Dist Avaliações") + xlab("Notas") + ylab("Quant Avaliações") +
  scale_x_continuous(breaks=seq(1, 10, 1))

Interessante observar que a distribuição da quantidade de votos segue, aproximadamente, uma distribuição normal.

A primeira pergunta sugerida foi: Existe alguma relação entre o ano em que o filme foi lançado e a avaliação do mesmo?, ou seja, ao longo dos anos, existe algum (ou alguns) ano que possui avaliações médias melhores que os demais?

Para responder essa pergunta, iremos:

  1. Verificar a quantidade de filmes lançados por ano (e assim verificar se há dados bastantes para utilizar bootstraping)

  2. Calcular o intervalo de confiança da média das avaliações por ano

  3. Realizar comparações

Sendo assim, vamos ao passo a:

ggplot(dados, aes(factor(year), rating)) + geom_boxplot() + 
  xlab("Anos - 1893 a 2005") + ylab("Avaliação") + ggtitle("Distribuição - Avaliações ao longo dos anos") +
  theme(axis.text.x = element_text(angle = 80, hjust = 1)) +
  scale_y_continuous(breaks=seq(0:10)) + 
  theme(axis.text.x = element_blank())

Por mais que A partir do gráfico da distribuições das avaliações ao longo dos anos podemos notar pontos interessantes. a) A grande maioria dos filmes recebem avaliações medianas, ou seja, está entre 4 e 7,5 b) Como já era de se esperar, a quantidade de filmes com notas muito baixas é superior a quantidade de filmes com notas muito altas c) Apenas 3 filmes possuem classificação máxima (embora a quantidade de avaliadores seja baixa (5)).

avaliacoesPorAno <- dados %>%
  group_by(year) %>%
  summarise(Media = mean(rating), Ocorrencias = n())

avaliacoesPorAno
## Source: local data frame [113 x 3]
## 
##     year    Media Ocorrencias
##    (int)    (dbl)       (int)
## 1   1893 7.000000           1
## 2   1894 4.888889           9
## 3   1895 5.500000           3
## 4   1896 5.269231          13
## 5   1897 4.677778           9
## 6   1898 5.040000           5
## 7   1899 4.277778           9
## 8   1900 4.731250          16
## 9   1901 4.682143          28
## 10  1902 4.900000           9
## ..   ...      ...         ...

Para este problema, consideraremos apenas os anos que tiveram mais de 100 filmes lançados, ou seja, a partir de 1928 para fazer o bootstraping e gerar os intervalos de confiança - passo b.

dadosfil <- subset(dados, dados$year >= 1928)

# intervalo de confiança pra cada ano

IC <- function(dadosIc, ano) {
  filtra_ano <- filter (dadosIc, year == ano)
  nAvaliacoes <- nrow(filtra_ano)

  boots <- bootstrap(filtra_ano$rating, mean)
  Media <- mean(filtra_ano$rating)

  intervalo <- CI.percentile(boots, probs = c(.05, .95))
  limite_inferior <- intervalo[1]
  limite_superior <- intervalo[2]

  boots_median <- bootstrap(filtra_ano$rating, median)
  Mediana <- median(filtra_ano$rating)

  intervalo_median <- CI.percentile(boots_median, probs = c(.05, .95))
  limite_inferior_median <- intervalo_median[1]
  limite_superior_median <- intervalo_median[2]

  Ano <- ano

  df <- data.frame(Ano, nAvaliacoes, Media, limite_inferior, limite_superior,
                   Mediana, limite_inferior_median, limite_superior_median)

  return(df)
}

# ics <- IC(dadosfil, 1928)

# year <- unique(sort(dadosfil$year))

# for (i in 2:length(year)) {
#   ics <- rbind(ics, IC(dadosfil, year[i]))
# }

#write.csv(ics, file="intervalos.csv", row.names = FALSE)
ics <- read.csv("intervalos.csv")

head(ics, 5)
##    Ano nAvaliacoes    Media limite_inferior limite_superior Mediana
## 1 1928         109 7.170642        6.966055        7.354128     7.5
## 2 1929         184 6.531522        6.365761        6.689674     6.7
## 3 1930         288 5.931250        5.804392        6.056944     6.0
## 4 1931         346 6.174566        6.076012        6.273699     6.2
## 5 1932         412 6.114563        6.015820        6.211893     6.2
##   limite_inferior_median limite_superior_median
## 1                    7.2                    7.6
## 2                    6.6                    6.9
## 3                    5.9                    6.1
## 4                    6.1                    6.3
## 5                    6.1                    6.3

Gerados os intervalos de confiança para a média, podemos visualizar o seguinte gráfico:

ggplot(ics, aes(x=Ano, y=Media, color=factor(Ano))) + 
    geom_errorbar(aes(ymin=limite_inferior, ymax=limite_superior),
    width=.2, position=position_dodge(.9)) +
    geom_point(shape=21, size=2, fill="white") +
    ggtitle("Intervalos de Confiança - Média Avaliações") +
    xlab("Ano") + ylab("Média Avaliações") +
    theme(axis.text.x = element_text(angle = 30, hjust = 1), legend.position="none") +
    scale_x_continuous(breaks=seq(1928, 2005, 2))

Relembrando a pergunta, queríamos saber se existe algum (ou alguns) ano que possui avaliações médias melhores que os demais.

Ao contrário do que pensamos a priori, que ao longo dos anos as novas produções aprendessem com os grandes clássicos (ou seja, que os filmes mais recentes tivessem avaliações mais promissoras que os mais antigos), vemos através do gráfico que aparentemente não há relação entre o passar dos anos e crescimento nas avaliações.

Entretanto, olhando para o ano de 2004 vemos um intervalo de confiança menor, o que significam muitas observações, e uma média de avaliações elevada, o que pode significar uma certa simpatia do público pelos filmes lançados neste ano (ou simplesmente coincidência).

ggplot(ics, aes(x=Ano, y=Mediana, color=factor(Ano))) + 
    geom_errorbar(aes(ymin=limite_inferior_median, ymax=limite_superior_median),
    width=.2, position=position_dodge(.9)) +
    geom_point(shape=21, size=2, fill="white") +
    ggtitle("Intervalos de Confiança - Mediana Avaliações") +
    xlab("Ano") + ylab("Mediana Avaliações") +
    theme(axis.text.x = element_text(angle = 30, hjust = 1), legend.position="none") +
    scale_x_continuous(breaks=seq(1928, 2005, 2))

No gráfico acima reproduzimos o mesmo gráfico para os intervalos de confiança para a mediana, afim de notar se possíveis outliers poderiam atrapalhar no resultado final, mas vemos que o gráfico possui uma forma bastante semelhante a do anterior.

Como vimos o ano em que o filme foi lançado aparentemente não influencia na nota em que o mesmo recebe, mas será que a duração do filme possui alguma influência na avaliação recebida?

Para essa análise:

  1. Dividiremos os filmes em grupos

  2. Calcular o intervalo de confiança da avaliação para os grupos

  3. Analisar

summary(dadosfil$length)
## Length  Class   Mode 
##      0   NULL   NULL
dadosfil$grupo <- NA

cor(dadosfil$rating, dadosfil$duracao)
## [1] -0.03711346

Grupo 1: Valores compreendidos entre 0 e o 1º Quartil

Grupo 2: Valores compreendidos entre o 1º Quartil e o 2º Quartil

Grupo 3: Valores compreendidos entre o 2º e o 3º Quartil

Grupo 4: Valores compreendidos entre o 3º Quartil e o valor máximo

suma <- summary(dadosfil$duracao)

# dadosfil <- dadosfil %>%
#    rowwise() %>%
#    mutate(grupo = ifelse(duracao <= suma[2], 1, 
#                          ifelse(duracao > suma[2] & duracao <= suma[3], 2, 
#                                 ifelse(duracao > suma[3] & duracao <= suma[5], 3, 4))))

#write.csv(dadosfil, file="dadosfil.csv", row.names = FALSE)
dadosfil <- read.csv("dadosfil.csv")



# ICgrupo <- function(dadosIc) {
#   
#   nAvaliacoes <- nrow(dadosIc)
# 
#   boots <- bootstrap(dadosIc$rating, mean)
#   Media <- mean(dadosIc$rating)
# 
#   intervalo <- CI.percentile(boots, probs = c(.05, .95))
#   limite_inferior <- intervalo[1]
#   limite_superior <- intervalo[2]
# 
#   df <- data.frame(dadosIc$grupo[1], nAvaliacoes, Media, limite_inferior, limite_superior)
# 
#   return(df)
# }
# 
# f1 <- filter(dadosfil, grupo == 1)
# f2 <- filter(dadosfil, grupo == 2)
# f3 <- filter(dadosfil, grupo == 3)
# f4 <- filter(dadosfil, grupo == 4)
# 
# icsg <- ICgrupo(f1)
# icsg <- rbind(icsg, ICgrupo(f2))
# icsg <- rbind(icsg, ICgrupo(f3))
# icsg <- rbind(icsg, ICgrupo(f4))


#write.csv(icsg, file = "icsgrupo.csv", row.names = FALSE)

icsg <- read.csv("icsgrupo.csv")

ggplot(icsg, aes(x=dadosIc.grupo.1., y=Media, color=factor(dadosIc.grupo.1.))) + 
    geom_errorbar(aes(ymin=limite_inferior, ymax=limite_superior),
    width=.2, position=position_dodge(.9)) +
    geom_point(shape=21, size=2, fill="white") +
    ggtitle("Intervalos de Confiança - Média Avaliações") +
    xlab("Grupos") + ylab("Média Avaliações") +
    theme(legend.position="none") +
    scale_x_continuous(breaks=seq(1, 4, 1))

Apesar de não demonstrar uma correlação alta, as avaliações e duração dos filmes mostram um gráfico de intervalos de confiança interessante. Aparentemente filmes dos grupos 1 (duração entre 1 e 75 minutos) e 4 (duração acima de 100 minutos), em média, recebem melhores avaliações pelos usuários. Isso significa que filmes lançados que se encaixe nos grupos 1 ou 4 têm 90% de chance de receberem avaliações boas.

Outro atributo interessante a se explorar também é a bilheteria dos filmes.

arrecadacao <- na.omit(dadosfil)

summary(arrecadacao$budget)
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##         0    259500   3000000  13590000  15600000 200000000
ggplot(arrecadacao, aes("-", budget/10000)) + geom_boxplot() + 
  xlab("") + 
  ylab("Bilheteria / 10000") + ggtitle("Distribuição - Bilheteria") +
  theme(axis.text.x = element_text(angle = 80, hjust = 1))

Referências