tmdb01

ds1

tidymodels

statlearning

tmdb

random-forest

num

Published

May 17, 2023

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 Random-Forest-Modell mit Tidymodels! Reichen Sie es bei Kaggle ein un berichten Sie den Score!

Hinweise

Verzichten Sie auf Vorverarbeitung.
Tunen Sie die typischen Parameter.
Begrenzen Sie sich auf folgende Prädiktoren.

preds_chosen <- 
  c("id", "budget", "popularity", "runtime")

Ausnahme: Log-transformieren Sie budget.
Tunen Sie die typischen Parameter.
Reichen Sie das Modell ein und berichten Sie Ihren Score.

preds_chosen <- 
  c("id", "budget", "popularity", "runtime", "status", "revenue")

Lösung

Pakete starten

library(tidyverse)
library(tidymodels)
library(tictoc)
library(doParallel)

Daten importieren

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"

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

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…

preds_chosen sind alle Prädiktoren im Datensatz, oder nicht? Das prüfen wir mal kurz:

preds_chosen %in% names(d_train) %>% 
  all()

[1] TRUE

Ja, alle Elemente von preds_chosen sind Prädiktoren im (Train-)Datensatz.

CV

Nur um Zeit zu sparen, setzen wir die Anzahl der Folds auf \(v=4\). Besser wäre z.B. \(v=10\).

cv_scheme <- vfold_cv(d_train, v = 4)

Rezept 1

rec1 <- 
  recipe(revenue ~ budget + popularity + runtime, data = d_train) %>% 
  step_impute_bag(all_predictors()) %>% 
  step_naomit(all_predictors())

Man beachte, dass noch 21 Prädiktoren angezeigt werden, da das Rezept noch nicht auf den Datensatz angewandt (“gebacken”) wurde.

tidy(rec1)

# A tibble: 2 × 6
  number operation type       trained skip  id              
   <int> <chr>     <chr>      <lgl>   <lgl> <chr>           
1      1 step      impute_bag FALSE   FALSE impute_bag_3h7s4
2      2 step      naomit     FALSE   TRUE  naomit_5oazu

Rezept checken:

prep(rec1)

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

glimpse(d_train_baked)

Rows: 3,000
Columns: 4
$ budget     <dbl> 1.40e+07, 4.00e+07, 3.30e+06, 1.20e+06, 0.00e+00, 8.00e+06,…
$ popularity <dbl> 6.575393, 8.248895, 64.299990, 3.174936, 1.148070, 0.743274…
$ runtime    <dbl> 93, 113, 105, 122, 118, 83, 92, 84, 100, 91, 119, 98, 122, …
$ revenue    <dbl> 12314651, 95149435, 13092000, 16000000, 3923970, 3261638, 8…

Fehlende Werte noch übrig?

library(easystats)
describe_distribution(d_train_baked) %>% 
  select(Variable, n_Missing)

Variable   | n_Missing
----------------------
budget     |         0
popularity |         0
runtime    |         0
revenue    |         0

Modell 1: RF

model1 <- rand_forest(mtry = tune(),
                        trees = tune(),
                        min_n = tune()) %>% 
            set_engine('ranger') %>% 
            set_mode('regression')

Workflow 1

wf1 <-
  workflow() %>% 
  add_model(model1) %>% 
  add_recipe(rec1)

Modell fitten (und tunen)

Parallele Verarbeitung starten:

cl <- makePSOCKcluster(4)  # Create 4 clusters
registerDoParallel(cl)

tic()
rf_fit1 <-
  wf1 %>% 
  tune_grid(resamples = cv_scheme)
toc()

27.47 sec elapsed

Irgendwelche Probleme oder Hinweise?

rf_fit1[[".notes"]][1]

[[1]]
# A tibble: 0 × 3
# ℹ 3 variables: location <chr>, type <chr>, note <chr>

Nein; bei mir nicht jedenfalls.

Bester Kandidat

select_best(rf_fit1)

Warning: No value of `metric` was given; metric 'rmse' will be used.

# A tibble: 1 × 4
   mtry trees min_n .config              
  <int> <int> <int> <chr>                
1     1  1851    25 Preprocessor1_Model04

Workflow finalisieren

wf_best <-
  wf1 %>% 
  finalize_workflow(parameters = select_best(rf_fit1))

Warning: No value of `metric` was given; metric 'rmse' will be used.

Final Fit

fit1_final <-
  wf_best %>% 
  fit(d_train)

fit1_final

══ Workflow [trained] ══════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: rand_forest()

── Preprocessor ────────────────────────────────────────────────────────────────
2 Recipe Steps

• step_impute_bag()
• step_naomit()

── Model ───────────────────────────────────────────────────────────────────────
Ranger result

Call:
 ranger::ranger(x = maybe_data_frame(x), y = y, mtry = min_cols(~1L,      x), num.trees = ~1851L, min.node.size = min_rows(~25L, x),      num.threads = 1, verbose = FALSE, seed = sample.int(10^5,          1)) 

Type:                             Regression 
Number of trees:                  1851 
Sample size:                      3000 
Number of independent variables:  3 
Mtry:                             1 
Target node size:                 25 
Variable importance mode:         none 
Splitrule:                        variance 
OOB prediction error (MSE):       6.709961e+15 
R squared (OOB):                  0.6452598

preds <-
  fit1_final %>% 
  predict(d_test)

Submission df

submission_df <-
  d_test %>% 
  select(id) %>% 
  bind_cols(preds) %>% 
  rename(revenue = .pred)

head(submission_df)

# A tibble: 6 × 2
     id   revenue
  <dbl>     <dbl>
1  3001  4975575.
2  3002  6349295.
3  3003 15825986.
4  3004 38573272.
5  3005  4449452.
6  3006 26780034.

Abspeichern und einreichen:

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

Kaggle Score

Diese Submission erzielte einen Score von Score: 2.76961 (RMSLE).

sol <-  2.76961

Categories:

ds1
tidymodels
statlearning
tmdb
random-forest
num