First, we need to start by loading the data.
# Location of the folder with movies & ratings data
setwd("C:/Users/manon/Desktop/Machine Learning for Big Data/Project/Part 1/ml-25m")
list.files()## [1] "genome-scores.csv" "genome-tags.csv" "links.csv"
## [4] "movies.csv" "ratings.csv" "README.txt"
## [7] "tags.csv"rm(list = ls())
movieData <- fread("movies.csv",
stringsAsFactors=FALSE)
ratingData <- fread("ratings.csv")
pca <- readRDS("C:/Users/manon/Desktop/Machine Learning for Big Data/Project/Part 3/features_fromPart2.RDS")Any project starts by Inspecting, Clean and Explore the data.
# General informations
glimpse(movieData)## Rows: 62,423
## Columns: 3
## $ movieId <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,…
## $ title <chr> "Toy Story (1995)", "Jumanji (1995)", "Grumpier Old Men (1995)…
## $ genres <chr> "Adventure|Animation|Children|Comedy|Fantasy", "Adventure|Chil…glimpse(ratingData)## Rows: 25,000,095
## Columns: 4
## $ userId <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ movieId <int> 296, 306, 307, 665, 899, 1088, 1175, 1217, 1237, 1250, 1260,…
## $ rating <dbl> 5.0, 3.5, 5.0, 5.0, 3.5, 4.0, 3.5, 3.5, 5.0, 4.0, 3.5, 4.0, …
## $ timestamp <int> 1147880044, 1147868817, 1147868828, 1147878820, 1147868510, …glimpse(pca)## Rows: 2,918
## Columns: 11
## $ PC1 <dbl> 4.405565, -5.453456, 12.072521, -11.474774, -10.320106, -3.893…
## $ PC2 <dbl> -8.0978468, -6.7777428, -0.8754869, -1.3173368, -2.4163792, 2.…
## $ PC3 <dbl> -15.2302310, 5.9443722, -2.5236028, 3.3639157, 3.7201249, -1.6…
## $ PC4 <dbl> -4.0909960, -1.5250008, 4.8227333, -2.6441390, -4.4611251, 1.7…
## $ PC5 <dbl> -4.6314681, 3.1432240, -10.1164793, 0.8888057, 2.4626307, -6.2…
## $ PC6 <dbl> -11.74459909, 2.29172908, -17.93452170, 0.06926521, -0.9861108…
## $ PC7 <dbl> -3.88099042, -1.32644387, -5.56217945, 0.20706439, 0.71664837,…
## $ PC8 <dbl> 31.3827211, 22.5147910, -3.0407079, 0.3183160, -0.9909675, -0.…
## $ PC9 <dbl> -14.6718654, -7.2217313, 16.4121592, -0.9630123, 1.6145418, 1.…
## $ PC10 <dbl> 33.83429251, 15.25659315, -13.18770058, -1.67657126, -1.239857…
## $ movieId <dbl> 1, 2, 6, 7, 10, 16, 17, 18, 19, 21, 22, 25, 28, 29, 31, 32, 34…summary(movieData)## movieId title genres
## Min. : 1 Length:62423 Length:62423
## 1st Qu.: 82147 Class :character Class :character
## Median :138022 Mode :character Mode :character
## Mean :122220
## 3rd Qu.:173222
## Max. :209171summary(ratingData)## userId movieId rating timestamp
## Min. : 1 Min. : 1 Min. :0.500 Min. :7.897e+08
## 1st Qu.: 40510 1st Qu.: 1196 1st Qu.:3.000 1st Qu.:1.012e+09
## Median : 80914 Median : 2947 Median :3.500 Median :1.199e+09
## Mean : 81189 Mean : 21388 Mean :3.534 Mean :1.216e+09
## 3rd Qu.:121557 3rd Qu.: 8623 3rd Qu.:4.000 3rd Qu.:1.447e+09
## Max. :162541 Max. :209171 Max. :5.000 Max. :1.574e+09summary(pca)## PC1 PC2 PC3 PC4
## Min. :-12.926 Min. :-1099.0722 Min. :-621.0262 Min. :-355.1322
## 1st Qu.:-11.279 1st Qu.: -2.2682 1st Qu.: 0.1699 1st Qu.: -4.3200
## Median : -9.095 Median : -1.1062 Median : 3.2190 Median : -2.9464
## Mean : 0.000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: -2.785 3rd Qu.: 0.4688 3rd Qu.: 4.1297 3rd Qu.: -0.1223
## Max. :966.720 Max. : 517.1730 Max. : 244.0335 Max. : 305.5415
## PC5 PC6 PC7 PC8
## Min. :-278.7495 Min. :-148.8555 Min. :-197.595 Min. :-123.5152
## 1st Qu.: -0.6049 1st Qu.: -2.2304 1st Qu.: -1.622 1st Qu.: -2.4139
## Median : 2.3830 Median : -0.6886 Median : 1.040 Median : -0.5502
## Mean : 0.0000 Mean : 0.0000 Mean : 0.000 Mean : 0.0000
## 3rd Qu.: 3.6631 3rd Qu.: 1.1412 3rd Qu.: 2.364 3rd Qu.: 1.3372
## Max. : 177.1198 Max. : 167.1718 Max. : 240.501 Max. : 228.0468
## PC9 PC10 movieId
## Min. :-135.175 Min. :-163.0232 Min. : 1
## 1st Qu.: -1.171 1st Qu.: -2.3193 1st Qu.: 2786
## Median : 0.850 Median : -0.7239 Median : 8984
## Mean : 0.000 Mean : 0.0000 Mean : 47000
## 3rd Qu.: 2.111 3rd Qu.: 1.7803 3rd Qu.: 81556
## Max. : 215.274 Max. : 142.5005 Max. :204698cat("There are:", "\n",
length(unique(ratingData$userId)), "unique userIds in ratingData", "\n",
length(unique(ratingData$movieId)), "unique movieIds in ratingData", "\n",
length(unique(movieData$movieId)), "unique movieIds in movieData", "\n",
length(unique(movieData$title)), "unique titles in movieData")## There are:
## 162541 unique userIds in ratingData
## 59047 unique movieIds in ratingData
## 62423 unique movieIds in movieData
## 62325 unique titles in movieDataThere are different lengths of unique movieId in the movieData and ratingData. Therefore, we need to clean and remove duplicates.
# Look for any movie title duplicates
repeatMovies <- names(which(table(movieData$title) > 1))
removeRows <- integer()
# Check, remove and store all duplicates in a vector
for(i in repeatMovies){
repeatMovieLoc <- which(movieData$title == i)
tempGenre <- paste(movieData$genres[repeatMovieLoc],
collapse="|")
tempGenre <- paste(unique(unlist(strsplit(tempGenre,
split = "\\|")[[1]])),
collapse = "|")
movieData$genres[repeatMovieLoc[1]] <- tempGenre
repeatMovieIdLoc <- which(ratingData$movieId %in% movieData$movieId[repeatMovieLoc[-1]])
ratingData$movieId[repeatMovieIdLoc] <- movieData$movieId[repeatMovieLoc[1]]
removeRows <- c(removeRows,
repeatMovieLoc[-1])}
movieData$movieId[removeRows]## [1] 204982 151797 114240 198719 207249 144450 156686 181675 184893 203649
## [11] 198947 115777 191775 138656 85070 200376 199035 206674 193559 128862
## [21] 67459 171555 122940 144426 192405 144606 192243 196353 168634 194845
## [31] 144440 181655 180205 174651 143703 202599 147002 160868 180465 175857
## [41] 198507 163206 168866 118818 185925 168088 136820 65665 194570 140890
## [51] 143978 199556 124757 199346 144748 164568 192003 181751 191867 172427
## [61] 206125 181329 150310 26982 191713 164667 197425 121586 205761 200914
## [71] 180029 168358 199916 163246 160356 194652 169530 151375 154943 194078
## [81] 150776 193447 190881 190241 158763 138870 178403 206117 183459 206925
## [91] 173729 150732 144830 174449 148482 179333 64997 181385movieData <- movieData[-removeRows,]
movieData[movieData$title == repeatMovies[1],]## movieId title genres
## 1: 71057 9 (2009) Adventure|Animation|Sci-Fi|ComedymovieData[movieData$title == repeatMovies[2],]## movieId title genres
## 1: 136696 Absolution (2015) Action|Adventure|Crime|Thriller|Drama# Let's remove non useful variables to increase the speed
rm(i,
removeRows,
repeatMovieIdLoc,
repeatMovieLoc,
repeatMovies,
tempGenre)
# Take best rating if a userId rated a movie multiple times
ratingData_dt <- as.data.table(ratingData)
ratingData <- ratingData_dt[,
.(rating = max(rating)),
by = .(userId, movieId)]
uniqueN(ratingData,
by = "movieId")## [1] 58958uniqueN(movieData,
by = "movieId")## [1] 62325moviesNotInRatingData <- setdiff(unique(movieData[,
movieId]),
unique(ratingData[,
movieId]))
rm(ratingData_dt)# Check that the data is cleaned
str(movieData)## Classes 'data.table' and 'data.frame': 62325 obs. of 3 variables:
## $ movieId: int 1 2 3 4 5 6 7 8 9 10 ...
## $ title : chr "Toy Story (1995)" "Jumanji (1995)" "Grumpier Old Men (1995)" "Waiting to Exhale (1995)" ...
## $ genres : chr "Adventure|Animation|Children|Comedy|Fantasy" "Adventure|Children|Fantasy" "Comedy|Romance" "Comedy|Drama|Romance" ...
## - attr(*, ".internal.selfref")=<externalptr>summary(movieData) ## movieId title genres
## Min. : 1 Length:62325 Length:62325
## 1st Qu.: 82061 Class :character Class :character
## Median :137938 Mode :character Mode :character
## Mean :122150
## 3rd Qu.:173169
## Max. :209171head(movieData)## movieId title
## 1: 1 Toy Story (1995)
## 2: 2 Jumanji (1995)
## 3: 3 Grumpier Old Men (1995)
## 4: 4 Waiting to Exhale (1995)
## 5: 5 Father of the Bride Part II (1995)
## 6: 6 Heat (1995)
## genres
## 1: Adventure|Animation|Children|Comedy|Fantasy
## 2: Adventure|Children|Fantasy
## 3: Comedy|Romance
## 4: Comedy|Drama|Romance
## 5: Comedy
## 6: Action|Crime|Thrillersummary(ratingData) ## userId movieId rating
## Min. : 1 Min. : 1 Min. :0.500
## 1st Qu.: 40510 1st Qu.: 1196 1st Qu.:3.000
## Median : 80914 Median : 2947 Median :3.500
## Mean : 81189 Mean : 21384 Mean :3.534
## 3rd Qu.:121557 3rd Qu.: 8623 3rd Qu.:4.000
## Max. :162541 Max. :209171 Max. :5.000head(ratingData)## userId movieId rating
## 1: 1 296 5.0
## 2: 1 306 3.5
## 3: 1 307 5.0
## 4: 1 665 5.0
## 5: 1 899 3.5
## 6: 1 1088 4.0# Check that there are no more duplicates
length(movieData) == length(unique(movieData))## [1] TRUElength(ratingData) == length(unique(ratingData))## [1] TRUE# Create genre vector
genres <- c("Adventure",
"Animation",
"Children",
"Comedy",
"Fantasy",
"Romance",
"Drama",
"Action",
"Crime",
"Thriller",
"Horror",
"Mystery",
"Sci-Fi",
"IMAX",
"Documentary",
"War",
"Musical",
"Western",
"Film-Noir",
"(no genres listed)")
# Ducplicate the movieData to not impact it
movie_dummy <- movieData
# Create a loop that creates a new column and a binary variable
for (i in genres) {movie_dummy[,
paste0(i)] <- as.integer(grepl(i,
movie_dummy$genres,
fixed = TRUE))}
# Remove genres column
movie_dummy <- movie_dummy %>%
select(-genres)
# Remove any rows with missing movieId
movie_dummy <- movie_dummy[complete.cases(movie_dummy),]# Calculate average ratings
ratingData <- ratingData %>%
group_by(movieId) %>%
summarise(avg_rating = mean(rating))
# We're using inner join so we only keep the movies common to all datasets, allowing us to reduce the size of the file
joined_dataset <- movie_dummy %>%
inner_join(pca, by = "movieId") %>%
inner_join(ratingData,
by = "movieId") %>%
select(-title)# Create a binary variable 'excellent'
joined_dataset$excellent <- as.integer(joined_dataset$avg_rating > 3.75)
# We split our dataset into training and test set of respectively 80% and 20%
set.seed(123) # for reproducibility
data_split <- initial_split(joined_dataset,
prop = 0.8)
data_train <- training(data_split)
data_test <- testing(data_split)# Different models
kernel <- c("linear",
"radial",
"sigmoid")
# Penaliser coefficient
cost <- c(1, 5, 10, 100, 200)
# Create empty data frame
resume <- data.frame(kernel = character(),
cost = numeric(),
rmse = numeric(),
stringsAsFactors = FALSE)
columns = c("kernel",
"cost",
"rmse")
colnames(resume) = columns
# Create a loop to try every possible outcome
for (k in kernel) {
for (c in cost) {
svm <- svm(excellent ~ .,
data = data_train,
kernel = k,
cost = c)
predictions <- predict(svm,
newdata = data_test)
confusion_matrix <- table(data_test$excellent,
predictions)
rmse <- sqrt(mean((data_test$excellent - predictions)^2))
resume <- rbind(resume,
data.frame(kernel = k,
cost = c,
rmse = rmse))}}
# Show table
resume## kernel cost rmse
## 1 linear 1 0.3203252
## 2 linear 5 0.3203188
## 3 linear 10 0.3202594
## 4 linear 100 0.3212630
## 5 linear 200 0.3765114
## 6 radial 1 0.2538708
## 7 radial 5 0.2503479
## 8 radial 10 0.2563482
## 9 radial 100 0.2874427
## 10 radial 200 0.3109583
## 11 sigmoid 1 1.8565635
## 12 sigmoid 5 9.4852946
## 13 sigmoid 10 19.3785039
## 14 sigmoid 100 217.0570725
## 15 sigmoid 200 391.2683867From this table, we can see that we should take the model with the lowest rmse, Radial model with cost of 5 has the best rmse, meaning that this model is the most accurate at predicting the outcome variable compared to the other models with different cost parameters. Radial can capture complex nonlinear relationships compared to linear models, making it more accurate. The rmse is still a little high, so we know there is no risk of overfitting for the radial models. We notice that all sigmoid models have a really high rmse. It is known that sigmoid can be sensitive to the choice of parameters, which can lead to overfitting the data or underfitting it. It is probably what happened in our case.
# Remove the column from task 1
joined_dataset <- joined_dataset %>%
select(-excellent)
# Create a binary variable 'excellent'
joined_dataset$excellent <- as.integer(joined_dataset$avg_rating > 4)
# We split our dataset into training and test set of respectively 80% and 20%
set.seed(123) # for reproducibility
data_split_4 <- initial_split(joined_dataset,
prop = 0.8)
data_train_4 <- training(data_split_4)
data_test_4 <- testing(data_split_4)# Create empty data frame
resume_4 <- data.frame(kernel = character(),
cost = numeric(),
rmse = numeric(),
stringsAsFactors = FALSE)
colnames(resume_4) = columns
# Create a loop to try every possible outcome
for (k in kernel) {
for (c in cost) {
svm_4 <- svm(excellent ~ .,
data = data_train_4,
kernel = k,
cost = c)
predictions_4 <- predict(svm_4,
newdata = data_test_4)
confusion_matrix_4 <- table(data_test_4$excellent,
predictions_4)
rmse_4 <- sqrt(mean((data_test_4$excellent - predictions_4)^2))
resume_4 <- rbind(resume_4,
data.frame(kernel = k,
cost = c,
rmse = rmse_4))}}
# Show table
resume_4## kernel cost rmse
## 1 linear 1 0.2389090
## 2 linear 5 0.2389291
## 3 linear 10 0.2389295
## 4 linear 100 0.2415162
## 5 linear 200 0.2452912
## 6 radial 1 0.2177605
## 7 radial 5 0.2037364
## 8 radial 10 0.2017594
## 9 radial 100 0.2118804
## 10 radial 200 0.2246179
## 11 sigmoid 1 1.1727413
## 12 sigmoid 5 5.6132275
## 13 sigmoid 10 11.2783398
## 14 sigmoid 100 119.1950757
## 15 sigmoid 200 251.9456918Compared to the previous table, the best model is still radial but with a cost of 10 instead of 5. The RMSE passed from 0.2503479 to 0.2017594, which is a significant decrease; it indicates that the model’s predictions are closer to the actual values. The second model uses a higher classification threshold, meaning fewer observations are considered ‘excellent’. This could result in a smaller number of positive cases. However, it’s also important to consider possible overfitting when evaluating the performances.
# logistic regression model
glm_model <- glm(excellent ~ .,
data = data_train,
family = "binomial")
predi <- predict(glm_model, newdata = data_test, type = "response")
t <- 0.5
predi <- ifelse(predi >= t, 1, 0)
confusion_matrix_glm <- table(data_test$excellent,
predi)
rmse <- sqrt(mean((data_test$excellent - predi)^2))
confusion_matrix_glm## predi
## 0 1
## 0 420 4
## 1 2 158rmse## [1] 0.1013606We can compare our two RMSEs for the logistic regression and the one for SVM. Our best model for SVM has an RMSE of 0.2503479, whereas the LM has an RMSE of 0.1013606. This is significantly smaller, meaning the logistic regression will make fewer errors. Therefore the logistic regression model is a better model to predict if a movie will get an excellent rating.
# Remove the column from task 1
joined_dataset <- joined_dataset %>%
select(-excellent)
# We split the original dataset into training and test set of respectively 80% and 20%
set.seed(123) # for reproducibility
split_data <- initial_split(joined_dataset,
prop = 0.8)
train_data <- training(split_data)
test_data <- testing(split_data)# Create recipe
norm_obj <- recipe(avg_rating ~ .,
data = train_data) %>%
step_sqrt(avg_rating) %>%
step_center(avg_rating) %>%
step_scale(avg_rating) %>%
prep(data = train_data)
# Print the recipe object
norm_obj## Recipe
##
## Inputs:
##
## role #variables
## outcome 1
## predictor 31
##
## Training data contained 2334 data points and no missing data.
##
## Operations:
##
## Square root transformation on avg_rating [trained]
## Centering for avg_rating [trained]
## Scaling for avg_rating [trained]train_normalized <- bake(norm_obj,
train_data)# Building our Artificial Neural Network
ann_model <- keras_model_sequential() %>%
# First hidden layer
layer_dense(units = 35,
activation = "relu",
input_shape = ncol(train_normalized)) %>%
# Dropout to prevent overfitting
layer_dropout(rate = 0.2) %>%
# Second hidden layer
layer_dense(units = 16,
activation = "relu") %>%
# Dropout to prevent overfitting
layer_dropout(rate = 0.2) %>%
# Third hidden layer
layer_dense(units = 8,
activation = "relu") %>%
# Dropout to prevent overfitting
layer_dropout(rate = 0.2) %>%
# Output layer
layer_dense(units = 1,
activation = "sigmoid")
# Compile NN
ann_model %>% compile(
loss = "mean_squared_error",
optimizer = 'adam',
metrics = c("mean_absolute_error"))
# Display model architecture
ann_model## Model: "sequential"
## ________________________________________________________________________________
## Layer (type) Output Shape Param #
## ================================================================================
## dense_3 (Dense) (None, 35) 1155
## dropout_2 (Dropout) (None, 35) 0
## dense_2 (Dense) (None, 16) 576
## dropout_1 (Dropout) (None, 16) 0
## dense_1 (Dense) (None, 8) 136
## dropout (Dropout) (None, 8) 0
## dense (Dense) (None, 1) 9
## ================================================================================
## Total params: 1,876
## Trainable params: 1,876
## Non-trainable params: 0
## ________________________________________________________________________________set.seed(123) # for reproducibility
# Train model
history <- fit(
object = ann_model,
x = as.matrix(train_normalized),
y = train_normalized$avg_rating,
batch_size = 140, # How many values are taken per iterations
epochs = 100, # Number of iterations
validation_split = 0.30 #to include 30% of the data for model validation, which prevents overfitting.
)We decided to include the mean absolute error as the primary metric to compare the ANN and linear models. We notice that after 100 iterations, the mean absolute error does not evolve anymore. Additionally, the val loss is constant and under 1, which is a good sign as we are not overfitting the data.
# linear model
lm_model <- lm(avg_rating ~ .-Adventure -PC6 -PC9,
data = train_data)
summary(lm_model)##
## Call:
## lm(formula = avg_rating ~ . - Adventure - PC6 - PC9, data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.94037 -0.16831 0.03523 0.22000 0.82248
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.607e+00 2.188e-02 164.803 < 2e-16 ***
## movieId -4.243e-07 1.300e-07 -3.263 0.001120 **
## Animation 2.301e-01 3.611e-02 6.371 2.26e-10 ***
## Children -1.142e-01 3.713e-02 -3.076 0.002125 **
## Comedy -1.191e-01 1.811e-02 -6.578 5.89e-11 ***
## Fantasy -1.271e-01 2.417e-02 -5.261 1.57e-07 ***
## Romance -2.780e-02 1.953e-02 -1.423 0.154751
## Drama 1.175e-01 1.723e-02 6.821 1.15e-11 ***
## Action -1.221e-01 1.890e-02 -6.460 1.27e-10 ***
## Crime 5.126e-02 2.149e-02 2.385 0.017153 *
## Thriller -7.507e-02 1.815e-02 -4.137 3.65e-05 ***
## Horror -1.514e-01 2.446e-02 -6.190 7.10e-10 ***
## Mystery 4.858e-02 2.647e-02 1.836 0.066531 .
## `Sci-Fi` -1.191e-01 2.193e-02 -5.432 6.16e-08 ***
## IMAX -1.098e-01 3.582e-02 -3.066 0.002195 **
## Documentary 1.763e-01 5.551e-02 3.175 0.001516 **
## War 7.991e-02 3.286e-02 2.432 0.015111 *
## Musical 3.122e-02 3.998e-02 0.781 0.434976
## Western 1.095e-01 5.747e-02 1.906 0.056771 .
## `Film-Noir` 2.706e-01 6.684e-02 4.049 5.32e-05 ***
## `(no genres listed)` 8.035e-02 1.662e-01 0.484 0.628745
## PC1 2.658e-03 1.803e-04 14.744 < 2e-16 ***
## PC2 2.314e-04 2.138e-04 1.082 0.279369
## PC3 -1.404e-03 2.649e-04 -5.301 1.26e-07 ***
## PC4 2.189e-03 3.549e-04 6.167 8.17e-10 ***
## PC5 -1.359e-03 3.885e-04 -3.499 0.000477 ***
## PC7 -9.226e-04 4.541e-04 -2.032 0.042308 *
## PC8 1.761e-03 5.183e-04 3.397 0.000693 ***
## PC10 9.931e-04 5.308e-04 1.871 0.061500 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3286 on 2305 degrees of freedom
## Multiple R-squared: 0.3019, Adjusted R-squared: 0.2934
## F-statistic: 35.6 on 28 and 2305 DF, p-value: < 2.2e-16We have removed all the irrelevant variables, and the p-value is lower than 5% so that we can keep the model. We have tried using log and poly to increase the rsquared, but the changes were minimal. The artificial neural network model has a mean absolute error of 0.7475 for the validation set. On the other hand, the linear regression model has a residual standard error of 0.3286 and an adjusted R-squared of 0.2934, meaning that the model explains about 30% of the variance. Therefore the linear model will make fewer errors when predicting a movie rating.