In previous analysis we verified that there is also strong effect of movie genre over the ratings. The residuals are obtained from the previous model:
$r_{u,i} = y_{u,i} - \hat{b}_{i} - \hat{b}_{u}$
We proceed now analyzing the data based on their rating to highlight this correlation.
It is important to note that we cannot use the rating as predictor, in case we want to fit a model, since the rating is our goal.
Our first step is to make some preprocessing on the data.
y <- train_set %>%
select(userId, movieId, rating) %>%
spread(movieId, rating) %>%
as.matrix()
rownames(y)<- y[,1]
y <- y[,-1]
colnames(y) <- with(movie_titles, title[match(colnames(y), movieId)])
The residuals are calculated by removing movies (columns) and users (rows) averages.
y <- sweep(y, 1, rowMeans(y, na.rm=TRUE))
y <- sweep(y, 2, colMeans(y, na.rm=TRUE))
The following graphic shows the correlation between two movies of the same title, in case, the movies Godfather and Godfater II. It shows that users that liked the Godfather more than the model prediction also liked the Godfather II more than the prediction.
m_1 <- "Godfather, The"
m_2 <- "Godfather: Part II, The"
qplot(y[,m_1], y[,m_2], xlab = m_1, ylab = m_2)
We can show the correlation between The Godfather and Goodfellas, movies in the same genre, gangsters. They still have some correlation.
m_1 <- "Godfather, The"
m_3 <- "Goodfellas"
qplot(y[ ,m_1], y[,m_3], xlab = m_1, ylab = m_3)
If we compare movies of another genre, like romantic comedies, you can also see a correlation between them.
m_4 <- "You've Got Mail"
m_5 <- "Sleepless in Seattle"
qplot(y[ ,m_4], y[,m_5], xlab = m_4, ylab = m_5)
Comparing these movies, the correlation between movies of the same genre are positive while movies from different genres show negative correlation, showing that users that like one group tend to not like the other group.
cor(y[, c(m_1, m_2, m_3, m_4, m_5)], use="pairwise.complete")
| Godfather, The | Godfather: Part II, The | Goodfellas | You've Got Mail | Sleepless in Seattle | |
|---|---|---|---|---|---|
| Godfather, The | 1.0000000 | 0.8598277 | 0.5162322 | -0.4061094 | -0.3938272 |
| Godfather: Part II, The | 0.8598277 | 1.0000000 | 0.6964481 | -0.3707847 | -0.3782395 |
| Goodfellas | 0.5162322 | 0.6964481 | 1.0000000 | -0.2542064 | -0.2872011 |
| You've Got Mail | -0.4061094 | -0.3707847 | -0.2542064 | 1.0000000 | 0.5793971 |
| Sleepless in Seattle | -0.3938272 | -0.3782395 | -0.2872011 | 0.5793971 | 1.0000000 |
With matrix factorization we are able to find patterns in grouped data, like groups of movies or groups of users. This technique allows us to approach a structure, by applying factor analysis.
We define factors that model the entire residuals dataset into two vectors {p} and {q}:
$r_{u,i} \approx p_{u}q_{i}$
The new model includes the residuals explained by factorization:
$Y_{u,i} = \mu + b_{i} + b_{u} + p_{u}q_{i} + \varepsilon_{u,i}$
The factors from the data can be estimated by applying single value decomposition (SVD) and principal component analysis (PCA).
Single value decomposition is a method that decomposes a matrix of data into principal components, that allows us to study the residuals variance. SVD estimates the vectors $p$ and $q$ by writing the residuals as $m$ rows and $n$ columns as:
$r_{u,i} = p_{u,1}q_{1,i} + p_{u,2}q_{2,i} + \cdots + p_{u,m}q_{m,i}$
With this it is possible to find important structure and variability in the data.
y[is.na(y)] <- 0
pca <- prcomp(y)
names(pca)
dim(pca$rotation)
dim(pca$x)
The function prcomp calculates the principal components, linear orthogonal transformation which maximizes the variability of a matrix. In this example we have 671 principal components.
The following graphic shows the variability of each principal component.
options(repr.plot.width=12, repr.plot.height=7)
plot(pca$sdev)
By plotting its cumulative sum, we can see that with just a few of principal components, we can explain a large percent of the data. With over 60 principal components we are able to explain 50% of the variability and with over 200 principal components we are able to explain about 80% of the variability out of a total of 671 principal components.
var_explained <- cumsum(pca$sdev^2/sum(pca$sdev^2))
plot(var_explained)
In order to investigate the importance of the first principal components, we can plot the first two, by labelling the points to their corresponding movies.
For this analysis we separate a small training set, only movies and users that have 50 or more ratings, and redo the fitting.
train_small <- movielens %>%
group_by(movieId) %>%
filter(n() >= 50) %>% ungroup() %>%
group_by(userId) %>%
filter(n() >= 50) %>% ungroup()
y_small <- train_small %>%
select(userId, movieId, rating) %>%
spread(movieId, rating) %>%
as.matrix()
rownames(y_small)<- y_small[,1]
y_small <- y_small[,-1]
colnames(y_small) <- with(movie_titles, title[match(colnames(y_small), movieId)])
y_small <- sweep(y_small, 1, rowMeans(y_small, na.rm=TRUE))
y_small <- sweep(y_small, 2, colMeans(y_small, na.rm=TRUE))
y_small[is.na(y_small)] <- 0
pca_small <- prcomp(y_small)
pcs <- data.frame(pca_small$rotation, name = colnames(y_small))
pcs %>% ggplot(aes(PC1, PC2)) + geom_point() +
geom_text_repel(aes(PC1, PC2, label=name),
data = filter(pcs,
PC1 < -0.1 | PC1 > 0.1 | PC2 < -0.075 | PC2 > 0.1))
By investigating the first components, we can see that the first principal component shows the difference between critically acclaimed movies on one side and Hollywood blockbusters on the other side.
pcs %>% select(name, PC1) %>% arrange(PC1) %>% slice(1:10)
| name | PC1 | |
|---|---|---|
| <chr> | <dbl> | |
| Pulp Fiction | Pulp Fiction | -0.15193338 |
| Seven (a.k.a. Se7en) | Seven (a.k.a. Se7en) | -0.13946975 |
| Fargo | Fargo | -0.13503309 |
| 2001: A Space Odyssey | 2001: A Space Odyssey | -0.12854057 |
| Taxi Driver | Taxi Driver | -0.12840530 |
| Silence of the Lambs, The | Silence of the Lambs, The | -0.11944908 |
| Clockwork Orange, A | Clockwork Orange, A | -0.11718471 |
| Being John Malkovich | Being John Malkovich | -0.11211581 |
| Godfather, The | Godfather, The | -0.09976609 |
| Shining, The | Shining, The | -0.09827393 |
pcs %>% select(name, PC1) %>% arrange(desc(PC1)) %>% slice(1:10)
| name | PC1 | |
|---|---|---|
| <chr> | <dbl> | |
| Independence Day (a.k.a. ID4) | Independence Day (a.k.a. ID4) | 0.16738870 |
| Shrek | Shrek | 0.13249690 |
| Twister | Twister | 0.12305968 |
| Titanic | Titanic | 0.12166442 |
| Armageddon | Armageddon | 0.11595145 |
| Spider-Man | Spider-Man | 0.11301894 |
| Forrest Gump | Forrest Gump | 0.10431041 |
| Harry Potter and the Sorcerer's Stone (a.k.a. Harry Potter and the Philosopher's Stone) | Harry Potter and the Sorcerer's Stone (a.k.a. Harry Potter and the Philosopher's Stone) | 0.10416240 |
| Batman Forever | Batman Forever | 0.10399732 |
| Enemy of the State | Enemy of the State | 0.09480923 |
The second principal component captures a different structure in the data. It groups on one side artsy independent films and the nerd movies on the other side.
pcs %>% select(name, PC2) %>% arrange(PC2) %>% slice(1:10)
| name | PC2 | |
|---|---|---|
| <chr> | <dbl> | |
| Little Miss Sunshine | Little Miss Sunshine | -0.07567774 |
| Truman Show, The | Truman Show, The | -0.07236028 |
| Slumdog Millionaire | Slumdog Millionaire | -0.07012892 |
| Mars Attacks! | Mars Attacks! | -0.06412999 |
| Amelie (Fabuleux destin d'Amélie Poulain, Le) | Amelie (Fabuleux destin d'Amélie Poulain, Le) | -0.06116785 |
| City of God (Cidade de Deus) | City of God (Cidade de Deus) | -0.06025946 |
| Jackie Brown | Jackie Brown | -0.05850240 |
| American Beauty | American Beauty | -0.05686564 |
| Monty Python's Life of Brian | Monty Python's Life of Brian | -0.05686078 |
| Beautiful Mind, A | Beautiful Mind, A | -0.05685260 |
pcs %>% select(name, PC2) %>% arrange(desc(PC2)) %>% slice(1:10)
| name | PC2 | |
|---|---|---|
| <chr> | <dbl> | |
| Lord of the Rings: The Two Towers, The | Lord of the Rings: The Two Towers, The | 0.3294433 |
| Lord of the Rings: The Fellowship of the Ring, The | Lord of the Rings: The Fellowship of the Ring, The | 0.3291928 |
| Matrix, The | Matrix, The | 0.2348116 |
| Lord of the Rings: The Return of the King, The | Lord of the Rings: The Return of the King, The | 0.2293528 |
| Star Wars: Episode IV - A New Hope | Star Wars: Episode IV - A New Hope | 0.2182464 |
| Star Wars: Episode VI - Return of the Jedi | Star Wars: Episode VI - Return of the Jedi | 0.1974455 |
| Star Wars: Episode V - The Empire Strikes Back | Star Wars: Episode V - The Empire Strikes Back | 0.1768390 |
| Spider-Man 2 | Spider-Man 2 | 0.1176449 |
| Dark Knight, The | Dark Knight, The | 0.1069100 |
| Speed | Speed | 0.1047370 |