library(tidymodels)
data(ames)tidymodels-ames-02
ds1
tidymodels
prediction
yacsda
statlearning
num
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.
Gesucht ist R-Quadrat als Maß für die Modellgüte im TEST-Sample.
Hinweise:
- Fixieren Sie die Zufallszahlen auf den Startwert 42.
Lösung
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 DefaultModell 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-16R-Quadrat via easystats:
library(easystats)
fit1_performance %>% r2() # rmse()# R2 for Linear Regression
R2: 0.484
adj. R2: 0.484tidy(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 0Vorhersagen 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.10preds ist ein Tibble, also müssen wir noch die Spalte .pred. herausziehen, z.B. mit pluck(preds, ".pred"):
preds_vec <- preds$.predames_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.10Oder 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.10Oder 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.10Modellgü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.517sol <- 0.51679Zur Interpretation von Log10-Werten
5e5[1] 5e+055*10^5 - 500000[1] 0Categories:
- ds1
- tidymodels
- prediction
- yacsda
- statlearning
- num