tidymodels-penguins02

ds1

tidymodels

prediction

yacsda

statlearning

num

Published

May 17, 2023

Aufgabe

Berechnen Sie ein kNN-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.
Tunen Sie nicht.
Entfernen Sie fehlende Werte in den Variablen.
Verzichten Sie auf weitere Schritte der Vorverarbeitung.

Lösung

Setup:

library(tidymodels)
library(tidyverse)
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 auf NAs prüfen:

d2 <-
  d %>% 
  drop_na()

Datensatz aufteilen:

set.seed(42)
d_split <- initial_split(d2)
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())

knn_model <-
  nearest_neighbor(
    mode = "regression"
  ) 

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

wflow

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

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

• step_naomit()

── Model ───────────────────────────────────────────────────────────────────────
K-Nearest Neighbor Model Specification (regression)

Computational engine: kknn

Backen:

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

# A tibble: 6 × 2
  bill_length_mm body_mass_g
           <dbl>       <dbl>
1           34.5        2900
2           52.2        3450
3           45.4        4800
4           42.1        4000
5           50          5350
6           41.5        4000

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 [199/50]> Fold1
2 <split [199/50]> Fold2
3 <split [199/50]> Fold3
4 <split [199/50]> Fold4
5 <split [200/49]> Fold5

Resampling:

d_resamples <-
  fit_resamples(
    wflow,
    resamples = folds
  )

d_resamples

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

Last Fit:

fit_last <- last_fit(wflow, d_split)

Modellgüte im Test-Sample:

fit_last %>% collect_metrics()

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

R-Quadrat:

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

[1] 0.2935091

Categories:

ds1
tidymodels
prediction
yacsda
statlearning
num