Introducción

El objetivo del presente trabajo es analizar las películas con una calificación superior a la media de una muestra de 831 películas desde el año 1921 hasta el año 2019 por los usuarios de la página Internet Movie DataBase (IMDB), a través de distintas herramientas estadísticas a partir de la aplicación de RStudio.

Las variables a analizar son el promedio del ingreso recaudado, la cantidad de películas por director, la calificación otorgada por los usuarios de IMDB y el año de estreno de todas las películas seleccionadas de la lista de las 831 películas mejor calificadas del IMDB.

Datos y limpieza de datos

Los datos fueron obtenidos de la siguiente liga: datos.

# Las librerias que se utilizaron fueron las que se enlistan a continuación.

# De manera general, tidyverse incluye un conjunto de librerias como ggplot2, dplyr, tidyr, etc.
library(tidyverse)

theme_set(theme_bw())
# Los datos se cargaron en:
imdb <- read_csv("data/imdb_top_1000.csv")
imdb_clean <- 
  imdb %>% 
  # Una película tiene PG en la columna de año. Por lo que se removieron este tipo de películas. 
  filter(Released_Year != "PG")  %>% 
  # Posteriormente, se convirtió el año en una variable numérica y no de caracter.
  mutate(
    Released_Year = as.numeric(Released_Year)
  ) %>% 
  # El año fue filtrado con el siguiente script. 
  filter(Released_Year >= 1921, Released_Year <= 2019) %>% 
  filter(
    !is.na(Gross),
    !is.na(IMDB_Rating)
  )
# Distribución del raiting.
imdb_clean %>% 
  ggplot(aes(x = IMDB_Rating)) +
  geom_histogram(binwidth = 1/5, color="darkgreen", fill="grey") +
  labs(
    y = "Frecuencia",
    x = "Calificacion obtenida (rating)"
  )

Para seleccionar la lista de las 831 películas mejor calificadas del IMDB entre los años 1921 y 2019. Se realizó el siguiente análisis.

imdb_clean <- imdb_clean %>% 
  arrange(desc(IMDB_Rating)) %>% 
  slice(1:831)

print(paste0("Peliculas a analizar despues de filtros: ", nrow(imdb_clean)))
## [1] "Peliculas a analizar despues de filtros: 830"

Análisis exploratorio

Las variables seleccionadas a explorar son:

Promedio del ingreso recaudado

El ingreso recaudado por género se calculó en primer lugar. Es importante observar que existen películas que fueron asignadas a más de un género. Por lo que el ingreso fue calculado para películas con múltiples géneros.

max_genres <- str_count(imdb_clean$Genre, pattern = ", ") %>% 
  max() %>% 
  sum(c(1))

generos <- 
  imdb_clean %>% 
  select(Genre, Gross, Series_Title) %>% 
  separate(Genre, sep=", ", into = paste0("Genre_", 1:max_genres)) %>% 
  pivot_longer(-c(Series_Title, Gross), values_to = "Genre") %>% 
  select(-name) %>% 
  filter(!is.na(Genre))

head(generos)
## # A tibble: 6 x 3
##       Gross Series_Title             Genre 
##       <dbl> <chr>                    <chr> 
## 1  28341469 The Shawshank Redemption Drama 
## 2 134966411 The Godfather            Crime 
## 3 134966411 The Godfather            Drama 
## 4 534858444 The Dark Knight          Action
## 5 534858444 The Dark Knight          Crime 
## 6 534858444 The Dark Knight          Drama

Se obtuvo una tabla en donde cada género está asignado a un película. En el caso de peliculas con múltiples géneros, existirá repeticiones. Por ejemplo, la película “The Godfather” aparecerá en los géneros de crimen y drama.

generos %>% 
  # mutate(
  #   Genre = fct_reorder(Genre, Gross, .fun=median, .desc = TRUE)
  # ) %>% 
  ggplot(aes(x = reorder(Genre, Gross, median), y = Gross, fill = Genre)) +
  geom_boxplot() +
  scale_y_log10() +
  coord_flip() +
  labs(
    y = "Ganancias en dolares \n escala logaritmica",
    x = "Genero"
  ) +
  theme(legend.position = "none")

En esta parte, se pueden observar los géneros que mayor ganancias obtuvieron. A partir de esto, se puede plantear la siguiente hipótesis:

El género Adventure genera más ganancias que el género de Mystery.

Para probar esta hipótesis, realizemos una prueba “t” de student.

hip1 <- generos %>% 
  filter(Genre %in% c("Adventure", "Mystery"))

t.test(Gross ~ Genre, data = hip1)
## 
##  Welch Two Sample t-test
## 
## data:  Gross by Genre
## t = 8.3943, df = 230.36, p-value = 4.782e-15
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##   95207479 153610377
## sample estimates:
## mean in group Adventure   mean in group Mystery 
##               165683310                41274382

En esta prueba obtenemos un p-value < 0.05, por lo cual podemos rechazar la hipótesis nula y aceptar que El género Adventure genera más ganancias que el género de Mystery. .

Cantidad de películas por director

A continuación se muestra la selección de películas dirigidas por director. Además, fue posible obtener el ingreso de las películas de cada director. Por lo tanto, la siguiente tabla resume los 10 directores que han generado mayor dinero con sus filmes al igual que el número de películas producidas.

imdb_clean %>% 
  group_by(Director) %>% 
  summarise(Peliculas = n(), Total_Recaudado = sum(Gross)) %>% 
  arrange(-Total_Recaudado) %>% 
  slice(1:10) %>% 
  knitr::kable(caption = "La columna Total_Recaudado esta en unidades de dólares americanos $.")
La columna Total_Recaudado esta en unidades de dólares americanos $.
Director Peliculas Total_Recaudado
Steven Spielberg 13 2478133165
Anthony Russo 4 2205039403
Christopher Nolan 8 1937454106
James Cameron 5 1748236602
Peter Jackson 5 1597312443
J.J. Abrams 3 1423170905
Brad Bird 4 1099627795
Robert Zemeckis 5 1049446456
David Yates 3 978953721
Pete Docter 3 939382131

Es evidente que el puesto número uno lo ocupa Steven Spielberg con 13 películas.

Calificación otorgada por los usuarios de IMDB

Ahora bien, en esta sección, se planteó la premisa si existe una correlación entre el la duración de la película en minutos y el rating obtenido por los usuarios de IMDB, de tal forma que se pueda comprobar si: Las peliculas largas son más aburridas.

La hipótesis a comprobar es:

Existe una correlación entre la duración de la película y el rating recibido

# El formato de duración está en XXX min. Por lo que se convirtió en una variable numérica, eliminando así el min.

imdb_clean <- 
  imdb_clean %>% 
  mutate(
    duration_min = str_replace(Runtime, " min", "") %>% as.numeric()
  )

imdb_clean %>% 
  ggplot(aes(x = duration_min, y = IMDB_Rating, color = log(Gross))) +
  geom_point(position = "jitter") +
  geom_smooth(method = "lm") +
  scale_color_viridis_c() +
  theme(legend.position = "none") +
  labs(
    x = "Duración de la película en minutos",
    y = "Calificacion obtenida (rating)"
  )

Es importante resaltar que la línea azul en la gráfica muestra la tendencia lineal de los datos. El color de los puntos representa la variable Gross.

cor.test(x = imdb_clean$duration_min, y = imdb_clean$IMDB_Rating)
## 
##  Pearson's product-moment correlation
## 
## data:  imdb_clean$duration_min and imdb_clean$IMDB_Rating
## t = 7.3627, df = 828, p-value = 4.352e-13
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1829228 0.3106948
## sample estimates:
##       cor 
## 0.2478865

Después de analizar la gráfica, se observa que existe una correlación positiva. Es decir, si la película es de larga duración, entonces será aburrida y por consiguiente obtendrá un raiting inferior.

En este orden de ideas, se estudió si este efecto se mantiene con la variable del género de las películas.

# Se utilizó la tabla de géneros anterior.
data2 <- inner_join(imdb_clean, generos, by= "Series_Title")

lm(IMDB_Rating ~ duration_min + Genre.y, data = data2) %>% 
  summary()
## 
## Call:
## lm(formula = IMDB_Rating ~ duration_min + Genre.y, data = data2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.54826 -0.20952 -0.04453  0.15511  1.31060 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       7.6200931  0.0358818 212.366   <2e-16 ***
## duration_min      0.0025887  0.0002266  11.423   <2e-16 ***
## Genre.yAdventure  0.0183194  0.0300467   0.610    0.542    
## Genre.yAnimation  0.0457861  0.0400036   1.145    0.253    
## Genre.yBiography -0.0503323  0.0351933  -1.430    0.153    
## Genre.yComedy    -0.0093691  0.0294194  -0.318    0.750    
## Genre.yCrime      0.0183355  0.0299660   0.612    0.541    
## Genre.yDrama      0.0017165  0.0243436   0.071    0.944    
## Genre.yFamily    -0.0266413  0.0447477  -0.595    0.552    
## Genre.yFantasy   -0.0173315  0.0422100  -0.411    0.681    
## Genre.yFilm-Noir  0.1266021  0.0846103   1.496    0.135    
## Genre.yHistory   -0.0618685  0.0472347  -1.310    0.190    
## Genre.yHorror    -0.0207480  0.0617784  -0.336    0.737    
## Genre.yMusic     -0.0253279  0.0518641  -0.488    0.625    
## Genre.yMusical   -0.0826419  0.0756294  -1.093    0.275    
## Genre.yMystery    0.0296868  0.0366296   0.810    0.418    
## Genre.yRomance   -0.0031479  0.0339904  -0.093    0.926    
## Genre.ySci-Fi     0.0539844  0.0408736   1.321    0.187    
## Genre.ySport     -0.0371150  0.0657729  -0.564    0.573    
## Genre.yThriller  -0.0102464  0.0337210  -0.304    0.761    
## Genre.yWar        0.0443897  0.0495448   0.896    0.370    
## Genre.yWestern    0.0690708  0.0710651   0.972    0.331    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2706 on 2084 degrees of freedom
## Multiple R-squared:  0.06883,    Adjusted R-squared:  0.05945 
## F-statistic: 7.335 on 21 and 2084 DF,  p-value: < 2.2e-16
data2 %>% 
  ggplot(aes(x = duration_min, y = IMDB_Rating, color = log(Gross.y))) +
  geom_point(position = "jitter") +
  geom_smooth(method = "lm") +
  scale_color_viridis_c() +
  facet_wrap(~Genre.y, scales = "free_x") +
  theme(legend.position = "none")

Con el objetivo de saber si las las películas más recientes recaudan más dinero, se establecieron los siguientes paramétros:

imdb_clean %>% 
  ggplot(aes(x = Released_Year, y = Gross)) +
  geom_point(position = "jitter") +
 scale_y_log10() +
  geom_smooth(method = "lm") +
  labs(
    x = "Año de lanzamiento",
    y = "Ganancias en dolares \n escala logaritmica"
  )

cor.test(x=imdb_clean$Released_Year, y=imdb_clean$Gross)
## 
##  Pearson's product-moment correlation
## 
## data:  imdb_clean$Released_Year and imdb_clean$Gross
## t = 6.9021, df = 828, p-value = 1.019e-11
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1678649 0.2965914
## sample estimates:
##       cor 
## 0.2332498

En general, existe una correlación positiva (p.value < 0.05) entre el año de la película y el ingreso recaudado, por lo que se concluye que que las películas más recientes generan mayores ganancias. El genero que mas dinero recauda es aventura. También, el director que tiene mas películas es Steven Spielberg y también el que mas dinero ha recaudado hasta la fecha.

Reproducibilidad

Este análisis fue realizado bajo la siguiente sesión de R.

sessionInfo()
## R version 4.0.3 (2020-10-10)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS Big Sur 10.16
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] forcats_0.5.0   stringr_1.4.0   dplyr_1.0.2     purrr_0.3.4    
## [5] readr_1.4.0     tidyr_1.1.3     tibble_3.0.4    ggplot2_3.3.5  
## [9] tidyverse_1.3.0
## 
## loaded via a namespace (and not attached):
##  [1] tidyselect_1.1.0  xfun_0.19         lattice_0.20-41   splines_4.0.3    
##  [5] haven_2.3.1       colorspace_2.0-0  vctrs_0.3.6       generics_0.1.0   
##  [9] viridisLite_0.3.0 htmltools_0.5.0   mgcv_1.8-33       yaml_2.2.1       
## [13] utf8_1.1.4        rlang_0.4.11      pillar_1.4.7      glue_1.4.2       
## [17] withr_2.3.0       DBI_1.1.0         dbplyr_2.0.0      modelr_0.1.8     
## [21] readxl_1.3.1      lifecycle_0.2.0   munsell_0.5.0     gtable_0.3.0     
## [25] cellranger_1.1.0  rvest_0.3.6       evaluate_0.14     labeling_0.4.2   
## [29] knitr_1.30        fansi_0.4.1       highr_0.8         broom_0.7.2      
## [33] Rcpp_1.0.7        scales_1.1.1      backports_1.2.0   jsonlite_1.7.1   
## [37] farver_2.0.3      fs_1.5.0          hms_0.5.3         digest_0.6.27    
## [41] stringi_1.5.3     grid_4.0.3        cli_2.2.0         tools_4.0.3      
## [45] magrittr_2.0.1    crayon_1.3.4      pkgconfig_2.0.3   Matrix_1.2-18    
## [49] ellipsis_0.3.1    xml2_1.3.2        reprex_0.3.0      lubridate_1.7.9.2
## [53] assertthat_0.2.1  rmarkdown_2.5     httr_1.4.2        rstudioapi_0.13  
## [57] R6_2.5.0          nlme_3.1-149      compiler_4.0.3