Week3A.GlobalB

Author

Caresse Cross Beard

Approach

Connect to my database in pgadmin4 and load the movies data I created. I will calculate the global baseline for a movie recommendation.

Code

library(dplyr)


Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library(DBI) 
library(RPostgres)

con <- dbConnect(
  RPostgres::Postgres(),
  dbname = "MoviesCCB",
  host = "localhost",
  port = 5432,
  user = "postgres",
  password = Sys.getenv("DB_PASSWORD")
)

ratings <- dbGetQuery(con, "
  SELECT *
  FROM ratings
")

head(ratings)

  user_id movie_id rating_value
1       1        1            5
2       1        2            4
3       1        3            3
4       1        4            5
5       1        5            4
6       2        1            4

ratings <- dbReadTable(con, "ratings")
users <- dbReadTable(con, "users")
movies <- dbReadTable(con, "movies")

dbDisconnect(con)

global_mean <- mean(ratings$rating_value, na.rm = TRUE)
global_mean

[1] 3.956522

The average movie rating was 3.58. Next, I will find each persons bias. Using the mean of the rating value and subtract the global mean.

user_bias <- ratings %>%
  group_by(user_id) %>%
  summarise(
    user_mean = mean(rating_value, na.rm = TRUE),
    user_bias = user_mean - global_mean
  )
user_bias

# A tibble: 5 × 3
  user_id user_mean user_bias
    <int>     <dbl>     <dbl>
1       1      4.2     0.243 
2       2      4       0.0435
3       3      3.8    -0.157 
4       4      3.75   -0.207 
5       5      4       0.0435

user_bias_named <- user_bias %>%
  left_join(users, by = "user_id") %>%
  select(user_name, user_mean, user_bias)
user_bias_named

# A tibble: 5 × 3
  user_name user_mean user_bias
  <chr>         <dbl>     <dbl>
1 Jennifer       4.2     0.243 
2 Charles        4       0.0435
3 Jordi          3.8    -0.157 
4 Ashley         3.75   -0.207 
5 Kevin          4       0.0435

My friend Jennifer tended to rate higher than the other friends. Then, I will check the movie rating average.

movie_bias <- ratings %>%
  group_by(movie_id) %>%
  summarise(
    movie_mean = mean(rating_value, na.rm = TRUE),
    movie_bias = movie_mean - global_mean
  )
movie_bias

# A tibble: 5 × 3
  movie_id movie_mean movie_bias
     <int>      <dbl>      <dbl>
1        1        4.2     0.243 
2        2        4       0.0435
3        3        3.8    -0.157 
4        4        4       0.0435
5        5        3.8    -0.157

movies_named <- movie_bias %>%
  left_join(movies, by = "movie_id") %>%
  select(movie_title, movie_mean, movie_bias)
movies_named

# A tibble: 5 × 3
  movie_title              movie_mean movie_bias
  <chr>                         <dbl>      <dbl>
1 Spiderman: Brand New Day        4.2     0.243 
2 Odyssey                         4       0.0435
3 Devil Wears Prada 2             3.8    -0.157 
4 The Drama                       4       0.0435
5 Project Hail Mary               3.8    -0.157

Among my friends, Spider-man: Brand New Day was generally rated higher than the others.

baseline_predictions <- ratings %>%
  select(user_id, movie_id) %>%
  distinct() %>%
  left_join(user_bias, by = "user_id") %>%
  left_join(movie_bias, by = "movie_id") %>%
  mutate(
    predicted_rating = global_mean + user_bias + movie_bias
  )
baseline_predictions

   user_id movie_id user_mean   user_bias movie_mean  movie_bias
1        1        1      4.20  0.24347826        4.2  0.24347826
2        1        2      4.20  0.24347826        4.0  0.04347826
3        1        3      4.20  0.24347826        3.8 -0.15652174
4        1        4      4.20  0.24347826        4.0  0.04347826
5        1        5      4.20  0.24347826        3.8 -0.15652174
6        2        1      4.00  0.04347826        4.2  0.24347826
7        2        3      4.00  0.04347826        3.8 -0.15652174
8        2        4      4.00  0.04347826        4.0  0.04347826
9        2        5      4.00  0.04347826        3.8 -0.15652174
10       3        1      3.80 -0.15652174        4.2  0.24347826
11       3        2      3.80 -0.15652174        4.0  0.04347826
12       3        3      3.80 -0.15652174        3.8 -0.15652174
13       3        4      3.80 -0.15652174        4.0  0.04347826
14       3        5      3.80 -0.15652174        3.8 -0.15652174
15       4        1      3.75 -0.20652174        4.2  0.24347826
16       4        2      3.75 -0.20652174        4.0  0.04347826
17       4        3      3.75 -0.20652174        3.8 -0.15652174
18       4        5      3.75 -0.20652174        3.8 -0.15652174
19       5        1      4.00  0.04347826        4.2  0.24347826
20       5        2      4.00  0.04347826        4.0  0.04347826
21       5        3      4.00  0.04347826        3.8 -0.15652174
22       5        4      4.00  0.04347826        4.0  0.04347826
23       5        5      4.00  0.04347826        3.8 -0.15652174
   predicted_rating
1          4.443478
2          4.243478
3          4.043478
4          4.243478
5          4.043478
6          4.243478
7          3.843478
8          4.043478
9          3.843478
10         4.043478
11         3.843478
12         3.643478
13         3.843478
14         3.643478
15         3.993478
16         3.793478
17         3.593478
18         3.593478
19         4.243478
20         4.043478
21         3.843478
22         4.043478
23         3.843478

baseline_predictions_named <- baseline_predictions %>%
  left_join(users, by = "user_id") %>%
  left_join(movies, by = "movie_id") %>%
  select(user_name, movie_title, predicted_rating)

baseline_predictions_named %>%
  filter(user_name == "Jennifer") %>%
  arrange(desc(predicted_rating))

  user_name              movie_title predicted_rating
1  Jennifer Spiderman: Brand New Day         4.443478
2  Jennifer                  Odyssey         4.243478
3  Jennifer                The Drama         4.243478
4  Jennifer      Devil Wears Prada 2         4.043478
5  Jennifer        Project Hail Mary         4.043478