Análise exploratória de filmes no IMDb

# Translating needed country names
imdb$country[imdb$country == "USA"] = "EUA"
imdb$country[imdb$country == "France"] = "França"
imdb$country[imdb$country == "UK"] = "Reino Unido"
imdb$country[imdb$country == "India"] = "Índia"
imdb$country[imdb$country == "Italy"] = "Itália"
imdb$country[imdb$country == "Germany"] = "Alemanha"
imdb$country[imdb$country == "Japan"] = "Japão"
imdb$country[imdb$country == "Canada"] = "Canadá"
imdb$country[imdb$country == "Spain"] = "Espanha"
imdb$country[imdb$country == "Turkey"] = "Turquia"
imdb$country[imdb$country == "Belgium"] = "Bélgica"
imdb$country[imdb$country == "South Korea"] = "Koreia do Sul"
imdb$country[imdb$country == "Sweden"] = "Suécia"
imdb$country[imdb$country == "Australia"] = "Australia"
imdb$country[imdb$country == "Mexico"] = "México"
imdb$country[imdb$country == "West Germany"] = "Alemanha Ocidental"
imdb$country[imdb$country == "Russia"] = "Rússia"
imdb$country[imdb$country == "Netherlands"] = "Países Baixos"

# Translating needed genre names
imdb$genre[imdb$genre == "Comedy"] = "Comédia"
imdb$genre[imdb$genre == "Action"] = "Ação"
imdb$genre[imdb$genre == "Adventure"] = "Aventura"
imdb$genre[imdb$genre == "Mystery"] = "Mistério"
imdb$genre[imdb$genre == "Family"] = "Família"
imdb$genre[imdb$genre == "Fantasy"] = "Fantasia"
imdb$genre[imdb$genre == "Biography"] = "Biografia"
imdb$genre[imdb$genre == "History"] = "História"
imdb$genre[imdb$genre == "War"] = "Guerra"
imdb$genre[imdb$genre == "Animation"] = "Animação"
imdb$genre[imdb$genre == "Music"] = "Música"
imdb$genre[imdb$genre == "Western"] = "Ocidental"
imdb$genre[imdb$genre == "Sport"] = "Esporte"

# Translating needed language names
imdb$language[imdb$language == "English"] = "Inglês"
imdb$language[imdb$language == "French"] = "Francês"
imdb$language[imdb$language == "Spanish"] = "Espanhol"
imdb$language[imdb$language == "Italian"] = "Italiano"
imdb$language[imdb$language == "German"] = "Alemão"
imdb$language[imdb$language == "Japanese"] = "Japonês"
imdb$language[imdb$language == "Russian"] = "Russo"
imdb$language[imdb$language == "Turkish"] = "Turco"
imdb$language[imdb$language == "Cantonese"] = "Cantonês"
imdb$language[imdb$language == "Portuguese"] = "Português"
imdb$language[imdb$language == "Belgium"] = "Bélgica"
imdb$language[imdb$language == "Korean"] = "Koreano"
imdb$language[imdb$language == "Arabic"] = "Árabe"
imdb$language[imdb$language == "Australia"] = "Australia"
imdb$language[imdb$language == "Swedish"] = "Sueco"
imdb$language[imdb$language == "Polish"] = "Polonês"
imdb$language[imdb$language == "Dutch"] = "Holandês"

Olá! hoje vamos mergulhar em um dos meus passatempos preferidos 😄 : os filmes 🎥 . Para isso, vamos usar dados do IMDb (Internet Movie Database), um site da Amazon que contém informações acerca de filmes, programas de TV, video games, etc. Mais especificamente, vamos trabalhar com cerca de 85.855 filmes (todos aqueles com mais de 100 votos até 01/01/2020).

Fonte: kaggle.

Quanto aos nossos objetivos, eles são:

  • Ter uma visão geral de vários aspectos individuais dos filmes nessa base de dados, como: anos de lançamento, países de gravação, gênero, duração, idiomas, orçamentos e receita global. Como também observar como eles variam no tempo;

  • Descrever semelhanças entre os filmes 1% mais bem sucedidos financeiramente, através de seus lucros, tanto absolutos quanto relativos aos seus orçamentos;

  • Desvendar quais os gêneros são mais populares e lucrativos;

  • Avaliar a receita global dos filmes com base em um modelo que utiliza regressão linear múltipla.

Obs: Como temos vários valores faltantes, informamos de antemão quantos filmes estão sendo de fato utilizados.

Visão geral dos filmes

Adiante analisaremos as distribuições estáticas e no tempo (quando aplicáveis) de variáveis do nosso conjunto de dados, que nos darão uma melhor noção dos filmes presentes.

Anos de lançamento

Primeiro, observaremos a distribuição dos anos de lançamento dos filmes acompanhado de uma linha com a média móvel de 5 anos, usada para suavisar o gráfico de barras e nos mostrar mais claramente o seu formato. Espero de antemão que haja um crescimento na frequência de lançamento nos últimos anos, dado o aparecimento de novas tecnologias (televisão, internet, melhores efeitos visuais…), como também do período pacífico que vivemos (principalmente no oeste), número maior de pessoas e possível crescimento na demanda em entretenimento.

# Filmes considerados: 85.854

imdb %>%
    select(imdb_title_id, year) %>%
    filter(!is.na(year), year < 2020) %>%
    unique %>%
    group_by(year) %>%
    summarise(freq = n()) %>%
    mutate(avg = rollmean(freq, 5,
                         align="right", 
                         fill=0)) %>%
    ggplot(aes(x = year, y = freq)) +
    geom_col(color = "white", fill = "#000000", alpha = 0.3) +
    geom_line(aes(y = avg), 
            color = "#128bb5", 
            size = 1) +
    scale_x_continuous(breaks = seq(from = 1860, to = 2020, 
                                    by = 10)) +
    labs(
        x = "Ano de lançamento",
        y = "Frequência",
        title = "Anos de lançamento dos filmes (1894 - 2019)",
        caption = "A linha representa a média móvel de lançamento de filmes nos últimos 5 anos"
    )

Confirmamos com esse gráfico que houve um aumento praticamente exponencial do número de filmes nas últimas décadas, principalmente a partir de 1990, o que por coincidência ou não marca o início da popularização da internet e fim da Guerra Fria.

País de gravação

Agora estamos preocupados com os países onde mais se gravaram filmes, vendo a distribuição das 20 maiores frequências de gravação e seus respectivos países. O que suspeito é que os mais desenvolvidos vão ter o maior número de gravações (EUA, França, Alemanha, Itália, …).

# Filmes considerados: 85.791

top_countries <- imdb %>%
                    select(imdb_title_id, country) %>%
                    filter(!is.na(country)) %>%
                    unique %>%
                    group_by(country) %>%
                    count %>%
                    arrange(desc(n)) %>%
                    head(n = 5) %>%
                    pull(country)
country_list <- imdb %>%
    select(imdb_title_id, country) %>%
    filter(!is.na(country)) %>%
    unique %>%
    group_by(country) %>%
    count %>%
    arrange(desc(n)) %>%
    ungroup() %>%
    mutate(freq = n / sum(n) * 100)

country_list %>%
    head(n = 20) %>%
    ggplot(aes(x = reorder(country, freq), y = freq)) +
    geom_segment(aes(xend = country, y = 0, yend = freq),
                   color = "#000000", lwd = 1.2, 
                   alpha = 0.2) +
    geom_point(size = 6, pch = 21, fill = "#000000", 
               color = "#FEC400", alpha = 0.85) +
    geom_text(aes(label = trunc(freq)), 
              nudge_y = 0, size = 3.8, color = "#FEC400") +
    coord_flip() +
    labs(
        y = "Frequência (%)",
        x = "Países",
        title = "Frequência de gravações por país",
        caption = "O eixo x está representado em escala logarítmica de base 10 
                   Somente a parte inteira das porcentagens são mostradas em cada ponto"
    ) +
    scale_y_continuous(
        trans=scales::pseudo_log_trans(base = 10),
        breaks = seq(from = 0, to = 40, by = 5))

Realmente, parece que nossa previsão estava correta, com algumas ressalvas. Alguns países em desenvolvimento também estão na lista, como: Índia, Rússia, China e México. Entretanto, os Estados Unidos, ainda assim, dominam de longe a frequência de filmes nos nossos dados (praticamente um terço de todos os filmes).

Depois de observada essa distribuição, é de interesse ver em um gráfico de linha como essas frequências flutuam por ano. Mas para não atrapalhar muito nossa visualização, vamos se ater a mostrá-las para os 5 países com mais gravações.

anim <- imdb %>%
    select(imdb_title_id, country, year) %>%
    filter(!is.na(country), 
           year != 2020, 
           country %in% top_countries) %>%
    unique %>%
    group_by(country, year) %>%
    count %>%
    arrange(desc(n)) %>%
        ggplot(aes(x = year, y = n, color = country)) +
        geom_line(size = 1.1) +
        transition_reveal(year, keep_last=FALSE) +
        scale_x_continuous(
            breaks = seq(from = 1860, to = 2020, by = 10)) +
        scale_color_aaas() +
        labs(
            x = "Ano", 
            y = "Número de filmes", 
            title = "Locais de gravação dos filmes",
            color = "País"
        )

animate(anim, 
        renderer = gifski_renderer(loop = F), 
        fps=20, 
        height=400, 
        width=800)

O gráfico revela que os Estados Unidos sempre tiveram as maiores frequências de gravação, com alguns períodos (e.g. 1960-1980) onde a diferença foi menor entre os países, e alguns outros (e.g. 1990-2020) onde essa diferença cresceu consideravelmente. É importante notar também que a Índia parece estar com uma tendência de crescida exponencial nos últimos anos e será interessante acompanhar como isso irá se desenrolar no futuro.

Gênero

Quantos aos gêneros, de forma semelhante ao caso dos países de gravação, observaremos os 20 que apresentam maiores frequências nos filmes (cada filme pode ter mais de um gênero). De antemão, não sei muito o que esperar, mas suspeito que ação e aventura estejam entre os mais frequentes.

# Filmes considerados: 85.855

top_genres <- imdb %>%
                select(imdb_title_id, genre) %>%
                filter(!is.na(genre)) %>%
                unique %>%
                group_by(genre) %>%
                count %>%
                arrange(desc(n)) %>%
                head(n = 5) %>%
                pull(genre)
genre_list <- imdb %>%
    select(imdb_title_id, genre) %>%
    filter(!is.na(genre)) %>%
    unique %>%
    group_by(genre) %>%
    count %>%
    arrange(desc(n)) %>%
    ungroup() %>%
    mutate(freq = n / sum(n) * 100)

genre_list %>%
    head(n = 20) %>%
    ggplot(aes(x = reorder(genre, freq), y = freq)) +
    geom_segment(aes(xend = genre, y = 0, yend = freq),
                   color = "darkslategray", lwd = 1.2, 
                   alpha = 0.15) +
    geom_point(size = 6, pch = 21, fill = "#000000", 
               color = "#FEC400", alpha = 0.85) +
    geom_text(aes(label = trunc(freq)), 
              nudge_y = 0, size = 3.8, color = "#FEC400") +
    coord_flip() +
    labs(
        y = "Frequência (%)",
        x = "Gêneros",
        title = "Frequência de gravações por gênero",
        caption = "O eixo x está representado em escala logarítmica de base 10 
                   Somente a parte inteira das porcentagens são mostradas em cada ponto"
    ) +
    scale_y_continuous(
        trans=scales::pseudo_log_trans(base = 10),
        breaks = seq(from = 0, to = 40, by = 5))

Praticamente um terço dos filmes que temos inclui o gênero drama e outra grande parte comédia, sendo seguidos por romance, em conjunto totalizando ~50% dos filmes que estamos analisando! Já aventura e ação, que suspeitávamos estarem entre os primeiros, estão em 4º e 8º respectivamente, o que ainda representa uma boa porção dos filmes, juntos totalizando 11%.

Abaixo se encontra um gráfico com essas frequências flutuando por ano dos 5 gêneros mais populares.

anim <- imdb %>%
    select(imdb_title_id, genre, year) %>%
    filter(!is.na(genre), 
           year != 2020, 
           genre %in% top_genres) %>%
    unique %>%
    group_by(genre, year) %>%
    count %>%
    arrange(desc(n)) %>%
        ggplot(aes(x = year, y = n, color = genre)) +
        geom_line(size = 1.1) +
        transition_reveal(year, keep_last=FALSE) +
        scale_x_continuous(
            breaks = seq(from = 1860, to = 2020, by = 10)) +
        scale_color_npg() +
        labs(
            x = "Ano", 
            y = "Número de filmes", 
            title = "Gêneros dos filmes",
            color = "País"
        )

animate(anim, 
        renderer = gifski_renderer(loop = F), 
        fps=20, 
        height=400, 
        width=800)

Aparentemente, comédia e drama sempre estiveram relativamente bem próximos, enquanto os demais gêneros experimentaram um crescimento bem mais tímido em comparação a esses outros dois.

Idiomas

Após a análise de quando os filmes foram lançados, onde foram gravados e quais gêneros estão mais presentes na nossa amostra. Estamos interessados em observar os idiomas mais usados (cada filme pode ter mais de um idioma). De antemão, suspeito que por a maioria dos filmes estarem sendo gravados nos Estados Unidos, então o inglês deve ser o idioma mais usado de longe.

# Filmes considerados: 85.022

language_list <- imdb %>%
    select(imdb_title_id, language) %>%
    filter(!is.na(language)) %>%
    unique %>%
    group_by(language) %>%
    count %>%
    arrange(desc(n)) %>%
    ungroup() %>%
    mutate(freq = n / sum(n) * 100)

language_list %>%
    head(n = 20) %>%
    ggplot(aes(x = reorder(language, freq), y = freq)) +
    geom_segment(aes(xend = language, y = 0, yend = freq),
                   color = "darkslategray", lwd = 1.2, 
                   alpha = 0.15) +
    geom_point(size = 6, pch = 21, fill = "#000000", 
               color = "#FEC400", alpha = 0.85) +
    geom_text(aes(label = trunc(freq)), 
              nudge_y = 0, size = 3.8, color = "#FEC400") +
    coord_flip() +
    labs(
        y = "Frequência (%)",
        x = "Idiomas",
        title = "Frequência de filmes por idioma",
        caption = "O eixo x está representado em escala logarítmica de base 10 
                   Somente a parte inteira das porcentagens são mostradas em cada ponto"
    ) +
    scale_y_continuous(
        trans=scales::pseudo_log_trans(base = 10))

Nossas suspeitas foram confirmadas, o inglês é o mais usado, e o francês segue logo atrás, juntos representando ~50% de todos os nossos filmes. Enquanto o português está apenas em 12º.

Como antes, aqui se encontra um gráfico com essas frequências flutuando por ano dos 5 idiomas com maior frequência.

top_languages <- imdb %>%
                select(imdb_title_id, language) %>%
                filter(!is.na(language)) %>%
                unique %>%
                group_by(language) %>%
                count %>%
                arrange(desc(n)) %>%
                head(n = 5) %>%
                pull(language)
anim <- imdb %>%
    select(imdb_title_id, language, year) %>%
    filter(!is.na(language), 
           year != 2020, 
           language %in% top_languages) %>%
    unique %>%
    group_by(language, year) %>%
    count %>%
    arrange(desc(n)) %>%
        ggplot(aes(x = year, y = n, color = language)) +
        geom_line(size = 1.1) +
        transition_reveal(year, keep_last=FALSE) +
        scale_x_continuous(
            breaks = seq(from = 1860, to = 2020, by = 10)) +
        scale_color_lancet() +
        labs(
            x = "Ano", 
            y = "Número de filmes", 
            title = "Idiomas dos filmes",
            color = "Idioma"
        )

animate(anim, 
        renderer = gifski_renderer(loop = F), 
        fps=20, 
        height=400, 
        width=800)

É aparente que o inglês sempre foi o idioma mais utilizado de longe, enquanto os outros idiomam experimentaram pouca frequência em comparação, mesmo os outros 4 maiores.

Duração

Agora estamos interessados em observar a distribuição das suas durações em minutos.

# Filmes considerados: 85.855

d1 <- imdb %>%
    select(imdb_title_id, duration, year) %>%
    filter(!is.na(duration + year)) %>%
    unique %>%
    mutate(round_year = year - year %% 10)

d1 %>%
    ggplot(aes(x = duration)) +
    geom_density(fill = "#000000", 
                 color = "#00000099", 
                 alpha = .1,
                 size = 0.9) +
    geom_vline(aes(xintercept = median(duration), color = "mediana"), size = 0.8) +
    geom_rug(alpha = 0.1, color = "#000000") +
    scale_x_log10() +
    scale_color_manual(name = "Estatística", values = c("mediana" = "#128bb5")) +
    labs(
        title = "Distribuição da duração dos filmes (1894-2020)",
        subtitle = "",
        x = "Duração (minutos)",
        y = "Densidade",
        caption = "O eixo x está representado em escala logarítimica de base 10"
    )

A duração mediana dos filmes está bem próxima de 100 minutos, mais especificamente em torno de 96 min (1h e 36min), enquanto temos uma longa cauda a direita (uma minoria de filmes bastante longos), a qual pode não estar aparecente, pois estamos usando uma escala logarítmica que a diminue um pouco, para melhor visualização do todo. Temos filmes de até 808 minutos (13 horas e 28 min)!

Para tornar a visualização mais interessante e dinâmica, observaremos a distribuição por década abaixo:

p <- d1 %>%
    filter(round_year >= 1910, round_year < 2020) %>%
    group_by(round_year) %>% 
             mutate(median_dur=median(duration)) %>%
    ggplot(aes(x = duration)) +
    geom_density(fill = "#000000", 
                 color = "#00000099", 
                 alpha = .1,
                 size = 0.9) +
    geom_segment(aes(x = median_dur, 
                     xend = median_dur,
                     y = -Inf,
                     yend = Inf),
                 color = "#128bb5",
                 size = .8,
                 alpha = 0.7
                ) +
    geom_rug(alpha = 0.1, color = "#000000") +
    scale_x_log10() +
    transition_states(round_year, 
                      transition_length = 4, 
                      state_length = 2,
                      wrap = T) +
    ease_aes('sine-in-out') +
    enter_fade()+
    exit_fade() +
    labs(
        title = "Distribuição da duração dos filmes (1910-2019)",
        subtitle = "Década: {closest_state}",
        x = "Duração (minutos)",
        y = "Densidade",
        caption = "Linha representa a mediana da duração dos filmes da respectiva década"
    )

animate(p, nframes = 200, fps=12)

Vemos duas tendências que cresceram com o passar dos anos, tanto as medianas da duração foram aumentando até se estagnar próximo de 100 min, quanto a concentração das durações próximas de 100 min cresceram com o tempo, chegando em seu pico na década de 80.

Aspectos monetários

Antes de analisarmos os orçamentos e arrecadações globais, temos de ter em mente que existem muitas moedas em circulação, com valores agregados diferentes. Como pode ser exemplificado pelo seguinte gráfico (os tamanhos dos retângulos dizem respeito a frequência de filmes com orçamento naquela moeda):

# Filmes considerados: 23.710

budget_units <- imdb %>%
    select(budget, imdb_title_id) %>%
    unique %>%
    filter(!is.na(budget)) %>%
    separate(budget, into = c("unit", "value"), sep = " ") %>%
    summarise(tot = n(), unit) %>%
    group_by(unit) %>%
    summarise(sum = n(), freq = round(sum/tot, 2) * 100) %>%
    unique

budget_units %>%
    ggplot(aes(area = sum, fill = unit, label = unit)) +
      geom_treemap(color = "white", alpha = .85) +
      geom_treemap_text(colour = "white",
                    place = "centre",
                    grow = TRUE,
                    aes(size = sum)) +
    guides(fill = "none", colour = "none", size = "none") +
    scale_fill_viridis(option = "G", discrete = T)

A maioria dos nossos filmes tem orçamento em dólar estadunidense ($), cerca de 70%, seguido de euro (EUR), rupia indiana (INR), libra esterlina (GBP), dólar canadense (CAD) e australiano (AUD). Já no caso da arrecadação global, não temos essas diferentes moedas. Ele é todo medido em termos de dólar estadunidense.

Por simplicidade, de agora em diante usaremos somente os filmes com orçamento e arrecadação global em dólar estadunidense.

Orçamentos

Depois dessa observação, iremos descrever a distribuição do orçamento dos filmes de forma geral e por década.

# Filmes considerados: 23.710

options(scipen = 999)
         
o1 <- imdb %>%
    select(imdb_title_id, budget, year) %>%
    filter(!is.na(budget), !is.na(year),
           str_detect(budget, "^\\$ ")) %>%
    unique %>%
    mutate(round_year = year - year %% 10) %>%
    filter(round_year > 1900, round_year < 2020)

o1$budget <- 
    as.numeric(gsub("^\\$ ", '', o1$budget))

o1 %>%
    mutate(median_budg=quantile(budget, 0.5)) %>%
    ggplot(aes(x = budget)) +
    geom_density(fill = "#000000", 
                 color = "#00000099", 
                 alpha = .1,
                 size = 0.9) +
    geom_segment(aes(x = median_budg, 
                     xend = median_budg,
                     y = -Inf,
                     yend = Inf),
                 color = "#128bb5",
                 size = .8,
                 alpha = 0.7
                ) +
    geom_rug(alpha = 0.1, color = "#000000") +
    scale_x_log10(labels=function(x) format(x, big.mark = ".", scientific = FALSE)) +
    labs(
        title = "Distribuição do orçamento dos filmes (1901-2020)",
        x = "Orçamento (dólares)",
        y = "Densidade",
        caption = "Linha representa a mediana do orçamento dos filmes"
    )

Estamos usando uma escala logarítma no eixo x, justamente porque os valores dos orçamentos estão bastante concentrados à esquerda, com uma cauda longa a direita, o que demonstra a raridade de investimento de maior porte na criação dos filmes. A mediana que está sendo mostrada no gráfico é de 3 milhões. Esse gráfico nos mostra que investimento baixos são raros, e o que é mais comum são aqueles entre 1 milhão e 20-30 milhões de dólares (zona “plana” na parte de cima). Decaindo consideravelmente a partir de 100 milhões.

Aqui está esse gráfico por década. Importante notar que só temos dados suficientes a partir de 1910.

p <- o1 %>%
    group_by(round_year) %>% 
    mutate(median_budg=median(budget)) %>%
    ggplot(aes(x = budget)) +
        geom_density(fill = "#000000", 
                 color = "#00000099", 
                 alpha = .1,
                 size = 0.9) +
        geom_segment(aes(x = median_budg, 
                         xend = median_budg,
                         y = -Inf,
                         yend = Inf),
                     color = "#128bb5",
                     size = .8,
                     alpha = 0.7
                    ) +
        geom_rug(alpha = 0.1, color = "#000000") +
        scale_x_log10(labels=function(x) format(x, big.mark = ".", scientific = FALSE)) +
        transition_states(round_year, 
                          transition_length = 4, 
                          state_length = 2,
                          wrap = T) +
        ease_aes('sine-in-out') +
        enter_fade() +
        exit_fade() +
        labs(
            title = "Distribuição do orçamento dos filmes (1901-2019)",
            subtitle = "Década: {closest_state}",
            x = "",
            y = "Densidade",
            caption = "Linha representa a mediana do orçamento dos filmes"
        )

animate(p, nframes = 200, fps=12)

Pode não parecer, mas esse gráfico ilustra como passamos de um orçamento mediano de apenas $50.000 na década de 1910 para um de $12.000.000 na década de 1990 e de volta para $3.000.000 na década de 2010. Essa diminuição deve ter se manisfestado pela explosão na criação de filmes com orçamentos mais baixos.

Receita mundial

# Filmes considerados: 30.607

Por último, iremos analisar a distribuição da arrecadação global.

r1 <- imdb %>%
    select(imdb_title_id, worlwide_gross_income, year) %>%
    filter(!is.na(worlwide_gross_income), !is.na(year),
           str_detect(worlwide_gross_income, "^\\$ ")) %>%
    unique %>%
    mutate(round_year = year - year %% 10) %>%
    filter(round_year >= 1920, round_year < 2020)

r1$worlwide_gross_income <- 
    as.numeric(gsub("^\\$ ", '', r1$worlwide_gross_income))

r1 %>%
    mutate(median_budg=median(worlwide_gross_income)) %>%
    ggplot(aes(x = worlwide_gross_income)) +
        geom_density(fill = "#000000", 
                     color = "#00000099", 
                     alpha = .1,
                     size = 0.9) +
        geom_segment(aes(x = median_budg, 
                         xend = median_budg,
                         y = -Inf,
                         yend = Inf),
                     color = "#128bb5",
                     size = .8,
                     alpha = 0.7
                    ) +
        geom_rug(alpha = 0.1, color = "#000000") +
        scale_x_log10(labels=function(x) format(x, big.mark = ".", scientific = FALSE)) +
        labs(
            title = "Distribuição da arrecadação global dos filmes (1901-2019)",
            x = "",
            y = "Densidade",
            caption = "Linha representa a mediana do orçamento dos filmes"
        )

Como no caso do orçamento, o gráfico original era bastante concentrado em valores pequenos com uma longa cauda a direita, por isso usamos uma escala logarítmica. Com ela, vemos um padrão relativamente simétrico com uma mediana de $1.108.330.

Aqui está o gráfico por década. Importante notar que só temos dados suficientes a partir de 1920:

p <- r1 %>%
    group_by(round_year) %>% 
    mutate(median_budg=median(worlwide_gross_income)) %>%
    ggplot(aes(x = worlwide_gross_income)) +
        geom_density(fill = "#000000", 
                     color = "#00000099", 
                     alpha = .1,
                     size = 0.9) +
        geom_segment(aes(x = median_budg, 
                         xend = median_budg,
                         y = -Inf,
                         yend = Inf),
                     color = "#128bb5",
                     size = .8,
                     alpha = 0.7
                    ) +
        geom_rug(alpha = 0.1, color = "#000000") +
        scale_x_log10(labels=function(x) format(x, big.mark = ".", scientific = FALSE)) +
        transition_states(round_year, 
                          transition_length = 4, 
                          state_length = 2,
                          wrap = T) +
        ease_aes('sine-in-out') +
        enter_fade() +
        exit_fade() +
        labs(
            title = "Distribuição do orçamento dos filmes (1901-2020)",
            subtitle = "Década: {closest_state}",
            x = "",
            y = "Densidade",
            caption = "Linha representa a mediana do orçamento dos filmes"
        )

animate(p, nframes = 200, fps=12)

Vemos que a mediana é bem menos comportada que no caso do orçamento, variando bastante entre décadas. Além disso os gráficos, pelos menos antes da década de 1980, apresentavam bimodalidades, ou seja, picos com filmes com melhores retornos e outros com piores.

Quais são os gêneros de filme mais lucrativos (considerando a mediana) ?

Existem pelo menos duas formas de responder essa pergunta, por um lado podemos levar em conta o lucro mediano absoluto dos filmes (arrecadação global - orçamento), mas isso esconde os filmes que lucraram muito pouco em relação ao seu orçamento. Por exemplo: Um filme que arrecadou $100.000.000 mundialmente e teve um orçamento de $99.000.000 ainda teve o lucro de um milhão de dólares, mas pode-se argumentar que isso é pouco em relação ao que foi gasto.

A outra opção mais óbvia seria avaliar o lucro relativo ((arrecadação global - orçamento) / orçamento), que nos daria quantos “orçamentos” o lucro cobre. Por um lado, pode-se argumentar que essa alternativa é melhor, pois reflete o ganho em cima do gasto, mas sua desvantagem é que eleva filmes que tiveram uma arrecadação baixa e um orçamento mais baixo ainda.

Sabendo de suas vantagens e desvantagens, iremos analisar os dois. Abaixo está o gráfico que mostra os diferentes lucros, calculados a partir da mediana da arrecadação e orçamento dos diferentes gêneros. O uso da mediana, em detrimento da média, é essencial nesse caso, porque a média é muito susceptível a aumentos e diminuições causadas por valores extremos, enquanto a mediana é bem mais resistente a esses eventos e descreve o ponto médio com mais precisão.

Obs: Estaremos usando apenas orçamentos e arrecadações em dólar por simplificação

imdb_aux <- imdb %>%
    filter(!is.na(budget), 
           !is.na(worlwide_gross_income), 
           str_detect(budget, "^\\$ "),
           str_detect(worlwide_gross_income, "^\\$ "))

imdb_aux$worlwide_gross_income <- 
    as.numeric(gsub("^\\$ ", '', imdb_aux$worlwide_gross_income))

imdb_aux$budget <- 
    as.numeric(gsub("^\\$ ", '', imdb_aux$budget))

imdb_aux <- imdb_aux %>%
    mutate(abs_profit = (worlwide_gross_income - budget),
           rel_profit = (worlwide_gross_income - budget) / budget)

p1 <- imdb_aux %>%
    select(imdb_title_id, genre, abs_profit) %>%
    filter(!is.na(genre)) %>%
    unique %>%
    group_by(genre) %>%
    summarise(m = quantile(abs_profit, 0.5) / 1000000) %>%
    ggplot(aes(x = reorder(genre, m), y = m)) +
    geom_segment(aes(x = reorder(genre, m), xend = genre, y = 0, yend = m),
                   color = "#deb522", lwd = 1, alpha = 0.8) +
    geom_point(size = 2) +
    coord_flip() +
    labs(
        x = "Gêneros",
        y = "Lucro absoluto (milhões de doláres)"
    )

p2 <- imdb_aux %>%
    select(imdb_title_id, genre, rel_profit) %>%
    filter(!is.na(genre)) %>%
    unique %>%
    group_by(genre) %>%
    summarise(m = quantile(rel_profit, 0.5)) %>%
    ggplot(aes(x = reorder(genre, m), y = m)) +
    geom_segment(aes(x = reorder(genre, m), xend = genre, y = 0, yend = m),
                   color = "#deb522", lwd = 1, alpha = 0.8) +
    geom_point(size = 2) +
    coord_flip() +
    labs(
        x = "Gêneros",
        y = "Lucro relativo ao orçamento"
    )

(p1 + p2) +
    plot_annotation(title = "Lucros absolutos e relativos dos gêneros baseado na mediana") & 
    theme(plot.title = element_text(hjust = 0.5))

Baseado no gráfico, observamos que filmes de animação e aventura de lucros medianos são de longe os mais rentáveis. Em termos absolutos, metade dos filmes com esses dois gêneros ultrapassam ganhos de 25 milhões de dólares, enquanto em termos relativos, metade tem lucros que equivalem ou ultrapassam os seus orçamentos.

Enquanto documentários, filmes históricos e de guerra com lucros medianos (tanto relativos, quanto absolutos) resultam em prejuízos.

Interessantemente, os gêneros mais populares (drama e comédia) não parecem lucrar bem considerando a mediana, e diversos fatores podem ajudar a explicar isso. Não iremos nos aprofundar neles, mas poderíamos começar explorando com que gêneros eles normalmente são pareados em filmes, analisar outros percentis além da mediana e considerar o custo de produção desses filmes, entre outros.

O que os filmes de maior sucesso financeiro têm em comum ?

De forma análoga à resposta anterior, podemos tomar o caminho do lucro absoluto ou relativo. E como também fizemos anteriormente, decidimos observar essas duas dimensões.

Obs: Estaremos usando apenas orçamentos e arrecadações em dólar por simplificação

Sucesso Absoluto

Iremos considerar os 1% dos filmes com maior lucro absoluto e tentar extrair semelhanças entre os seus enredos através das sinópses e sumarisar outras características que vimos anteriormente.

a <- imdb_aux %>%
    filter(abs_profit > quantile(abs_profit, .99)) %>%
    select(imdb_title_id, worlwide_gross_income, description) %>%
    unique %>%
    arrange(desc(worlwide_gross_income))

text <- paste0(a$description, collapse = " ")

wc <- rquery.wordcloud(text, type=c("text"), 
                lang="english", excludeWords=NULL, 
                textStemming=FALSE,  colorPalette="Dark2",
                min.freq=3, max.words=200)

p1 <- wc$plot

p2 <- wc$source %>%
    arrange(desc(freq)) %>%
    head(n = 15) %>%
    ggplot(aes(x = reorder(word, freq), y = freq)) +
      geom_segment(aes(x = reorder(word, freq), xend = word,
                       y = 0, yend = freq),
                   color = "#deb522", lwd = 1.4, alpha = 0.4) +
      geom_point(size = 6, pch = 21, fill = "#deb522", color = "white", col = 1, alpha = 0.95) +
      geom_text(aes(label = freq), color = "#0c0b00", size = 2.8) +
      coord_flip() +
      labs(
          y = "Frequência",
          x = "Palavras"
      )

(p1 + p2 ) +
    plot_annotation(title = "Nuvem e frequências de palavras das sinópses (lucro absoluto)") & 
    theme(plot.title = element_text(hjust = 0.5))

Aparentemente, baseado nas palavras que mais repetem, os enredos focam em descoberta, novidade, mundo, planeta terra, salvar, deveres, família, rapaz, juventude, vida, entre outras. O que é bastante intrigante, pois parecem se encaixar perfeitamente em filmes de ação/aventura modernos (e.g. super hérois, bruxos, mundos alternativos), como também em histórias ancentrais (mitos fantásticos gregos, romanos, …), que em narratologia são trabalhados na ideia de monomito.

Uma teoria que tenta classificar semelhanças nessas histórias de heróis. Em que, geralmente, um rapaz jovem é confrontado com o dever de salvar o mundo pelo bem de sua família, amigos e parceiros. Recebendo ajuda no meio do caminho, prevalencendo aos testes que se apresentam e vencendo a batalha final.

Quanto as sumarizações, o orçamento mediano desses filmes é em torno de 160 milhões de dólares (desvio padrão: $74.156.277), enquanto a arrecadação global mediana está em torno de 1 bilhão de dólares (desvio padrão: $379.444.564). Já a duração mediana fica em 2h e 13min (desvio padrão: 24.80 min). 49% deles incluem inglês como idioma, 6% espanhol e 4% francês. Os gêneros mais presentes incluem aventura (31%), ação (20%) e fantasia (9%). Por fim, os países de gravações principais são o EUA (60%), Reino Unido (12%) e China (4%).

Sucesso Relativo

Faremos o mesmo que no caso anterior para os 1% dos filmes com maior lucro relativo.

a <- imdb_aux %>%
    filter(rel_profit > quantile(rel_profit, .99)) %>%
    select(imdb_title_id, worlwide_gross_income, description) %>%
    unique %>%
    arrange(desc(worlwide_gross_income))

text <- paste0(a$description, collapse = " ")

wc <- rquery.wordcloud(text, type=c("text"), 
                lang="english", excludeWords=NULL, 
                textStemming=FALSE,  colorPalette="Dark2",
                min.freq=3, max.words=200)

p1 <- wc$plot

p2 <- wc$source %>%
    arrange(desc(freq)) %>%
    head(n = 15) %>%
    ggplot(aes(x = reorder(word, freq), y = freq)) +
      geom_segment(aes(x = reorder(word, freq), xend = word, 
                       y = 0, yend = freq),
                   color = "#deb522", lwd = 1.4, alpha = 0.4) +
      geom_point(size = 6, pch = 21, fill = "#deb522", color = "white", col = 1, alpha = 0.95) +
      geom_text(aes(label = freq), color = "#0c0b00", size = 2.8) +
      coord_flip() +
      labs(
          y = "Frequência",
          x = "Palavras"
      )

(p1 + p2 ) +
    plot_annotation(title = "Nuvem e frequências de palavras das sinópses (lucro relativo)") & 
    theme(plot.title = element_text(hjust = 0.5))

Aparentemente, nesse caso, os enredos dos filmes focam em temas mais próximos de relações humanas reais e menos fabulosas, com palavras como: familia, jovem, escola, lar, mulher, dois, devem, garoto. O que mais me despertou interesse aqui foi a presença marcante do dois como palavra mais popular, sendo algo bacana de ser analisado no futuro. De antemão, suspeito que ela possa estar conectada as outras palavras mais frequentes (dever, amar/amor, …), e possa ser explicada no contexto de romance.

Quanto as sumarizações, o orçamento mediano desses filmes está em torno de 18 milhões de dólares (desvio padrão: $44.230.636), enquanto a arrecadação global mediana está em torno de 52.9 milhões de dólares (desvio padrão: $198.185.098). Já a duração mediana fica em 1h e 46min (desvio padrão: 19.30 min). 55% deles incluem inglês como idioma, 7% espanhol e 5% francês. Os gêneros mais presentes incluem drama (18%), comédia (15%), ação (10%) e aventura (8%). Por fim, os países de gravações principais são o EUA (55%), Reino Unido (9%), Canadá (4%) e França (4%).

Modelando a arrecadação mundial com regressão linear múltipla

set.seed(123)

imdb_aux <- imdb %>%
    filter(!is.na(budget), 
           !is.na(worlwide_gross_income), 
           !is.na(votes),
           !is.na(reviews_from_users),
           !is.na(reviews_from_critics),
           str_detect(budget, "^\\$ "), 
           str_detect(worlwide_gross_income, "^\\$ "),
           reviews_from_users >= 50,
           reviews_from_critics >= 50)

imdb_aux <- imdb_aux %>%
    select(imdb_title_id, budget, worlwide_gross_income, 
           votes, reviews_from_critics,
           reviews_from_users) %>%
    unique()

imdb_aux$budget <- 
    as.numeric(gsub("^\\$ ", '', imdb_aux$budget))

imdb_aux$worlwide_gross_income <- 
    as.numeric(gsub("^\\$ ", '', imdb_aux$worlwide_gross_income))

wgi_model <- lm(log10(worlwide_gross_income) ~ log10(budget) +
                    log10(votes) + log10(reviews_from_users) +
                    log10(reviews_from_critics), 
                data = imdb_aux)

Por fim, iremos modelar a arrecadação mundial dos filmes atravez de uma regressão linear múltipla. Para isso, escolhemos utilizar algumas variáveis númericas que temos, as quais apresentam algum tipo de relação linear com a arrecação global. Elas se tratam de: número de votos, orçamento, número de avaliações dos usuários e número de avaliações de críticos.

# Filmes considerados: 5.056

Além do orçamento, não haviamos explorado a distribuição dessas outras variáveis para esse relatório não ficar muito exaustivo. Mas ainda é importante observar a natureza linear da relações entre as variáveis dependentes e independentes. Por isso, abaixo estão os gráficos de pontos mostrando justamente isso:

options(scipen = 0)

formatCustomSci <- function(x) {     # Create user-defined function
  x_sci <- str_split_fixed(formatC(x, format = "e"), "e", 2)
  alpha <- as.numeric(x_sci[ , 1])
  power <- as.integer(x_sci[ , 2])
  paste(alpha * 10, power - 1L, sep = "^")
}

pm1 <- imdb_aux %>%
    ggplot(aes(budget, worlwide_gross_income)) +
    geom_point(alpha = 0.05, size = 0.1) +
    scale_x_log10(labels = formatCustomSci) +
    scale_y_log10(labels = formatCustomSci) +
    labs(
        x = "Orçamento (milhões)",
        y = "Arrecadação (milhões)"
    )

pm2 <- imdb_aux %>%
    ggplot(aes(votes, worlwide_gross_income)) +
    geom_point(alpha = 0.05, size = 0.1) +
    scale_x_log10(labels = formatCustomSci) +
    scale_y_log10(labels = formatCustomSci) +
    labs(
        x = "Votos",
        y = "Arrecadação (milhões)"
    )

pm3 <- imdb_aux %>%
    ggplot(aes(reviews_from_users, worlwide_gross_income)) +
    geom_point(alpha = 0.05, size = 0.1) +
    scale_x_log10() +
    scale_y_log10(labels = formatCustomSci) +
    labs(
        x = "# Avaliações de usuários",
        y = "Arrecadação (milhões)"
    )

pm4 <- imdb_aux %>%
    ggplot(aes(reviews_from_critics, worlwide_gross_income)) +
    geom_point(alpha = 0.05, size = 0.1) +
    scale_x_log10() +
    scale_y_log10() +
    labs(
        x = "# Avaliações de críticos",
        y = "Arrecadação (milhões)"
    )

(pm1 + pm2) / (pm3 + pm4)

Obs:

  1. As relações lineares entre as variáveis ocorrem entre seus logarítmos, ou seja, aumentos exponenciais na arrecadação acompanham aumentos exponenciais nessas outras váriaveis;

  2. Não foram utilizadas as variáveis categóricas, por possuírem muitos valores possíveis (atores, escritores, …), o que poderia prejudicar a interpretação do modelo;

  3. Consideramos apenas orçamentos e arrecadação globais em dólar.

Ocorrem algumas “linhas” verticais nas avaliações de usuários e críticos, as quais sugerem que existem números baixos de avaliações para filmes com arrecadações globais tanto altas, como também baixas. Por isso, nosso modelo irá considerar apenas essas avaliações a partir do 50.

Após codificado em R, nosso modelo apresentou as seguintes estimativas para seus termos:

model <- tidy(wgi_model, conf.int = T)

model$term[model$term == "log10(budget)"] <- 
    "Log(Orçamento)"
model$term[model$term == "log10(votes)"] <- 
    "Log(Votos)"
model$term[model$term == "log10(reviews_from_users)"] <-
    "Log(Avaliações dos usuários)"
model$term[model$term == "log10(reviews_from_critics)"] <-
    "Log(Avaliações dos críticos)"

model %>%
    select(term, estimate, conf.low, conf.high) %>%
    mutate("IC 95%" = 
               paste("[", round(conf.low, 4), ", ", 
                     round(conf.high, 4), "]", sep = "")) %>%
    rename("Termo" = term, "Estimativa" = estimate) %>%
    select(!starts_with("conf")) %>%
    kbl() %>%
    kable_styling(font_size = 13, full_width = F)
Termo Estimativa IC 95%
(Intercept) -2.3542383 [-2.5851, -2.1233]
Log(Orçamento) 0.8587136 [0.8281, 0.8893]
Log(Votos) 0.7013755 [0.6385, 0.7642]
Log(Avaliações dos usuários) 0.0274818 [-0.0547, 0.1096]
Log(Avaliações dos críticos) 0.0606030 [-0.0309, 0.1521]

Com base na tabela apresentada, o modelo tem o seguinte formato:

\[ \begin{aligned} log_{10}(wgi) = -2.35 + log_{10}(budget) * 0.86 + log_{10}(votes) * 0.70 - \\ log_{10}(rev\_users) * 0.027 - log_{10}(rev\_critics) * 0.06 \end{aligned} \]

E seu coeficiente de determinação (r2) ajustado, que diz respeito ao quanto da variação da arrecadação global pode ser explicada pelas variáveis independentes, obteve um valor de 59.63%. Ou seja, explica consideravelmente bem as flutuações de arrecadação global somente considerando esses quatro valores.

Já para interpretar o impacto dos aumentos individuais desses fatores na arrecadação global, temos de relembrar algumas propriedades dos logarítmos.

Relembrando…

Primeiro, se multiplicamos o x em \(log_{10}(x)\) por 10, temos: \(log_{10}(x * 10) = log_{10}(x) + log_{10}(10) = log_{10}(x) + 1\), consequentemente aumentamos em 1 o \(log_{10}(x)\) original.

Com base nessa propriedade, se temos, por exemplo, \(log_{10}(x) = 0.5 * log_{10}(y)\) e multiplicamos o y por 10, então: \(log_{10}(x) = 0.5 * (log_{10}(y) + 1) = 0.5 * log_{10}(y) + 0.5\), o que revela um aumento de 0.5 no primeiro \(log_{10}(x)\).

Portanto, considerando que \(10^{log_{10}(x)} = 10^{0.5 * log_{10}(y) + 0.5} = 10^{0.5 * log_{10}(y)}*10^{0.5}\), temos que \(x = 10^{log_{10}(x)}\) , o x original, foi multiplicado por \(10^{0.5} = 3.16\).

Dessa forma, podemos descrever por quanto o x aumenta, dado que y foi multiplicado por 10.

Com base no que relembramos podemos avaliar os impactos individuais de cada fator na arrecadação. No caso do orçamento (budget), quando multiplicado por 10, temos que a arrecadação é multiplicada por \(10^{0.86} \approx 7.24\) , enquanto para o número de votos, temos que a arrecadação será multiplicada por \(10^{0.70} \approx 5.01\), ou seja, tem um efeito bem menor na nossa variável de resposta. Já no caso das avaliações dos usuários, haverá um efeito pequeno \(10^{0.027} = \approx 1.064\) e no caso das avaliações dos críticos \(10^{0.06} = \approx 1.15\), isto é, esses fatores pouco aumentam a arrecadação em torno de 6-15%.

Agora investigaremos os possíveis valores desse modelo na população (de todos os filmes) através de intervalos de confiança de 95%.

model %>%
    filter(term != "(Intercept)") %>%
    ggplot(aes(x = reorder(term, estimate), 
               y = estimate, 
               ymin = conf.low, 
               ymax = conf.high)) +
    geom_linerange(size = .7) +
    geom_point(color = "cadetblue", size = 2.5, alpha = 1) +
    geom_text(aes(label = paste("[", round(conf.low, 2), ", ", 
                                round(conf.high, 2), "]", sep = "")), 
              nudge_x = -0.2, nudge_y = 0.15, size = 3.4) +
    coord_flip() +
    labs(
        x = "Termos do modelo",
        y = "Estimativa",
        title = "Termos do modelo na população"
    )

Podemos observar que não há muita diferença entre os valores previstos nos intervalos intervalos de confiança e os do nosso modelo da amostra. Entretanto estimamos que as avaliações podem ser levemente negativas ou positivas (com baixo efeito, de toda forma). Já o número de votos e o orçamento continuem tendo o maior impacto positivo no modelo da população.

Era isso por hoje pessoal, até a próxima!