Global Baseline Estimate

Author

Andre Thomson

Approach

I used the movie ratings from my Week 2 survey. There are six participants and six movies. Everyone rated all six movies, so there was no missing rating to estimate.

To demonstrate the Global Baseline Estimate, I held out Participant 6’s rating for The Super Mario Bros. Movie. I used the other 35 ratings to estimate that value, then compared the estimate with the original rating. The CSV stays unchanged.

Load the packages and data

This code loads the CSV and checks the columns used in the calculation.

Show the code 
library(tidyverse)
library(knitr)

# Read the ratings exported from the Week 2 database.
ratings <- read_csv(
  "movie_ratings_query.csv",
  show_col_types = FALSE
)

required_columns <- c("participant_id", "movie_title", "rating")

stopifnot(
  all(required_columns %in% names(ratings)),
  !anyNA(ratings[required_columns]),
  all(ratings$rating %in% 1:5),
  !anyDuplicated(ratings[c("participant_id", "movie_title")])
)

glimpse(ratings)
Rows: 36
Columns: 3
$ participant_id <chr> "Participant 1", "Participant 1", "Participant 1", "Par…
$ movie_title    <chr> "Puss in Boots: The Last Wish", "The Wild Robot", "Insi…
$ rating         <dbl> 5, 5, 5, 5, 3, 4, 5, 5, 3, 5, 2, 4, 3, 2, 1, 2, 5, 5, 3…

Check the ratings

I checked the number of participants, movies, ratings, and missing values before doing the calculation.

Show the code 
data_check <- ratings |>
  summarise(
    participants = n_distinct(participant_id),
    movies = n_distinct(movie_title),
    ratings = n(),
    missing_ratings = sum(is.na(rating))
  )

stopifnot(
  data_check$participants == 6,
  data_check$movies == 6,
  data_check$ratings == 36,
  data_check$missing_ratings == 0
)

kable(data_check)
participants movies ratings missing_ratings
6 6 36 0

Set aside one rating

The course spreadsheet estimates a question-mark value. My survey has no blanks, so I removed one known rating from the calculation and treated it as the value to estimate.

Show the code 
target_user <- "Participant 6"
target_movie <- "The Super Mario Bros. Movie"

held_out_rating <- ratings |>
  filter(
    participant_id == target_user,
    movie_title == target_movie
  )

stopifnot(nrow(held_out_rating) == 1)

training_ratings <- ratings |>
  filter(
    !(participant_id == target_user & movie_title == target_movie)
  )

stopifnot(
  nrow(training_ratings) == 35,
  !any(
    training_ratings$participant_id == target_user &
      training_ratings$movie_title == target_movie
  )
)

kable(held_out_rating)
participant_id movie_title rating
Participant 6 The Super Mario Bros. Movie 5

Calculate the global average

The global average is the mean of the 35 ratings used in the estimate.

Show the code 
global_average <- mean(training_ratings$rating)

tibble(
  calculation = "Global average",
  value = global_average
) |>
  kable(digits = 3)
calculation value
Global average 3.6

Calculate the participant bias

Participant bias shows whether Participant 6 usually rates above or below the global average.

Show the code 
participant_summary <- training_ratings |>
  group_by(participant_id) |>
  summarise(
    participant_average = mean(rating),
    .groups = "drop"
  ) |>
  mutate(
    participant_bias = participant_average - global_average
  )

target_participant <- participant_summary |>
  filter(participant_id == target_user)

stopifnot(nrow(target_participant) == 1)

kable(target_participant, digits = 3)
participant_id participant_average participant_bias
Participant 6 3.6 0

Calculate the movie bias

Movie bias shows whether The Super Mario Bros. Movie was rated above or below the global average by the other participants.

Show the code 
movie_summary <- training_ratings |>
  group_by(movie_title) |>
  summarise(
    movie_average = mean(rating),
    .groups = "drop"
  ) |>
  mutate(
    movie_bias = movie_average - global_average
  ) |>
  arrange(desc(movie_average))

target_movie_summary <- movie_summary |>
  filter(movie_title == target_movie)

stopifnot(nrow(target_movie_summary) == 1)

kable(target_movie_summary, digits = 3)
movie_title movie_average movie_bias
The Super Mario Bros. Movie 4.6 1

Estimate the held-out rating

I used the formula shown in the course spreadsheet:

[ = + + ]

Show the code 
baseline_estimate <- global_average +
  target_participant$participant_bias +
  target_movie_summary$movie_bias

estimate_result <- tibble(
  participant = target_user,
  movie = target_movie,
  global_average = global_average,
  participant_bias = target_participant$participant_bias,
  movie_bias = target_movie_summary$movie_bias,
  estimated_rating = baseline_estimate,
  actual_rating = held_out_rating$rating,
  absolute_error = abs(held_out_rating$rating - baseline_estimate)
)

# Expected values for this exact CSV provide a reproducibility check.
stopifnot(
  isTRUE(all.equal(global_average, 3.6)),
  isTRUE(all.equal(target_participant$participant_bias, 0)),
  isTRUE(all.equal(target_movie_summary$movie_bias, 1)),
  isTRUE(all.equal(baseline_estimate, 4.6)),
  baseline_estimate >= 1,
  baseline_estimate <= 5
)

kable(estimate_result, digits = 2)
participant movie global_average participant_bias movie_bias estimated_rating actual_rating absolute_error
Participant 6 The Super Mario Bros. Movie 3.6 0 1 4.6 5 0.4

The estimated rating is 4.60. The original rating was 5, so the absolute error is 0.40 points.

Recommendation

Show the code 
recommendation <- tibble(
  participant = target_user,
  recommended_movie = target_movie,
  estimated_rating = baseline_estimate
)

kable(recommendation, digits = 2)
participant recommended_movie estimated_rating
Participant 6 The Super Mario Bros. Movie 4.6

For this demonstration, I would recommend The Super Mario Bros. Movie to Participant 6 because its estimated rating is 4.60 out of 5.

This is a small example. The original survey has only six people, and everyone rated every movie. I created one held-out case to demonstrate the method, so this result should not be treated as evidence that the system would perform well on new users or a larger dataset.

Tools and AI assistance

I used R and Quarto to calculate the estimate and create the report. I used GitHub Copilot and ChatGPT to review the code structure, comments, file paths, and assignment requirements. I reviewed the final code and results before submission.

Conclusion

The Global Baseline Estimate combined the overall average, Participant 6’s rating pattern, and the movie’s rating pattern. The estimate was 4.60, compared with the held-out rating of 5. The difference was 0.40 points.

Sources