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

Backen:

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

Auf NA prüfen:

sum(is.na(d_baked))

CV:

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

Resampling:

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

Last Fit:

penguins_last <- last_fit(wflow, d_split)

Modellgüte im Test-Sample:

penguins_last %>% collect_metrics()

R-Quadrat:

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

Categories:

ds1
tidymodels
prediction
yacsda
statlearning
num

--- exname: tidymodels-penguins01 extype: num exsolution: r fmt(sol) exshuffle: no extol: 1 expoints: 1 categories: - ds1 - tidymodels - prediction - yacsda - statlearning - num date: '2023-05-17' slug: tidymodels-penguins01 title: tidymodels-penguins01 execute: cache: true eval: false --- ```{r global-knitr-options, include=FALSE} knitr::opts_chunk$set(fig.pos = 'H', fig.asp = 0.618, fig.width = 4, fig.cap = "", fig.path = "", cache = TRUE, echo = TRUE, message = FALSE, fig.show = "hold") ``` # 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: ```{r} 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: ```{r} set.seed(42) d_split <- initial_split(penguins) d_train <- training(d_split) d_test <- testing(d_split) ``` Workflow: ```{r} 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 ``` Backen: ```{r} d_baked <- prep(rec1) %>% bake(new_data = NULL) d_baked %>% head() ``` Auf NA prüfen: ```{r} sum(is.na(d_baked)) ``` CV: ```{r} set.seed(42) folds <- vfold_cv(d_train, v = 5) folds ``` Resampling: ```{r} penguins_resamples <- fit_resamples( wflow, resamples = folds ) penguins_resamples ``` Last Fit: ```{r} penguins_last <- last_fit(wflow, d_split) ``` Modellgüte im Test-Sample: ```{r} penguins_last %>% collect_metrics() ``` R-Quadrat: ```{r} sol <- collect_metrics(penguins_last)[[".estimate"]][2] sol ``` --- Categories: - ds1 - tidymodels - prediction - yacsda - statlearning - num