movieLens dataset analysis

Objectives

The movieLens dataset is most often used for the purpose of recommender systems which aim to predict user movie ratings based on other users’ ratings. In other words we expect that users with similar taste will tend to rate movies with high correlation.

However, in this analysis we will try to explore the movies themselves. Hopefully it will give us an interesting insight into the history of cinematography.

Packages used

For this analysis the Microsoft R Open distribution was used. The reason for this was its multithreaded performance as described here. Most of the packages that were used come from the tidyverse - a collection of packages that share common philosophies of tidy data. The tidytext and wordcloud packages were used for some text processing. Finally, the doMC package was used to embrace the multithreading in some of the custom functions which will be described later.

doMC package is not available on Windows. Use doParallel package instead.

# Load the packages -------------------------------------------------------
library(checkpoint)
checkpoint("2017-01-15", auto.install.knitr=T)
library(tidyverse)
library(lubridate)
library(stringr)
library(rvest)
library(XML)
library(tidytext)
library(wordcloud)
library(doMC)
registerDoMC()
set.seed(1234)

The output of sessionInfo() is placed here for reproducibility purposes.

# Print Session Information
sessionInfo()

## R version 3.3.2 (2016-10-31)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS Sierra 10.12.2
##
## locale:
## [1] pl_PL.UTF-8/pl_PL.UTF-8/pl_PL.UTF-8/C/pl_PL.UTF-8/pl_PL.UTF-8
##
## attached base packages:
## [1] parallel  stats     graphics  grDevices utils     datasets  methods  
## [8] base     
##
## other attached packages:
##  [1] doMC_1.3.4         iterators_1.0.8    foreach_1.4.3     
##  [4] wordcloud_2.5      RColorBrewer_1.1-2 tidytext_0.1.2    
##  [7] XML_3.98-1.5       rvest_0.3.2        xml2_1.0.0        
## [10] stringr_1.1.0      lubridate_1.6.0    dplyr_0.5.0       
## [13] purrr_0.2.2        readr_1.0.0        tidyr_0.6.0       
## [16] tibble_1.2         ggplot2_2.2.0      tidyverse_1.0.0   
## [19] checkpoint_0.3.18
##
## loaded via a namespace (and not attached):
##  [1] Rcpp_0.12.7       plyr_1.8.4        tokenizers_0.1.4
##  [4] tools_3.3.2       digest_0.6.10     evaluate_0.10    
##  [7] gtable_0.2.0      nlme_3.1-128      lattice_0.20-34  
## [10] Matrix_1.2-7.1    psych_1.6.9       DBI_0.5-1        
## [13] yaml_2.1.14       janeaustenr_0.1.4 httr_1.2.1       
## [16] knitr_1.15        RevoUtils_10.0.2  grid_3.3.2       
## [19] R6_2.2.0          foreign_0.8-67    rmarkdown_1.1    
## [22] reshape2_1.4.2    magrittr_1.5      codetools_0.2-15
## [25] scales_0.4.1      SnowballC_0.5.1   htmltools_0.3.5  
## [28] assertthat_0.1    mnormt_1.5-5      colorspace_1.3-0
## [31] stringi_1.1.2     lazyeval_0.2.0    munsell_0.4.3    
## [34] slam_0.1-38       broom_0.4.1

Dataset Download

First the data needs to be downloaded and unzipped. Although it is generally done only once during the analysis, it makes the reproducibility so much easier and less painful.

url <- "http://files.grouplens.org/datasets/movielens/"
dataset_small <- "ml-latest-small"
dataset_full <- "ml-latest"
data_folder <- "data"
archive_type <- ".zip"

# Choose dataset version
dataset <- dataset_full
dataset_zip <- paste0(dataset, archive_type)

# Download the data and unzip it
if (!file.exists(file.path(data_folder, dataset_zip))) {
  download.file(paste0(url, dataset_zip), file.path(data_folder, dataset_zip))
}
unzip(file.path(data_folder, dataset_zip), exdir = data_folder, overwrite = F)

# Display the unzipped files
list.files('data/', recursive=T)

##  [1] "ml-latest-small.zip"         "ml-latest-small/links.csv"  
##  [3] "ml-latest-small/movies.csv"  "ml-latest-small/ratings.csv"
##  [5] "ml-latest-small/README.txt"  "ml-latest-small/tags.csv"   
##  [7] "ml-latest.zip"               "ml-latest/genome-scores.csv"
##  [9] "ml-latest/genome-tags.csv"   "ml-latest/links.csv"        
## [11] "ml-latest/movies.csv"        "ml-latest/ratings.csv"      
## [13] "ml-latest/README.txt"        "ml-latest/tags.csv"         
## [15] "placeholder"

Loading the Dataset

The dataset is split into four files (genome-scores.csv and genome-tags.csv were omitted for this analysis)- movies.csv, ratings.csv, links.csv and tags.csv. We will iteratively load the files into the workspace using read_csv() function and assign variable names accordingly. The read_csv() function is very convenient because it automagically guesses column types based on the first 1000 rows. And more importantly it never converts strings to factors. Never.

Finally we will check object sizes to see how big is the dataset.

dataset_files <- c("movies", "ratings", "links", "tags")
suffix <- ".csv"

for (f in dataset_files) {
  path <- file.path(data_folder, dataset, paste0(f, suffix))
  assign(f, read_csv(path))
  print(paste(f, "object size is", format(object.size(get(f)),units="Mb")))
}

## [1] "movies object size is 3.8 Mb"
## [1] "ratings object size is 465.5 Mb"
## [1] "links object size is 2.5 Mb"
## [1] "tags object size is 15.7 Mb"

The biggest data frame is ratings - 465.5 Mb - it contains movie ratings from movieLens users. Next we will see what kind of data we deal with.

How many movies were produced per year?

The first question that may be asked is how many movies were produced year by year. We can easily extract this information from the movies_df data frame.

# Number of movies per year/decade
movies_per_year <- movies_df %>%
  na.omit() %>% # omit missing values
  select(movieId, year) %>% # select columns we need
  group_by(year) %>% # group by year
  summarise(count = n())  %>% # count movies per year
  arrange(year)

knitr::kable(head(movies_per_year, 10))

There are some years that are missing, probably there were no movies produced in the early years. We can easily fix missing values using complete() function from the tidyr package.

# fill missing years
movies_per_year <- movies_per_year %>%
  complete(year = full_seq(year, 1), fill = list(count = 0))

knitr::kable(head(movies_per_year, 10))

That’s better. Now let’s plot what we have.

movies_per_year %>%
  ggplot(aes(x = year, y = count)) +
  geom_line(color="blue")

We can see an exponential growth of the movie business and a sudden drop in 2016. The latter is caused by the fact that the data is collected until October 2016 so we don’t have the full data on this year. As for the former, perhaps it was somewhat linked to the beginning of the information era. Growing popularity of the Internet must have had a positive impact on the demand for movies. That is certainly something worthy of further analysis.

What were the most popular movie genres year by year?

We know how many movies were produced, but can we check what genres were popular? We might expect that some events in history might have influenced the movie creators to produce specific genres. First we will check what genres are the most popular in general.

genres_df <- movies_df %>%
  separate_rows(genres, sep = "\\|") %>%
  group_by(genres) %>%
  summarise(number = n()) %>%
  arrange(desc(number))

knitr::kable(head(genres_df, 10))

No suprise here. Dramas and comedies are definitely the most popular genres.

# Genres popularity per year
genres_popularity <- movies_df %>%
  na.omit() %>% # omit missing values
  select(movieId, year, genres) %>% # select columns we are interested in
  separate_rows(genres, sep = "\\|") %>% # separate genres into rows
  mutate(genres = as.factor(genres)) %>% # turn genres in factors
  group_by(year, genres) %>% # group data by year and genre
  summarise(number = n()) %>% # count
  complete(year = full_seq(year, 1), genres, fill = list(number = 0)) # add missing years/genres

Now we are able to plot the data. For readability we choose 4 genres: animation, sci-fi, war and western movies.

genres_popularity %>%
  filter(year > 1930) %>%
  filter(genres %in% c("War", "Sci-Fi", "Animation", "Western")) %>%
  ggplot(aes(x = year, y = number)) +
    geom_line(aes(color=genres)) +
    scale_fill_brewer(palette = "Paired") 

Here we have some interesting observations. First we can notice a rapid growth of sci-fi movies shortly after 1969, the year of the first Moon landing. Secondly, we notice high number of westerns in 1950s and 1960s that was the time when westerns popularity was peaking. Next, we can see the rise of popularity of animated movies, the most probable reason might be the computer animation technology advancement which made the production much easier. War movies were popular around the time when big military conflicts occured - World War II, Vietnam War and most recently War in Afghanistan and Iraq. It’s interesting to see how the world of cinematography reflected the state of the real world.

What were the best movies of every decade (based on users’ ratings)?

We may wish to see what were the highest rated movies in every decade. First, let’s find average score for each movie.

# average rating for a movie
avg_rating <- ratings_df %>%
  inner_join(movies_df, by = "movieId") %>%
  na.omit() %>%
  select(movieId, title, rating, year) %>%
  group_by(movieId, title, year) %>%
  summarise(count = n(), mean = mean(rating), min = min(rating), max = max(rating)) %>%
  ungroup() %>%
  arrange(desc(mean))

knitr::kable(head(avg_rating, 10))

That doesn’t look too good. If we sort by average score our ranking will be polluted by movies with low count of reviews. To deal with this issue we will use a weighted average used on IMDB website for their Top 250 ranking. Head here for more details.

# R = average for the movie (mean) = (Rating)
# v = number of votes for the movie = (votes)
# m = minimum votes required to be listed in the Top 250
# C = the mean vote across the whole report
weighted_rating <- function(R, v, m, C) {
  return (v/(v+m))*R + (m/(v+m))*C
}

avg_rating <- avg_rating %>%
  mutate(wr = weighted_rating(mean, count, 500, mean(mean))) %>%
  arrange(desc(wr))

knitr::kable(head(avg_rating, 10))

That’s better. Movies with more good reviews got higher score. Now let’s findthe best movie for every decade since the beginning of cinematography.

# find best movie of a decade based on score
# heavily dependent on the number of reviews
best_per_decade <- avg_rating %>%
  mutate(decade = year  %/% 10 * 10) %>%
  arrange(year, desc(wr)) %>%
  group_by(decade) %>%
  summarise(title = first(title), wr = first(wr), mean = first(mean), count = first(count))
knitr::kable(best_per_decade)

Here we can notice the disadvantage of weighted ratings - low score for old movies. That’s not necessarily caused by movies quality, rather small number of viewers.

What were the best years for a genre (based on users’ ratings)?

genres_rating <- movies_df %>%
  na.omit() %>%
  select(movieId, year, genres) %>%
  inner_join(ratings_df, by = "movieId") %>%
  select(-timestamp, -userId) %>%
  mutate(decade = year  %/% 10 * 10) %>%
  separate_rows(genres, sep = "\\|") %>%
  group_by(year, genres) %>%
  summarise(count = n(), avg_rating = mean(rating)) %>%
  ungroup() %>%
  mutate(wr = weighted_rating(mean, count, 5000, mean(mean))) %>%
  arrange(year)

genres_rating %>%
  #filter(genres %in% genres_top$genres) %>%
  filter(genres %in% c("Action", "Romance", "Sci-Fi", "Western")) %>%
  ggplot(aes(x = year, y = wr)) +
    geom_line(aes(group=genres, color=genres)) +
    geom_smooth(aes(group=genres, color=genres)) +
    facet_wrap(~genres)

It seems that most of the movie genres are actually getting better and better.

Does a movie budget affect its score?

imdb_df %>%
  #filter(budget < 1e10) %>%
  ggplot(aes(x=log(budget), y=wr)) +
    geom_point(color="blue")

# check correlation coefficient
cor(imdb_df$budget, imdb_df$wr, use = "na.or.complete")

## [1] 0.01040528

The scatterplot doesn’t show any particular pattern and the correlation coefficient is close to 0. If it’s not the money then perhaps it is the running time?

What is the optimal movie running time?

imdb_df %>%
  filter(time < 200) %>%
  ggplot(aes(x=time, y=wr)) +
    geom_point(color="blue")

Interesting. We can see a triangular shape suggesting that longer movies are less likely to get low score. The scores for short movies look pretty random.

Who is the best movie director?

Now, that we have the list of movie directors we can trace the directors whose movies get the best ratings.

best_director <- imdb_df %>%
  inner_join(movies_df, by = "movieId") %>%
  na.omit() %>%
  select(director, wr, mean) %>%
  separate_rows(director, sep = "\\|") %>%
  group_by(director) %>%
  summarise(count = n(), avg_rating = mean(mean)) %>%
  mutate(wr = weighted_rating(mean, count, 30, mean(mean))) %>%
  arrange(desc(wr), count)

knitr::kable(head(best_director, 10))

Looks like Woody Allen is on the top here. What about the best actor?

What cast is the ultimate movie cast?

best_cast <- imdb_df %>%
  inner_join(movies_df, by = "movieId") %>%
  na.omit() %>%
  select(cast, wr, mean) %>%
  separate_rows(cast, sep = "\\|") %>%
  group_by(cast) %>%
  summarise(count = n(), avg_rating = mean(mean)) %>%
  mutate(wr = weighted_rating(mean, count, 30, mean(mean))) %>%
  arrange(desc(wr), count)

knitr::kable(head(best_cast, 10))

Robert De Niro is the highest scoring actor. Perhaps he should talk to Woody Allen about making the best movie in history?