index.qmd

---
title: "Predicting Upcoming Board Games"
subtitle: "Predictive Models for BoardGameGeek Ratings"
author: "Phil Henrickson"
date: today
date-format: short
format: 
        html:
                code-fold: true
                code-overflow: scroll
                code-summary: 'Show the code'
                self-contained: true
                toc: true
                fig-align: center
                theme: cerulean
                message: false
                warning: false
                echo: false
editor: source
---
```{r}
#| include: false
#| echo: false
options(knitr.duplicate.label = "allow")
```

```{r}
#| include: false
library(dplyr)
library(bggUtils)
library(tidymodels)
library(vetiver)
library(gert)
library(qs)
library(quarto)
library(targets)
library(tarchetypes)

# authenticate
googleCloudStorageR::gcs_auth(json_file = Sys.getenv("GCS_AUTH_FILE"))

# set bucket
googleCloudStorageR::gcs_global_bucket("bgg_models")

# src
tar_source("src")

# load in objects
tar_load(valid_predictions)
tar_load(valid_metrics)
tar_load(details)
tar_load(hurdle_threshold)
tar_load(valid_hurdle_metrics)
tar_load(hurdle_results)

# find valid_years
valid_years = 
valid_predictions |> 
    summarize(min_year = min(yearpublished),
              max_year = max(yearpublished))
# model board
model_board = pins::board_folder("models",
                                 versioned = T)

# games
games = 
    get_games_from_gcp(
        bucket = "bgg_data"
    )

# set ggplot theme
theme_set(bggUtils::theme_bgg())
```


# Pipeline

<!-- # ```{r, results = "asis", echo = FALSE} -->
<!-- #   cat(c("```{mermaid}", targets::tar_mermaid(targets_only = T), "```"), sep = "\n") -->
<!-- # ``` -->

I use historical data from BoardGameGeek (BGG) to train a number of predictive models for boardgames. I first classify games based on their probability of achieving a minimum number of ratings on BGG. I then estimate each game's complexity (average weight) in order to predicts its number of user ratings and average rating. I then use these estimates to compute the expected Geek Rating.

The following (somewhat messy) visualization displays the status of the current pipeline used to train models and predict new games.

```{r}
#| fig-align: center
#| fig-height: 4
#| message: false
#| warning: false
targets::tar_visnetwork(targets_only =T)

```

<!-- # Models -->

```{r}
#| message: false
#| warning: false
averageweight_fit = 
    vetiver_pin_read(
        model_board,
        "bgg_averageweight_"
    )

average_fit = 
    vetiver_pin_read(
        model_board,
        "bgg_average_"
    )

usersrated_fit = 
    vetiver_pin_read(
        model_board,
        "bgg_usersrated_"
    )

hurdle_fit = 
    vetiver_pin_read(
        model_board,
        "bgg_hurdle_"
    )

```

## Assessment

How did the models perform in predicting games?

I used a training-validation approach based around the year in which games were published. I creating a training set of games published prior to **`r valid_years$min_year`** and evaluated its performance in predicting games published from **`r valid_years$min_year`** to **`r valid_years$max_year`**.

I used a training-validation approach based around the year in which games were published. I creating a training set of games published prior to **`r valid_years$min_year`** and evaluated its performance in predicting games published from **`r valid_years$min_year`** to **`r valid_years$max_year`**.

### BGG Ratings

```{r}
#| message: false
#| warning: false
valid_predictions |>
    pivot_outcomes() |>
    left_join(
        games |>
            bggUtils:::unnest_outcomes() |>
            select(game_id, usersrated),
        by = join_by(game_id)
    ) |>
    left_join(
        valid_predictions |>
            select(game_id, hurdle, .pred_hurdle_yes)
    ) |>
    mutate(hurdle = case_when(hurdle == 'yes' ~ '>25 ratings',
                              hurdle == 'no' ~ '<25 ratings')) |>
    plot_predictions(color = hurdle,
                     alpha = 0.25)+
    theme(legend.title = element_text())+
    scale_color_manual(values = c("grey60","navy"))+
    guides(colour = guide_legend(override.aes = list(alpha=1)))

```

```{r}

targets_tracking_details(metrics = valid_metrics,
                         details = details) |>
    select(model, minratings, outcome, any_of(c("rmse", "mae", "mape", "rsq", "ccc"))) |>
    filter(minratings == 25) |>
    select(minratings, everything()) |>
    gt::gt() |>
    gt::tab_options(quarto.disable_processing = T) |>
    gtExtras::gt_theme_espn()

```

### Hurdle

I first predict whether games are expected to receive enough ratings to be assigned a geek rating (25 ratings). This is a classification model which assigns a probability to a game; in order to classify games, I need to determine the appropriate threshold 

I select this threshold by examining performance across a variety of classification metrics. I select the threshold that maximizes the (F2 measure) in order to minimize false negatives, as I'm interested in using the hurdle model to filter out games that are very unlikely to receive ratings, where including a game that is worse than missing a game.

```{r}

prob_metrics = metric_set(yardstick::roc_auc,
                          yardstick::pr_auc)

prob_hurdle_metrics = valid_predictions |>
    group_by(outcome = 'hurdle') |>
    prob_metrics(truth = hurdle,
                 .pred_hurdle_yes,
                 event_level = 'second')

valid_hurdle_metrics |>
    bind_rows(prob_hurdle_metrics) |>
    gt::gt() |>
    gt::tab_options(quarto.disable_processing = T) |>
    gt::fmt_number(columns = c(".estimate"),
                   decimals = 3) |>
    gtExtras::gt_theme_espn()

```

## Features

Which features were influential for predicting each outcome?
    
```{r}
#| message: false
#| warning: false
average_plot = 
    average_fit |> 
    extract_vetiver_features() |>
    plot_model_features()+
    labs(title = 'Average Rating')

averageweight_plot = 
    averageweight_fit |> 
    extract_vetiver_features() |>
    plot_model_features()+
    labs(title = 'Average Weight')

usersrated_plot = 
    usersrated_fit |> 
    extract_vetiver_features() |>
    plot_model_features()+
    labs(title = 'Users Rated')

```

::: {.panel-tabset}

### Average Weight

```{r}
#| fig-height: 7
#| results: asis
#| echo: false

averageweight_plot

```

### Average 

```{r}
#| fig-height: 7
#| results: asis
#| echo: false
average_plot

```

### Users Rated

```{r}
#| fig-height: 7
#| results: asis
#| echo: false
usersrated_plot

```

:::

# Predictions

```{r}
#| message: false
#| warning: false
#| include: false

end_train_year = max(average_fit$metadata$user$data$yearpublished) +1

upcoming_ids = 
    games |>
    bggUtils:::unnest_info() |>
    filter(yearpublished > end_train_year) |>
    pull(game_id)

upcoming_games = 
    games |>
    filter(game_id %in% upcoming_ids) |>
    bggUtils::preprocess_bgg_games()

```

```{r}
# predict games
predictions = 
    upcoming_games |>
    impute_averageweight(
        model = averageweight_fit
    ) |>
    predict_hurdle(
        model = hurdle_fit,
        threshold = hurdle_threshold
    ) |>
    predict_bayesaverage(
        average_model = average_fit,
        usersrated_model = usersrated_fit
    )

```


## Upcoming Games

The following table displays predicted BGG outcomes for games that are expected to achieve at least 25 user ratings.

```{r}
#| echo: false

# table
predictions |>
    filter(yearpublished >= 2024) |>
    filter(.pred_hurdle_class == 'yes') |>
    select(-starts_with(".pred_hurdle")) |>
    # this goddamn bah humbug game
    filter(game_id != 388225) |>
    predictions_dt(games = games) |>
    add_colors()

```


## Hurdle

This table displays predicted probabilities for whether games will achieve enough ratings (25) to be assigned a Geek Rating.

```{r}
#| echo: false
#| message: false
#| warning: false
predictions |>
    filter(yearpublished >= 2024) |>
    filter(.pred_hurdle_class == 'yes') |>
    arrange(desc(.pred_hurdle_yes)) |>
    filter(!is.na(thumbnail)) |>
    mutate(name = make_hyperlink(make_bgg_link(game_id), 
                                 mytext = paste(name, paste0("(",yearpublished, ")")))) |>
    mutate(Image = make_image_link(thumbnail),
           Game = name,
           Description = stringr::str_trunc(description, width = 150),
           `Pr(Hurdle)` = round(.pred_hurdle_yes, 3),
           `Ratings` = usersrated,
           .keep = 'none') |>
    DT::datatable(escape=F,
                  rownames = F,
                  extensions = c('Responsive'),
                  class = list(stripe =F),
                  filter = list(position = 'top'),
                  options = list(pageLength = 15,
                                 initComplete = htmlwidgets::JS(
                                     "function(settings, json) {",
                                     paste0("$(this.api().table().container()).css({'font-size': '", '10pt', "'});"),
                                     "}"),
                                 scrollX=F,
                                 columnDefs = list(
                                     list(className = 'dt-center',
                                          visible=T,
                                          targets = c("Image", "Pr(Hurdle)", "Ratings")
                                     )
                                 )
                  )
    ) 

```