bike04

statlearning

tidymodels

num

Published

May 17, 2023

Aufgabe

Kann man die Anzahl gerade verliehener Fahrräder eines entsprechenden Anbieters anhand der Temperatur vorhersagen?

In dieser Übung untersuchen wir diese Frage.

Sie können die Daten von der Webseite der UCI herunterladen.

Wir beziehen uns auf den Datensatz day.

Berechnen Sie einen Entscheidungsbaum mit der Anzahl der aktuell vermieteten Räder als AV und der aktuellen Temperatur als UV!

Tunen Sie alle Paramter; lassen Sie sich 20 Tuningparameter vorschlagen.

Geben Sie den MSE an!

Hinweise

Lösung

library(tidymodels)
library(tidyverse)
library(tictoc)

d <- read.csv("/Users/sebastiansaueruser/datasets/Bike-Sharing-Dataset/day.csv")

glimpse(d)

Data split

set.seed(42)
d_split <- initial_split(d, strata = cnt)

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

Define recipe

rec1 <- 
  recipe(cnt ~ temp, data = d)

Define model

m1 <-
  decision_tree(cost_complexity = tune(),
                tree_depth = tune(),
                min_n = tune(),
                mode = "regression")

Tuning grid

grid <-
  grid_latin_hypercube(cost_complexity(), 
               tree_depth(),
               min_n(),
               size = 20)
grid

Alternativ:

grid <-
  grid_latin_hypercube(extract_parameter_set_dials(m1), size = 50)
grid

Define Resamples

rsmpl <- vfold_cv(d_train)

Workflow

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

Fit

tic()
fit1 <- tune_grid(
  object = wf1, 
  resamples = rsmpl)
toc()
fit1

Bester Kandidat

show_best(fit1)

wf1_best <-
  wf1 %>% 
  finalize_workflow(parameters = select_best(fit1))

Last Fit

fit_testsample <- last_fit(wf1_best, d_split)

Model performance (metrics) in test set

fit_testsample %>% collect_metrics()

MSE <- fit_testsample %>% collect_metrics() %>% pluck(3, 1)
MSE

Solution:

Categories:

statlearning
tidymodels
num

--- exname: bike04 extype: num exsolution: r fmt(sol) exshuffle: no expoints: 1 categories: - statlearning - tidymodels - num date: '2023-05-17' slug: bike04 title: bike04 execute: eval: false error: true --- ```{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") library(tidyverse) library(exams) ``` # Aufgabe Kann man die Anzahl gerade verliehener Fahrräder eines entsprechenden Anbieters anhand der Temperatur vorhersagen? In dieser Übung untersuchen wir diese Frage. Sie können die Daten von der [Webseite der UCI](https://archive.ics.uci.edu/ml/datasets/Bike+Sharing+Dataset#) herunterladen. Wir beziehen uns auf den Datensatz `day`. Berechnen Sie einen Entscheidungsbaum mit der Anzahl der aktuell vermieteten Räder als AV und der aktuellen Temperatur als UV! Tunen Sie alle Paramter; lassen Sie sich 20 Tuningparameter vorschlagen. Geben Sie den MSE an! [Hinweise](https://datenwerk.netlify.app/Hinweise.html) # Lösung ```{r} library(tidymodels) library(tidyverse) library(tictoc) ``` ```{r} d <- read.csv("/Users/sebastiansaueruser/datasets/Bike-Sharing-Dataset/day.csv") ``` ```{r} glimpse(d) ``` ## Data split ```{r} set.seed(42) d_split <- initial_split(d, strata = cnt) d_train <- training(d_split) d_test <- testing(d_split) ``` ## Define recipe ```{r} rec1 <- recipe(cnt ~ temp, data = d) ``` ## Define model ```{r} m1 <- decision_tree(cost_complexity = tune(), tree_depth = tune(), min_n = tune(), mode = "regression") ``` ## Tuning grid ```{r} grid <- grid_latin_hypercube(cost_complexity(), tree_depth(), min_n(), size = 20) grid ``` Alternativ: ```{r} grid <- grid_latin_hypercube(extract_parameter_set_dials(m1), size = 50) grid ``` ## Define Resamples ```{r} rsmpl <- vfold_cv(d_train) ``` ## Workflow ```{r} wf1 <- workflow() %>% add_model(m1) %>% add_recipe(rec1) ``` ## Fit ```{r} tic() fit1 <- tune_grid( object = wf1, resamples = rsmpl) toc() fit1 ``` ## Bester Kandidat ```{r} show_best(fit1) ``` ```{r} wf1_best <- wf1 %>% finalize_workflow(parameters = select_best(fit1)) ``` ## Last Fit ```{r} fit_testsample <- last_fit(wf1_best, d_split) ``` ## Model performance (metrics) in test set ```{r} fit_testsample %>% collect_metrics() ``` ```{r} MSE <- fit_testsample %>% collect_metrics() %>% pluck(3, 1) MSE ``` **Solution**: ```{r echo=FALSE} sol <- MSE ``` --- Categories: - statlearning - tidymodels - num