library(tidyverse)
library(tidymodels)
library(tictoc)
library(easystats)
library(doParallel) # mehrere CPUs nutzen
library(finetune) # Anova Race
tmdb05
Aufgabe
Melden Sie sich an für die Kaggle Competition TMDB Box Office Prediction - Can you predict a movie’s worldwide box office revenue?.
Sie benötigen dazu ein Konto; es ist auch möglich, sich mit seinem Google-Konto anzumelden.
Bei diesem Prognosewettbewerb geht es darum, vorherzusagen, wieviel Umsatz wohl einige Filme machen werden. Als Prädiktoren stehen einige Infos wie Budget, Genre, Titel etc. zur Verfügung. Eine klassische “predictive Competition” also :-) Allerdings können immer ein paar Schwierigkeiten auftreten ;-)
Aufgabe
Erstellen Sie ein Boosting-Modell mit Tidymodels!
Hinweise
- Für den Start empfehle ich, etwaige Vorverarbeitung erstmal klein zu halten. Nach dem Motto: Erstmal das Modell zum Laufen kriegen, dann erst verbessern.
- Tunen Sie die typischen Parameter.
- Reichen Sie das Modell bei Kaggle ein und berichten Sie Ihren Score.
- Im Übrigen sind Sie frei in Ihrem Vorgehen.
Lösung
Pakete starten
Daten importieren
<- "https://raw.githubusercontent.com/sebastiansauer/Lehre/main/data/tmdb-box-office-prediction/train.csv"
d_train_path <- "https://raw.githubusercontent.com/sebastiansauer/Lehre/main/data/tmdb-box-office-prediction/test.csv"
d_test_path
<- read_csv(d_train_path)
d_train <- read_csv(d_test_path) d_test
Werfen wir einen Blick in die Daten:
glimpse(d_train)
Rows: 3,000
Columns: 23
$ id <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1…
$ belongs_to_collection <chr> "[{'id': 313576, 'name': 'Hot Tub Time Machine C…
$ budget <dbl> 1.40e+07, 4.00e+07, 3.30e+06, 1.20e+06, 0.00e+00…
$ genres <chr> "[{'id': 35, 'name': 'Comedy'}]", "[{'id': 35, '…
$ homepage <chr> NA, NA, "http://sonyclassics.com/whiplash/", "ht…
$ imdb_id <chr> "tt2637294", "tt0368933", "tt2582802", "tt182148…
$ original_language <chr> "en", "en", "en", "hi", "ko", "en", "en", "en", …
$ original_title <chr> "Hot Tub Time Machine 2", "The Princess Diaries …
$ overview <chr> "When Lou, who has become the \"father of the In…
$ popularity <dbl> 6.575393, 8.248895, 64.299990, 3.174936, 1.14807…
$ poster_path <chr> "/tQtWuwvMf0hCc2QR2tkolwl7c3c.jpg", "/w9Z7A0GHEh…
$ production_companies <chr> "[{'name': 'Paramount Pictures', 'id': 4}, {'nam…
$ production_countries <chr> "[{'iso_3166_1': 'US', 'name': 'United States of…
$ release_date <chr> "2/20/15", "8/6/04", "10/10/14", "3/9/12", "2/5/…
$ runtime <dbl> 93, 113, 105, 122, 118, 83, 92, 84, 100, 91, 119…
$ spoken_languages <chr> "[{'iso_639_1': 'en', 'name': 'English'}]", "[{'…
$ status <chr> "Released", "Released", "Released", "Released", …
$ tagline <chr> "The Laws of Space and Time are About to be Viol…
$ title <chr> "Hot Tub Time Machine 2", "The Princess Diaries …
$ Keywords <chr> "[{'id': 4379, 'name': 'time travel'}, {'id': 96…
$ cast <chr> "[{'cast_id': 4, 'character': 'Lou', 'credit_id'…
$ crew <chr> "[{'credit_id': '59ac067c92514107af02c8c8', 'dep…
$ revenue <dbl> 12314651, 95149435, 13092000, 16000000, 3923970,…
glimpse(d_test)
Rows: 4,398
Columns: 22
$ id <dbl> 3001, 3002, 3003, 3004, 3005, 3006, 3007, 3008, …
$ belongs_to_collection <chr> "[{'id': 34055, 'name': 'Pokémon Collection', 'p…
$ budget <dbl> 0.00e+00, 8.80e+04, 0.00e+00, 6.80e+06, 2.00e+06…
$ genres <chr> "[{'id': 12, 'name': 'Adventure'}, {'id': 16, 'n…
$ homepage <chr> "http://www.pokemon.com/us/movies/movie-pokemon-…
$ imdb_id <chr> "tt1226251", "tt0051380", "tt0118556", "tt125595…
$ original_language <chr> "ja", "en", "en", "fr", "en", "en", "de", "en", …
$ original_title <chr> "ディアルガVSパルキアVSダークライ", "Attack of t…
$ overview <chr> "Ash and friends (this time accompanied by newco…
$ popularity <dbl> 3.851534, 3.559789, 8.085194, 8.596012, 3.217680…
$ poster_path <chr> "/tnftmLMemPLduW6MRyZE0ZUD19z.jpg", "/9MgBNBqlH1…
$ production_companies <chr> NA, "[{'name': 'Woolner Brothers Pictures Inc.',…
$ production_countries <chr> "[{'iso_3166_1': 'JP', 'name': 'Japan'}, {'iso_3…
$ release_date <chr> "7/14/07", "5/19/58", "5/23/97", "9/4/10", "2/11…
$ runtime <dbl> 90, 65, 100, 130, 92, 121, 119, 77, 120, 92, 88,…
$ spoken_languages <chr> "[{'iso_639_1': 'en', 'name': 'English'}, {'iso_…
$ status <chr> "Released", "Released", "Released", "Released", …
$ tagline <chr> "Somewhere Between Time & Space... A Legend Is B…
$ title <chr> "Pokémon: The Rise of Darkrai", "Attack of the 5…
$ Keywords <chr> "[{'id': 11451, 'name': 'pok√©mon'}, {'id': 1155…
$ cast <chr> "[{'cast_id': 3, 'character': 'Tonio', 'credit_i…
$ crew <chr> "[{'credit_id': '52fe44e7c3a368484e03d683', 'dep…
CV
<- vfold_cv(d_train) cv_scheme
Rezept 1
Begrenzen wir uns der Einfachheit halber auf folgende Prädiktoren, zumindest fürs Erste:
<-
preds_chosen c("budget", "popularity", "runtime")
<-
d_train %>%
d_train select(any_of(preds_chosen), revenue)
<-
rec1 recipe(revenue ~ ., data = d_train) %>%
#update_role(id, new_role = "id") %>%
#step_novel() %>%
step_impute_bag() %>%
step_center(all_numeric_predictors()) %>%
step_scale(all_numeric_predictors())
rec1
Boosting braucht nicht unbedingt skalierte Prädiktoren (sd=1), aber es kann helfen, zu z-transformieren.
Rezept checken
<- prep(rec1) %>% bake(new_data = NULL)
d_train_baked d_train_baked
# A tibble: 3,000 × 4
budget popularity runtime revenue
<dbl> <dbl> <dbl> <dbl>
1 -0.230 -0.156 -0.673 12314651
2 0.472 -0.0177 0.233 95149435
3 -0.519 4.61 -0.129 13092000
4 -0.576 -0.437 0.640 16000000
5 -0.609 -0.604 0.459 3923970
6 -0.392 -0.638 -1.13 3261638
7 -0.230 -0.0972 -0.718 85446075
8 -0.609 -0.538 -1.08 2586511
9 -0.609 -0.129 -0.356 34327391
10 -0.446 -0.313 -0.763 18750246
# ℹ 2,990 more rows
Viele Modelle können nicht arbeiten mit nominalen Prädiktoren oder mit fehlenden Werten. Daher sollte man im Rezept diese Fehler vorab abfangen.
Ein letzter Blick:
describe_distribution(d_train_baked)
Variable | Mean | SD | IQR | Range | Skewness | Kurtosis | n | n_Missing
--------------------------------------------------------------------------------------------------------
budget | -1.33e-18 | 1.00 | 0.78 | [-0.61, 9.65] | 3.10 | 13.23 | 3000 | 0
popularity | -6.08e-17 | 1.00 | 0.57 | [-0.70, 23.62] | 14.38 | 280.10 | 3000 | 0
runtime | 3.63e-17 | 1.00 | 1.09 | [-4.88, 10.42] | 1.02 | 8.19 | 2998 | 2
revenue | 6.67e+07 | 1.38e+08 | 6.66e+07 | [1.00, 1.52e+09] | 4.54 | 27.78 | 3000 | 0
Sieht ok aus.
Modell 1
Tipp: Mit {usemodels}
kann man sich den Code für einen Workflow (inkl. dem typischen Kladderadatsch) schon mal ausgeben lassen. Praktisch.
library(usemodels)
<-
model_boost1 boost_tree(mtry = tune(),
min_n = tune(),
learn_rate = tune(),
tree_depth = tune()) %>%
set_engine("xgboost") %>%
set_mode("regression")
Workflow 1
<-
wf1 workflow() %>%
add_model(model_boost1) %>%
add_recipe(rec1)
Tipp: Gewöhnen Sie sich ein konsistentes Schema zu Benennung Ihrer Objekte an. Z.B. Workflow-Objekte mit wf1
, wf2
etc. Fit-Objekte mit fit_boost1
, fit_rf1
, etc. Da gibt’s viele Wege, keine einzelne richtige Lösung.
Modell fitten (und tunen)
Tipp: Wenn Sie Ihr Rezept ändern, nicht vergessen, das Workflow-Objekt, wf1
in diesem Fall, neu zu berechnen. Vergisst man gerne mal…
Eine professioneller Lösung wäre ein Tool, das für Sie prüft, welche Objekte Sie aktualisieren müssen, z.B. das R-Paket {targets}
.
Schalten wir, um Zeit zu sparen, noch mehrere Rechenkerne frei.
<- parallel::detectCores(logical = FALSE)
cores cores
[1] 4
Wenn man auf mehreren Kernen gleichzeitig rechnet, braucht man natürlich auch mehr (Arbeits-)Speicher (RAM). Wenn Ihre Maschine wenig (freien) Arbeitsspeicher hat, dann kann man nicht (oder nicht sinnvoll) auf mehreren Kernen gleichzeitig arbeiten.
::registerDoParallel(4)
doParalleltic()
<-
fit_boost1 %>%
wf1 tune_race_anova(
resamples = cv_scheme,
grid = 5) # der kleine Wert ist NUR um Rechenzeit zu sparen
toc()
4.127 sec elapsed
Rechenzeit auf diesem Rechner:
Es könnte sich lohnen, das Modellobjekt abzuspeichern, da die Rechenzeit doch ganz schön lang sein kann. ABER Achtung: Sie dürfen dann nicht vergessen, das Objekt auf der Festplatte zu aktualisieren. Diese Strategie ist nicht ungefährlich: Leicht vergisst man das Aktualisieren.
Mit dem Parameter grid
kann man die Anzahl der Tuningparameter-Kandidaten festlegen, vgl. hier:
grid
A data frame of tuning combinations or a positive integer. The data frame should have columns for each parameter being tuned and rows for tuning parameter candidates. An integer denotes the number of candidate parameter sets to be created automatically.
Der Standardwert (Default) beträgt 10.
Ein Blick in die Hinweise zum Fitten, ob beim Fitten etwas Ungewöhnliches passiert ist:
".notes"]][[1]] fit_boost1[[
# A tibble: 0 × 3
# ℹ 3 variables: location <chr>, type <chr>, note <chr>
Und weiter reingezoomt, falls es Hinweise geben sollte (ist hier nicht der Fall, nur der Info halber):
".notes"]][[1]] %>% select(note) %>% slice_head(n=1) fit_boost1[[
# A tibble: 0 × 1
# ℹ 1 variable: note <chr>
Dran denken: Wenn Sie das Modell aus irgendwelchen Gründen neu fitten, müssen Sie “flussabwärts”, also danach kommenden Objekte, auch neu berechnen.
Bester Modellkandidat
<- select_best(fit_boost1) bestmodel_params
Warning: No value of `metric` was given; metric 'rmse' will be used.
<-
wf_final %>%
wf1 finalize_workflow(bestmodel_params)
wf_final
══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: boost_tree()
── Preprocessor ────────────────────────────────────────────────────────────────
3 Recipe Steps
• step_impute_bag()
• step_center()
• step_scale()
── Model ───────────────────────────────────────────────────────────────────────
Boosted Tree Model Specification (regression)
Main Arguments:
mtry = 3
min_n = 39
tree_depth = 14
learn_rate = 0.185289651636074
Computational engine: xgboost
Final fit
<-
fit_final %>%
wf_final fit(d_train)
Final Predict
<-
d_test_baked %>%
rec1 prep() %>%
bake(new_data = d_test)
%>%
d_test_baked glimpse()
Rows: 4,398
Columns: 3
$ budget <dbl> -0.60852594, -0.60614924, -0.60852594, -0.42487164, -0.5545…
$ popularity <dbl> -0.38100960, -0.40511279, -0.03123597, 0.01096644, -0.43337…
$ runtime <dbl> -0.80848591, -1.94040243, -0.35571930, 1.00258052, -0.71793…
$revenue <- NA
d_test<-
final_preds %>%
fit_final predict(d_test)
Categories:
- ds1
- tidymodels
- statlearning
- tmdb
- random-forest
- num