tidymodels-penguins03

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 \(K\) (Default-Tuning)
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",
    neighbors = tune()
  ) 

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)

Main Arguments:
  neighbors = tune()

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(43)
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

Tunen:

d_resamples <-
  tune_grid(
    wflow,
    resamples = folds,
    control = control_grid(save_workflow = TRUE)
  )

d_resamples

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

Bester Kandidat:

show_best(d_resamples)

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

# A tibble: 5 × 7
  neighbors .metric .estimator  mean     n std_err .config             
      <int> <chr>   <chr>      <dbl> <int>   <dbl> <chr>               
1        14 rmse    standard    664.     5    22.7 Preprocessor1_Model9
2        12 rmse    standard    671.     5    23.2 Preprocessor1_Model8
3        11 rmse    standard    675.     5    24.1 Preprocessor1_Model7
4         9 rmse    standard    685.     5    22.3 Preprocessor1_Model6
5         8 rmse    standard    688.     5    22.9 Preprocessor1_Model5

fitbest <- fit_best(d_resamples)
fitbest

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

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

• step_naomit()

── Model ───────────────────────────────────────────────────────────────────────

Call:
kknn::train.kknn(formula = ..y ~ ., data = data, ks = min_rows(14L,     data, 5))

Type of response variable: continuous
minimal mean absolute error: 526.4603
Minimal mean squared error: 416216.1
Best kernel: optimal
Best k: 14

Last Fit:

fit_last <- last_fit(fitbest, d_split)
fit_last

# Resampling results
# Manual resampling 
# A tibble: 1 × 6
  splits           id               .metrics .notes   .predictions .workflow 
  <list>           <chr>            <list>   <list>   <list>       <list>    
1 <split [249/84]> train/test split <tibble> <tibble> <tibble>     <workflow>

Modellgüte im Test-Sample:

fit_last %>% collect_metrics()

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

R-Quadrat:

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

[1] 0.38246

Categories:

ds1
tidymodels
prediction
yacsda
statlearning
num