tidymodels-ames-03

ds1

tidymodels

prediction

yacsda

statlearning

num

Published

May 17, 2023

Aufgabe

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

Modellgleichung: Sale_Price ~ Gr_Liv_Area, data = ames.

Berechnen Sie ein multiplikatives (exponenzielles) Modell.

Rücktransformieren Sie die Log-Werte in “Roh-Dollar”.

Geben Sie den mittleren Vorhersagewert an als Lösung.

Hinweise:

Fixieren Sie die Zufallszahlen auf den Startwert 42.

Lösung

library(tidymodels)
data(ames)

Multiplikatives Modell:

ames <- 
  ames %>% 
  mutate(Sale_Price = log10(Sale_Price)) %>% 
  select(Sale_Price, Gr_Liv_Area)

Nicht vergessen: AV-Transformation in beiden Samples!

Datensatz aufteilen:

set.seed(42)
ames_split <- initial_split(ames, prop = 0.80, strata = Sale_Price)
ames_train <- training(ames_split)
ames_test  <-  testing(ames_split)

Modell definieren:

m1 <-
  linear_reg() # engine ist "lm" im Default

Modell fitten:

fit1 <-
  m1 %>% 
  fit(Sale_Price ~ Gr_Liv_Area, data = ames)

fit1 %>% pluck("fit")


Call:
stats::lm(formula = Sale_Price ~ Gr_Liv_Area, data = data)

Coefficients:
(Intercept)  Gr_Liv_Area  
  4.8552133    0.0002437

Modellgüte im Train-Sample:

fit1_performance <-
  fit1 %>% 
  extract_fit_engine()  # identisch zu pluck("fit")

Modellgüte im Train-Sample:

fit1_performance %>% summary()


Call:
stats::lm(formula = Sale_Price ~ Gr_Liv_Area, data = data)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.02587 -0.06577  0.01342  0.07202  0.39231 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 4.855e+00  7.355e-03  660.12   <2e-16 ***
Gr_Liv_Area 2.437e-04  4.648e-06   52.43   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.1271 on 2928 degrees of freedom
Multiple R-squared:  0.4842,    Adjusted R-squared:  0.484 
F-statistic:  2749 on 1 and 2928 DF,  p-value: < 2.2e-16

R-Quadrat via easystats:

library(easystats)
fit1_performance %>% r2()  # rmse()

# R2 for Linear Regression
       R2: 0.484
  adj. R2: 0.484

tidy(fit1_performance)  # ähnlich zu parameters()

# A tibble: 2 × 5
  term        estimate  std.error statistic p.value
  <chr>          <dbl>      <dbl>     <dbl>   <dbl>
1 (Intercept) 4.86     0.00736        660.        0
2 Gr_Liv_Area 0.000244 0.00000465      52.4       0

Vorhersagen im Test-Sample:

preds <- predict(fit1, new_data = ames_test)  # liefert TABELLE (tibble) zurück
head(preds)

# A tibble: 6 × 1
  .pred
  <dbl>
1  5.07
2  5.18
3  5.31
4  5.11
5  5.18
6  5.10

preds ist ein Tibble, also müssen wir noch die Spalte .pred. herausziehen, z.B. mit pluck(preds, ".pred"):

preds_vec <- preds$.pred

ames_test2 <-
  ames_test %>% 
  mutate(preds = pluck(preds, ".pred"),  # pluck aus der Tabelle rausziehen
         .pred = preds_vec)  # oder  mit dem Dollar-Operator

head(ames_test2)

# A tibble: 6 × 4
  Sale_Price Gr_Liv_Area preds .pred
       <dbl>       <int> <dbl> <dbl>
1       5.02         896  5.07  5.07
2       5.24        1329  5.18  5.18
3       5.60        1856  5.31  5.31
4       5.15        1056  5.11  5.11
5       5.26        1337  5.18  5.18
6       4.98         987  5.10  5.10

Oder mit unnest:

ames_test2 <-
  ames_test %>% 
  mutate(preds = preds) %>% 
  unnest(preds) # Listenspalte "entschachteln"

head(ames_test2)

# A tibble: 6 × 3
  Sale_Price Gr_Liv_Area .pred
       <dbl>       <int> <dbl>
1       5.02         896  5.07
2       5.24        1329  5.18
3       5.60        1856  5.31
4       5.15        1056  5.11
5       5.26        1337  5.18
6       4.98         987  5.10

Oder wir binden einfach die Spalte an den Tibble:

ames_test2 <-
  ames_test %>% 
  bind_cols(preds = preds)  # nimmt Tabelle und bindet die Spalten dieser Tabelle an eine Tabelle

head(ames_test2)

# A tibble: 6 × 3
  Sale_Price Gr_Liv_Area .pred
       <dbl>       <int> <dbl>
1       5.02         896  5.07
2       5.24        1329  5.18
3       5.60        1856  5.31
4       5.15        1056  5.11
5       5.26        1337  5.18
6       4.98         987  5.10

Modellgüte im Test-Sample:

rsq(ames_test2,
    truth = Sale_Price,
    estimate = .pred)

# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rsq     standard       0.517

sol <- 0.51679

Zur Interpretation von Log10-Werten

5e5

[1] 5e+05

5*10^5 - 500000

[1] 0

Rücktransformation (ohne Bias-Korrektur):

ames_test2 <-
  ames_test2 %>% 
  mutate(pred_raw = 10^(.pred))

Mittelwert der Vorhersagen:

sol <- mean(ames_test2$pred_raw)
sol

[1] 175973.8

Categories:

ds1
tidymodels
prediction
yacsda
statlearning
num