diamonds-tidymodels01

ds1

tidymodels

statlearning

string

Published

May 17, 2023

Aufgabe

Finden Sie ein möglichst “gutes” prädiktives Modell zur Vorhersage des Diamantenpreises im Datensatz diamonds!

Gegenstand dieser Aufgabe ist die Modellierung; Datenvorverarbeitug (wie explorative Datenanalyse) steht nicht im Fokus.

Hinweise:

Verwenden Sie die Methoden aus tidymodels.
Hohe Modellgüte (“gutes Modell”) sei definiert über \(R^2\), RMSE und MAE
Verwenden Sie verschiedene Algorithmen (lineare Modell, kNN, …) und verschiedene Rezepte.
Resampling und Tuning ist hier noch nicht nötig.s

Der Datensatz ist hier zu beziehen. Außerdem ist er Teil von ggplot2 bzw. des Tidyverse und daher mit data() zu laden, wenn das entsprechende Paket vorhanden ist.

Lösung

Setup

library(tidyverse)
library(tidymodels)

Daten laden:

data(diamonds, package = "ggplot2")

Oder so:

diamonds <- read_csv("https://vincentarelbundock.github.io/Rdatasets/csv/ggplot2/diamonds.csv")

Rows: 53940 Columns: 11
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (3): cut, color, clarity
dbl (8): rownames, carat, depth, table, price, x, y, z

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Train- vs. Testdaten:

d_split <- initial_split(diamonds, strata = price)

d_train <- training(d_split)
d_test <- testing(d_split)

Modelle:

lin_mod <-
  linear_reg()

knn_mod <-
  nearest_neighbor(mode = "regression")

Hilfe zu kNN findet sich z.B. hier.

Rezepte:

rec1 <-
  recipe(price ~ ., data = d_train) %>% 
  update_role(1, new_role = "id") %>% 
  step_naomit() %>% 
  step_log(all_outcomes())

Rezept prüfen (preppen und backen)

rec1_prepped <-
  rec1 %>% 
  prep()

rec1_prepped

── Recipe ──────────────────────────────────────────────────────────────────────

── Inputs

Number of variables by role

outcome:   1
predictor: 9
id:        1

── Training information

Training data contained 40453 data points and no incomplete rows.

── Operations

• Removing rows with NA values in: <none> | Trained

• Log transformation on: price | Trained

d_train_baked <-
  bake(rec1_prepped, new_data = d_train)

Einen Überblick zu steps findet sich z.B. hier.

Rollen-Definitionen in Tidymodels-Rezepten kann man hier nachlesen.

rec2 <-
  recipe(price ~ ., data = d_train) %>% 
  update_role(1, new_role = "id") %>% 
  step_impute_knn() %>% 
  step_log(all_outcomes())

Workflows:

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

wf2 <-
  wf1 %>% 
  update_model(knn_mod)

Fitting

fit1 <-
  wf1 %>% 
  fit(d_train)
fit1

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

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

• step_naomit()
• step_log()

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

Call:
stats::lm(formula = ..y ~ ., data = data)

Coefficients:
 (Intercept)         carat       cutGood      cutIdeal    cutPremium  
   -2.913222     -0.540689      0.091189      0.155213      0.108878  
cutVery Good        colorE        colorF        colorG        colorH  
    0.124711     -0.061150     -0.091230     -0.157784     -0.259018  
      colorI        colorJ     clarityIF    claritySI1    claritySI2  
   -0.386879     -0.528595      1.093164      0.607816      0.440536  
  clarityVS1    clarityVS2   clarityVVS1   clarityVVS2         depth  
    0.817124      0.751466      1.000923      0.935170      0.050243  
       table             x             y             z  
    0.009026      1.156195      0.012648      0.040728

Fitten des Test-Samples

fit1_test <-
  wf1 %>% 
  last_fit(d_split)
fit1_test

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

Modellgüte

collect_metrics(fit1_test)

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

De-logarithmieren, wenn man Vorhersagen in den Rohwerten haben möchte:

collect_predictions(fit1_test) %>% 
  head()

# A tibble: 6 × 5
  id               .pred  .row price .config             
  <chr>            <dbl> <int> <dbl> <chr>               
1 train/test split  5.81     5  5.81 Preprocessor1_Model1
2 train/test split  5.86     6  5.82 Preprocessor1_Model1
3 train/test split  5.89     8  5.82 Preprocessor1_Model1
4 train/test split  6.10     9  5.82 Preprocessor1_Model1
5 train/test split  5.85    21  5.86 Preprocessor1_Model1
6 train/test split  5.90    25  5.87 Preprocessor1_Model1

d_test_w_preds <- 
collect_predictions(fit1_test) %>% 
  mutate(pred_raw = exp(.pred)) 

head(d_test_w_preds)

# A tibble: 6 × 6
  id               .pred  .row price .config              pred_raw
  <chr>            <dbl> <int> <dbl> <chr>                   <dbl>
1 train/test split  5.81     5  5.81 Preprocessor1_Model1     334.
2 train/test split  5.86     6  5.82 Preprocessor1_Model1     352.
3 train/test split  5.89     8  5.82 Preprocessor1_Model1     360.
4 train/test split  6.10     9  5.82 Preprocessor1_Model1     447.
5 train/test split  5.85    21  5.86 Preprocessor1_Model1     346.
6 train/test split  5.90    25  5.87 Preprocessor1_Model1     364.

Categories:

ds1
tidymodels
statlearning
string