tmdb03

ds1

tidymodels

statlearning

tmdb

random-forest

num

Published

May 17, 2023

Aufgabe

Wir bearbeiten hier die Fallstudie TMDB Box Office Prediction - Can you predict a movie’s worldwide box office revenue?, ein Kaggle-Prognosewettbewerb.

Ziel ist es, genaue Vorhersagen zu machen, in diesem Fall für Filme.

Die Daten können Sie von der Kaggle-Projektseite beziehen oder so:

d_train_path <- "https://raw.githubusercontent.com/sebastiansauer/Lehre/main/data/tmdb-box-office-prediction/train.csv"
d_test_path <- "https://raw.githubusercontent.com/sebastiansauer/Lehre/main/data/tmdb-box-office-prediction/test.csv"

Aufgabe

Reichen Sie bei Kaggle eine Submission für die Fallstudie ein! Berichten Sie den Score!

Hinweise:

Sie müssen sich bei Kaggle ein Konto anlegen (kostenlos und anonym möglich); alternativ können Sie sich mit einem Google-Konto anmelden.
Verwenden Sie mehrere, und zwar folgende Algorithmen: Random Forest, Boosting, lineare Regression. Tipp: Ein Workflow-Set ist hilfreich.
Logarithmieren Sie budget.
Betreiben Sie Feature Engineering, zumindest etwas. Insbesondere sollten Sie den Monat und das Jahr aus dem Datum extrahieren und als Features (Prädiktoren) nutzen.
Verwenden Sie tidymodels.
Die Zielgröße ist revenue in Dollars; nicht in “Log-Dollars”. Sie müssen also rücktransformieren, falls Sie revenue logarithmiert haben.

Lösung

Vorbereitung

library(tidyverse)
library(tidymodels)
library(tictoc)  # Rechenzeit messen
#library(Metrics)
library(lubridate)  # Datumsangaben
library(VIM)  # fehlende Werte
library(visdat)  # Datensatz visualisieren
library(lubridate)  # Datum/Uhrzeit verarbeiten
library(doParallel)  # mehrere CPUs nutzen

d_train_raw <- read_csv(d_train_path)
d_test <- read_csv(d_test_path)

Mal einen Blick werfen:

glimpse(d_train_raw)
glimpse(d_test)

Train-Set verschlanken

d_train <-
  d_train_raw %>% 
  select(popularity, runtime, revenue, budget, release_date)

Datensatz kennenlernen

library(visdat)
vis_dat(d_train)

Fehlende Werte prüfen

Welche Spalten haben viele fehlende Werte?

vis_miss(d_train)

Mit {VIM} kann man einen Datensatz gut auf fehlende Werte hin untersuchen:

aggr(d_train)

Rezept definieren

rec1 <-
  recipe(revenue ~ ., data = d_train) %>% 
  #update_role(all_predictors(), new_role = "id") %>% 
  #update_role(popularity, runtime, revenue, budget, original_language) %>% 
  #update_role(revenue, new_role = "outcome") %>% 
  step_mutate(budget = if_else(budget < 10, 10, budget)) %>% 
  step_log(budget) %>% 
  step_mutate(release_date = mdy(release_date)) %>% 
  step_date(release_date, features = c("year"), keep_original_cols = FALSE) %>% 
  step_impute_bag(all_predictors()) %>% 
  step_dummy(all_nominal())

rec1

tidy(rec1)

Check das Rezept

prep(rec1, verbose = TRUE)

d_train_baked <- 
prep(rec1) %>% 
  bake(new_data = NULL) 

d_train_baked

d_train_baked %>% 
  map_df(~ sum(is.na(.)))

Keine fehlenden Werte mehr in den Prädiktoren.

Nach fehlenden Werten könnte man z.B. auch so suchen:

datawizard::describe_distribution(d_train_baked)

So bekommt man gleich noch ein paar Infos über die Verteilung der Variablen. Praktische Sache.

Check Test-Sample

Das Test-Sample backen wir auch mal. Das hat nur den Zwecke, zu prüfen, ob unser Rezept auch richtig funktioniert. Das Preppen und Backen des Test-Samples wir automatisch von predict() bzw. last_fit() erledigt.

Wichtig: Wir preppen den Datensatz mit dem Train-Sample, auch wenn wir das Test-Sample backen wollen.

rec1_prepped <- prep(rec1)

d_test_baked <-
  bake(rec1_prepped, new_data = d_test)

d_test_baked %>% 
  head()

Kreuzvalidierung

Nur aus Zeitgründen ist hier $v=5$ eingestellt; besser wäre z.B. $v=10$ und $r=3$.

cv_scheme <- vfold_cv(d_train,
                      v = 5, 
                      repeats = 1)

Modelle

Baum

mod_tree <-
  decision_tree(cost_complexity = tune(),
                tree_depth = tune(),
                mode = "regression")

Random Forest

mod_rf <-
  rand_forest(mtry = tune(),
              min_n = tune(),
              trees = 1000,
              mode = "regression")

XGBoost

mod_boost <- boost_tree(mtry = tune(),
                        min_n = tune(),
                        trees = tune()) %>% 
  set_mode("regression")

mod_lm <-
  linear_reg()

Workflow-Set

preproc <- list(rec1 = rec1)
models <- list(tree1 = mod_tree, 
               rf1 = mod_rf, 
               boost1 = mod_boost, 
               lm1 = mod_lm)
 
all_workflows <- workflow_set(preproc, models)

Fitten und tunen

Fitten/Tunen

Wenn man das Ergebnis-Objekt abgespeichert hat, dann kann man es einfach laden, spart Rechenzeit (der Tag ist kurz):

result_obj_file <- "tmdb_model_set.rds"

(Davon ausgehend, dass die Datei im Arbeitsverzeichnis liegt.)

Dann könnte man Folgendes machen:

if (file.exists(result_obj_file)) {
  tmdb_model_set <- read_rds(result_obj_file)
} else {
  
  <computer_workflow_set_and_be_happy>
  
}

Achtung Gefährlich! Zwischenspeichern auf der Festplatte birgt die Gefahr, dass man vergisst, das Objekt auf der Festplatte zu aktualisieren und Sie noch in einem Jahr und nach 100 Updates Ihres Rezepts immer noch das uralte Objekt von der Festplatte laden …

Um Rechenzeit zu sparen, kann man das Ergebnisobjekt abspeichern, dann muss man beim nächsten Mal nicht wieder von Neuem berechnen:

#write_rds(tmdb_model_set, "objects/tmdb_model_set.rds")

Hier berechnen wir aber lieber das Modell neu:

tic()
tmdb_model_set <-
  all_workflows %>% 
  workflow_map(
    resamples = cv_scheme,
    #grid = 10,
    metrics = metric_set(rmse),
    seed = 42,  # reproducibility
    control = control_grid(verbose = FALSE))
toc()

Ohne Parallelisierung dauerte die Berechnung bei mir knapp 4 Minuten (225 Sec). Ich habe hier auf Parallelisierung verzichtet, da Tidymodels einen Fehler aufwarf mit der Begründung, dass das Paket lubridate in den parallel laufenden Instanzen nicht verfügbar sei (und der parameter pckgs = 'lubridate keine Linderung brachte).

Check:

tmdb_model_set[["result"]][[1]]

Finalisieren

Welcher Algorithmus schneidet am besten ab?

Genauer gesagt, welches Modell, denn es ist ja nicht nur ein Algorithmus, sondern ein Algorithmus plus ein Rezept plus die Parameterinstatiierung plus ein spezifischer Datensatz.

tune::autoplot(tmdb_model_set)

R-Quadrat ist nicht so entscheidend; rmse ist wichtiger.

Die Ergebnislage ist nicht ganz klar, aber einiges spricht für das Random-Forest-Modell.

tmdb_model_set %>% 
  collect_metrics() %>% 
  arrange(mean) %>% 
  slice_head(n = 10)

best_model_params <-
extract_workflow_set_result(tmdb_model_set, "rec1_rf1") %>% 
  select_best()

best_model_params

Finalisieren

best_wf <- 
all_workflows %>% 
  extract_workflow("rec1_rf1")

best_wf

best_wf_finalized <- 
  best_wf %>% 
  finalize_workflow(best_model_params)

best_wf_finalized

Final Fit

fit_final <-
  best_wf_finalized %>% 
  fit(d_train)

fit_final

d_test$revenue <- NA

final_preds <- 
  fit_final %>% 
  predict(new_data = d_test) %>% 
  bind_cols(d_test)

Submission

submission_df <-
  final_preds %>% 
  select(id, revenue = .pred)

Abspeichern und einreichen:

#write_csv(submission_df, file = "submission.csv")

Kaggle Score

Diese Submission erzielte einen Score von 4.79227 (RMSLE).

sol <- 4.79227

Categories:

ds1
tidymodels
statlearning
tmdb
random-forest
num

--- exname: tmdb03 extype: num exsolution: r sol extol: 0.2 expoints: 1 categories: - ds1 - tidymodels - statlearning - tmdb - random-forest - num date: '2023-05-17' slug: tmdb03 title: tmdb03 execute: eval: false --- ```{r global-knitr-options, include=FALSE} knitr::opts_chunk$set(fig.pos = 'H', fig.asp = 0.618, fig.width = 4, fig.cap = "", fig.path = "", echo = TRUE, message = FALSE, fig.show = "hold") ``` ```{r include-supplement, echo = FALSE} result_obj_file <- "tmdb_model_set.rds" result_obj_path <- "/Users/sebastiansaueruser/github-repos/rexams-exercises/objects/tmdb_model_set.rds" ``` # Aufgabe Wir bearbeiten hier die Fallstudie [TMDB Box Office Prediction - Can you predict a movie's worldwide box office revenue?](https://www.kaggle.com/competitions/tmdb-box-office-prediction/overview), ein [Kaggle](https://www.kaggle.com/)-Prognosewettbewerb. Ziel ist es, genaue Vorhersagen zu machen, in diesem Fall für Filme. Die Daten können Sie von der Kaggle-Projektseite beziehen oder so: ```{r} d_train_path <- "https://raw.githubusercontent.com/sebastiansauer/Lehre/main/data/tmdb-box-office-prediction/train.csv" d_test_path <- "https://raw.githubusercontent.com/sebastiansauer/Lehre/main/data/tmdb-box-office-prediction/test.csv" ``` # Aufgabe Reichen Sie bei Kaggle eine Submission für die Fallstudie ein! Berichten Sie den Score! Hinweise: - Sie müssen sich bei Kaggle ein Konto anlegen (kostenlos und anonym möglich); alternativ können Sie sich mit einem Google-Konto anmelden. - Verwenden Sie *mehrere, und zwar folgende Algorithmen*: Random Forest, Boosting, lineare Regression. Tipp: Ein Workflow-Set ist hilfreich. - Logarithmieren Sie `budget`. - Betreiben Sie Feature Engineering, zumindest etwas. Insbesondere sollten Sie den Monat und das Jahr aus dem Datum extrahieren und als Features (Prädiktoren) nutzen. - Verwenden Sie `tidymodels`. - Die Zielgröße ist `revenue` in Dollars; nicht in "Log-Dollars". Sie müssen also rücktransformieren, falls Sie `revenue` logarithmiert haben. # Lösung *Vorbereitung* ```{r} library(tidyverse) library(tidymodels) library(tictoc) # Rechenzeit messen #library(Metrics) library(lubridate) # Datumsangaben library(VIM) # fehlende Werte library(visdat) # Datensatz visualisieren library(lubridate) # Datum/Uhrzeit verarbeiten library(doParallel) # mehrere CPUs nutzen ``` ```{r import-data} d_train_raw <- read_csv(d_train_path) d_test <- read_csv(d_test_path) ``` Mal einen Blick werfen: ```{r} glimpse(d_train_raw) glimpse(d_test) ``` *Train-Set verschlanken* ```{r} d_train <- d_train_raw %>% select(popularity, runtime, revenue, budget, release_date) ``` *Datensatz kennenlernen* ```{r} library(visdat) vis_dat(d_train) ``` *Fehlende Werte prüfen* Welche Spalten haben viele fehlende Werte? ```{r} vis_miss(d_train) ``` Mit `{VIM}` kann man einen Datensatz gut auf fehlende Werte hin untersuchen: ```{r} aggr(d_train) ``` *Rezept definieren* ```{r} rec1 <- recipe(revenue ~ ., data = d_train) %>% #update_role(all_predictors(), new_role = "id") %>% #update_role(popularity, runtime, revenue, budget, original_language) %>% #update_role(revenue, new_role = "outcome") %>% step_mutate(budget = if_else(budget < 10, 10, budget)) %>% step_log(budget) %>% step_mutate(release_date = mdy(release_date)) %>% step_date(release_date, features = c("year"), keep_original_cols = FALSE) %>% step_impute_bag(all_predictors()) %>% step_dummy(all_nominal()) rec1 ``` ```{r} tidy(rec1) ``` *Check das Rezept * ```{r} prep(rec1, verbose = TRUE) ``` ```{r bakcen} d_train_baked <- prep(rec1) %>% bake(new_data = NULL) d_train_baked ``` ```{r} d_train_baked %>% map_df(~ sum(is.na(.))) ``` Keine fehlenden Werte mehr *in den Prädiktoren*. Nach fehlenden Werten könnte man z.B. auch so suchen: ```{r} datawizard::describe_distribution(d_train_baked) ``` So bekommt man gleich noch ein paar Infos über die Verteilung der Variablen. Praktische Sache. *Check Test-Sample* Das Test-Sample backen wir auch mal. Das hat *nur* den Zwecke, zu prüfen, ob unser Rezept auch richtig funktioniert. Das Preppen und Backen des Test-Samples wir *automatisch* von `predict()` bzw. `last_fit()` erledigt. Wichtig: Wir preppen den Datensatz mit dem *Train-Sample*, auch wenn wir das Test-Sample backen wollen. ```{r} rec1_prepped <- prep(rec1) d_test_baked <- bake(rec1_prepped, new_data = d_test) d_test_baked %>% head() ``` # Kreuzvalidierung Nur aus Zeitgründen ist hier $v=5$ eingestellt; besser wäre z.B. $v=10$ und $r=3$. ```{r} cv_scheme <- vfold_cv(d_train, v = 5, repeats = 1) ``` # Modelle *Baum* ```{r} mod_tree <- decision_tree(cost_complexity = tune(), tree_depth = tune(), mode = "regression") ``` *Random Forest* ```{r} mod_rf <- rand_forest(mtry = tune(), min_n = tune(), trees = 1000, mode = "regression") ``` *XGBoost* ```{r} mod_boost <- boost_tree(mtry = tune(), min_n = tune(), trees = tune()) %>% set_mode("regression") ``` *LM* ```{r} mod_lm <- linear_reg() ``` *Workflow-Set* ```{r} preproc <- list(rec1 = rec1) models <- list(tree1 = mod_tree, rf1 = mod_rf, boost1 = mod_boost, lm1 = mod_lm) all_workflows <- workflow_set(preproc, models) ``` *Fitten und tunen* # Fitten/Tunen Wenn man das Ergebnis-Objekt abgespeichert hat, dann kann man es einfach laden, spart Rechenzeit (der Tag ist kurz): ```{r eval = FALSE} result_obj_file <- "tmdb_model_set.rds" ``` (Davon ausgehend, dass die Datei im Arbeitsverzeichnis liegt.) Dann *könnte* man Folgendes machen: ```{r eval = FALSE, tmdb-model-set-load} if (file.exists(result_obj_file)) { tmdb_model_set <- read_rds(result_obj_file) } else { <computer_workflow_set_and_be_happy> } ``` *Achtung* Gefährlich! Zwischenspeichern auf der Festplatte birgt die Gefahr, dass man vergisst, das Objekt auf der Festplatte zu aktualisieren und Sie noch in einem Jahr und nach 100 Updates Ihres Rezepts immer noch das uralte Objekt von der Festplatte laden ... Um Rechenzeit zu sparen, kann man das Ergebnisobjekt abspeichern, dann muss man beim nächsten Mal nicht wieder von Neuem berechnen: ```{r eval = FALSE} #write_rds(tmdb_model_set, "objects/tmdb_model_set.rds") ``` Hier berechnen wir aber lieber das Modell neu: ```{r tmdb-model-set-compute} tic() tmdb_model_set <- all_workflows %>% workflow_map( resamples = cv_scheme, #grid = 10, metrics = metric_set(rmse), seed = 42, # reproducibility control = control_grid(verbose = FALSE)) toc() ``` Ohne Parallelisierung dauerte die Berechnung bei mir knapp 4 Minuten (225 Sec). Ich habe hier auf Parallelisierung verzichtet, da Tidymodels einen Fehler aufwarf mit der Begründung, dass das Paket `lubridate` in den parallel laufenden Instanzen nicht verfügbar sei (und der parameter `pckgs = 'lubridate` keine Linderung brachte). Check: ```{r} tmdb_model_set[["result"]][[1]] ``` *Finalisieren* **Welcher Algorithmus schneidet am besten ab?** Genauer gesagt, welches Modell, denn es ist ja nicht nur ein Algorithmus, sondern ein Algorithmus plus ein Rezept plus die Parameterinstatiierung plus ein spezifischer Datensatz. ```{r out.width = "50%"} tune::autoplot(tmdb_model_set) ``` R-Quadrat ist nicht so entscheidend; `rmse` ist wichtiger. Die Ergebnislage ist nicht ganz klar, aber einiges spricht für das Random-Forest-Modell. ```{r} tmdb_model_set %>% collect_metrics() %>% arrange(mean) %>% slice_head(n = 10) ``` ```{r} best_model_params <- extract_workflow_set_result(tmdb_model_set, "rec1_rf1") %>% select_best() best_model_params ``` *Finalisieren* ```{r} best_wf <- all_workflows %>% extract_workflow("rec1_rf1") best_wf ``` ```{r} best_wf_finalized <- best_wf %>% finalize_workflow(best_model_params) best_wf_finalized ``` *Final Fit* ```{r} fit_final <- best_wf_finalized %>% fit(d_train) fit_final ``` ```{r} d_test$revenue <- NA final_preds <- fit_final %>% predict(new_data = d_test) %>% bind_cols(d_test) ``` *Submission* ```{r} submission_df <- final_preds %>% select(id, revenue = .pred) ``` Abspeichern und einreichen: ```{r eval = FALSE} #write_csv(submission_df, file = "submission.csv") ``` *Kaggle Score* Diese Submission erzielte einen Score von **4.79227** (RMSLE). ```{r} sol <- 4.79227 ``` --- Categories: - ds1 - tidymodels - statlearning - tmdb - random-forest - num