Prob3CP1

library(tidyverse, warn.conflicts = F)
library(rvest)
library(plotly)
library(cluster)
library(ggdendro)
library(gridExtra)
theme_set(theme_light())
source("plota_solucoes_hclust.R")

Há vários anos, Matt Damon é figurinha certa na lista dos atores mais bem pagos de Hollywood. Além disso, ele é um dos 40 atores de maior bilheteria de todos os tempos. Vamos aqui analisar seus filmes segundo bilheteria e crítica, tentando agrupar aqueles que apresentam semelhanças. Os dados utilizados nessa análise foram retirados do Rotten Tomatoes.

from_page <- read_html("https://www.rottentomatoes.com/celebrity/matt_damon/") %>% 
    html_node("#filmographyTbl") %>% # A sintaxe da expressão é de um seletor à lá JQuery: https://rdrr.io/cran/rvest/man/html_nodes.html 
    html_table(fill=TRUE) %>% # Faz parse
    as.tibble()

filmes = from_page %>% 
    filter(RATING != "No Score Yet", 
           `BOX OFFICE` != "—", 
           CREDIT != "Executive Producer") %>%
    mutate(RATING = as.numeric(gsub("%", "", RATING)), 
           `BOX OFFICE` = as.numeric(gsub("[$|M]", "", `BOX OFFICE`))) %>% 
    filter(`BOX OFFICE` >= 1)

As variáveis presentes nos dados são:

* `RATING`: avaliação dos usuários e críticos no Rotten Tomatoes
* `TITLE`: O título do filme
* `CREDIT`: Que papel o ator interpretou no filme
* `BOX OFFICE`: Quantos milhões de dólares o filme lucrou em bilheterias nos EUA
* `YEAR`: Ano de lançamento do filme

glimpse(filmes)

## Observations: 42
## Variables: 5
## $ RATING       <dbl> 51, 29, 35, 95, 55, 91, 71, 30, 67, 95, 51, 66, 4...
## $ TITLE        <chr> "Downsizing", "Suburbicon", "The Great Wall", "Ma...
## $ CREDIT       <chr> "Paul Safranek", "Gardner LodgeGardner", "William...
## $ `BOX OFFICE` <dbl> 23.0, 5.8, 45.2, 47.7, 162.2, 202.4, 158.8, 67.3,...
## $ YEAR         <int> 2017, 2017, 2017, 2016, 2016, 2015, 2014, 2014, 2...

Vamos observar as variáveis RATING(crítica) e BOX OFFICE(bilheteria) para checar se existem grupos semelhantes:

filmes %>% 
    ggplot(aes(x = "Filmes", y = RATING)) + 
    geom_jitter(width = .01, height = 0, size = 2, alpha = .6)

filmes %>%
    ggplot(aes(x = RATING)) +
    geom_histogram(bins = 15,
                   boundary = 0,
                   fill = "#95CFB7",
                   color = "black") + 
    geom_rug()

filmes %>% 
    ggplot(aes(x = "Filmes", y = `BOX OFFICE`)) + 
    geom_jitter(width = .02, height = 0, size = 2, alpha = .6) 

filmes %>% 
    ggplot(aes(x = `BOX OFFICE`)) + 
    geom_histogram(bins = 17, 
                   fill = "#FFF7BD",
                   color = "black") + 
    geom_rug()+
    scale_x_log10()

Aparentemente existe uma estrutura de grupos para BOX OFFICE, mas não para RATING.

agrupamento_h_2d = filmes %>% 
    mutate(`BOX OFFICE` = log10(`BOX OFFICE`)) %>%
    mutate_at(vars(RATING, `BOX OFFICE`), funs(scale)) %>%
    as.data.frame() %>% 
    column_to_rownames("TITLE") %>%
    select(RATING, `BOX OFFICE`) %>%
    dist(method = "euclidean") %>% 
    hclust(method = "ward.D")

filmes2 = filmes %>% mutate(`BOX OFFICE` = log10(`BOX OFFICE`))
plota_hclusts_2d(agrupamento_h_2d, 
                 filmes2, 
                 c("RATING", "`BOX OFFICE`"), 
                 linkage_method = "ward.D", ks = 1:6) + 
    scale_y_log10() + 
    scale_color_brewer(palette = "Dark2")

No gráfico acima temos os grupos encontrados pelo algoritmo. O agrupamento com 3 grupos parece ser melhor definido que os demais, portanto, vamos adotá-lo. Com o dendrograma abaixo podemos ver as três categorias formadas e os filmes presentes em cada uma.

ggdendrogram(agrupamento_h_2d, rotate = TRUE, theme_dendro = F)+
            geom_hline(yintercept = 7, colour = "red")

Logo abaixo vemos com mais clareza os grupos formados:

filmes2_agrupados = filmes2 %>%
    mutate(grupo = agrupamento_h_2d %>% cutree(3) %>%  as.character())

filmes2_long = filmes2_agrupados %>% 
    mutate_at(vars(`BOX OFFICE`), log10) %>% 
    mutate_at(vars(`BOX OFFICE`, YEAR, RATING), scale) %>% 
    gather(key = "variavel", value = "valor", -TITLE, -grupo, -CREDIT) 

filmes2_long %>% 
    ggplot(aes(x = reorder(variavel, valor), y = valor, group = variavel, colour = variavel)) +
    geom_point(alpha = .4, size = 2, position = position_dodge(width = .5)) + 
    labs(x = "", y = "z-score") + 
    facet_grid(reorder(grupo, valor, median) ~ . ) + 
    coord_flip() + 
    scale_color_brewer(palette = "Dark2")

O primeiro grupo é formado por os filmes com baixa avaliação e bilheteria alta, são os Rejeitados pela Crítica. Nessa categoria estão filmes como Ocean’s Twelve, que teve um desempenho inferior tanto em bilheteria quanto em avaliação quando comparado com seu predecessor, Ocean’s Eleven. O segundo grupo contém filmes com alto RATING e BOX OFFICE, são os Blockbusters. Esse grupo conta com filmes como Ocean’s Eleven, Interstellar, Manchester by the Sea e The Martian, com destaque para o último, que sozinho faturou $630.161.890, sendo o filme de maior faturamento de Damon. Já o grupo 3 conta com filmes com baixo BOX OFFICE e RATING alto, chamaremos esse grupo de Cult. Esse grupo conta com apenas 4 filmes, como Inside Job, que foi aclamado pela crítica, mas teve um BOX OFFICE de apenas $4,311,834.