tidymodels-penguins01

ds1

tidymodels

prediction

yacsda

statlearning

num

Published

May 17, 2023

Aufgabe

Berechnen Sie ein lineares Modell mit tidymodels und zwar anhand des penguins Datensatzes.

Modellgleichung: body_mass_g ~ bill_length_mm, data = d_train.

Gesucht ist R-Quadrat als Maß für die Modellgüte im TEST-Sample.

Hinweise:

Fixieren Sie die Zufallszahlen auf den Startwert 42.
Nutzen Sie eine v=5,r=1 CV.
Entfernen Sie fehlende Werte in den Variablen.
Verzichten Sie auf weitere Schritte der Vorverarbeitung.

Lösung

Setup:

library(tidymodels)
library(tictoc)  # Rechenzeit messen, optional
# data(penguins, package = "palmerpenguins")
d_path <- "https://vincentarelbundock.github.io/Rdatasets/csv/modeldata/penguins.csv"
d <- read.csv(d_path)

Datensatz aufteilen:

set.seed(42)
d_split <- initial_split(penguins)
d_train <- training(d_split)
d_test <- testing(d_split)

Workflow:

rec1 <-
  recipe(body_mass_g ~ bill_length_mm, data = d_train) %>% 
  step_naomit(all_numeric())

lm_mod <-
  linear_reg()

wflow <-
  workflow() %>%
  add_recipe(rec1) %>%
  add_model(lm_mod)

wflow

══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: linear_reg()

── Preprocessor ────────────────────────────────────────────────────────────────
1 Recipe Step

• step_naomit()

── Model ───────────────────────────────────────────────────────────────────────
Linear Regression Model Specification (regression)

Computational engine: lm

Backen:

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

# A tibble: 6 × 2
  bill_length_mm body_mass_g
           <dbl>       <int>
1           36          3450
2           50.9        3675
3           46.1        4500
4           45.8        4150
5           48.6        5800
6           39          3650

Auf NA prüfen:

sum(is.na(d_baked))

[1] 0

CV:

set.seed(42)
folds <- vfold_cv(d_train, v = 5)
folds

#  5-fold cross-validation 
# A tibble: 5 × 2
  splits           id   
  <list>           <chr>
1 <split [206/52]> Fold1
2 <split [206/52]> Fold2
3 <split [206/52]> Fold3
4 <split [207/51]> Fold4
5 <split [207/51]> Fold5

Resampling:

penguins_resamples <-
  fit_resamples(
    wflow,
    resamples = folds
  )
penguins_resamples

# Resampling results
# 5-fold cross-validation 
# A tibble: 5 × 4
  splits           id    .metrics         .notes          
  <list>           <chr> <list>           <list>          
1 <split [206/52]> Fold1 <tibble [2 × 4]> <tibble [0 × 3]>
2 <split [206/52]> Fold2 <tibble [2 × 4]> <tibble [0 × 3]>
3 <split [206/52]> Fold3 <tibble [2 × 4]> <tibble [0 × 3]>
4 <split [207/51]> Fold4 <tibble [2 × 4]> <tibble [0 × 3]>
5 <split [207/51]> Fold5 <tibble [2 × 4]> <tibble [0 × 3]>

Last Fit:

penguins_last <- last_fit(wflow, d_split)

Modellgüte im Test-Sample:

penguins_last %>% collect_metrics()

# A tibble: 2 × 4
  .metric .estimator .estimate .config             
  <chr>   <chr>          <dbl> <chr>               
1 rmse    standard     652.    Preprocessor1_Model1
2 rsq     standard       0.385 Preprocessor1_Model1

R-Quadrat:

sol <-  collect_metrics(penguins_last)[[".estimate"]][2]
sol

[1] 0.3850608

Categories:

ds1
tidymodels
prediction
yacsda
statlearning
num