pacman::p_load(tidyverse, tidymodels, ISLR, janitor, inspectdf, GGally, kknn ) TALLER
DATOS
El conjunto de datos principales está relacionado con el registro histórico de dos años correspondiente a los años 2011 y 2012 del sistema Capital Bikeshare, Washington D.C., EE. UU., que está disponible públicamente en http://capitalbikeshare.com/system-data. Los datos fueron agregados cada dos horas y cada día y, a continuación se añadió la información meteorológica y estacional correspondiente. La información meteorológica se extrajo de http://www.freemeteo.com
url <- "https://archive.ics.uci.edu/static/public/275/bike+sharing+dataset.zip"
download.file(url, destfile = "bike_sharing_dataset.zip")
unzip("bike_sharing_dataset.zip")
datos <- read.csv("day.csv")Análisis Exploratorio de los datos
inspect_types(datos)# A tibble: 3 × 4
type cnt pcnt col_name
<chr> <int> <dbl> <named list>
1 integer 11 68.8 <chr [11]>
2 numeric 4 25 <chr [4]>
3 character 1 6.25 <chr [1]> var_cat<- inspect_cat(datos)
names(datos) [1] "instant" "dteday" "season" "yr" "mnth"
[6] "holiday" "weekday" "workingday" "weathersit" "temp"
[11] "atemp" "hum" "windspeed" "casual" "registered"
[16] "cnt" inspect_types(datos)# A tibble: 3 × 4
type cnt pcnt col_name
<chr> <int> <dbl> <named list>
1 integer 11 68.8 <chr [11]>
2 numeric 4 25 <chr [4]>
3 character 1 6.25 <chr [1]> str(datos)'data.frame': 731 obs. of 16 variables:
$ instant : int 1 2 3 4 5 6 7 8 9 10 ...
$ dteday : chr "2011-01-01" "2011-01-02" "2011-01-03" "2011-01-04" ...
$ season : int 1 1 1 1 1 1 1 1 1 1 ...
$ yr : int 0 0 0 0 0 0 0 0 0 0 ...
$ mnth : int 1 1 1 1 1 1 1 1 1 1 ...
$ holiday : int 0 0 0 0 0 0 0 0 0 0 ...
$ weekday : int 6 0 1 2 3 4 5 6 0 1 ...
$ workingday: int 0 0 1 1 1 1 1 0 0 1 ...
$ weathersit: int 2 2 1 1 1 1 2 2 1 1 ...
$ temp : num 0.344 0.363 0.196 0.2 0.227 ...
$ atemp : num 0.364 0.354 0.189 0.212 0.229 ...
$ hum : num 0.806 0.696 0.437 0.59 0.437 ...
$ windspeed : num 0.16 0.249 0.248 0.16 0.187 ...
$ casual : int 331 131 120 108 82 88 148 68 54 41 ...
$ registered: int 654 670 1229 1454 1518 1518 1362 891 768 1280 ...
$ cnt : int 985 801 1349 1562 1600 1606 1510 959 822 1321 ...ggpairs(datos[, c("atemp", "hum", "windspeed", "cnt")])
Seleccionar variables predictoras y variable a predecir
x <- c("atemp", "hum", "windspeed")
y <- "cnt"
data <- datos[, c(x,y)]Partición de datos
set.seed(100)
particion<- initial_split(datos, prop = 0.8)
dato_entre<- training(particion)
dato_test<- testing(particion)Definición Genérica del Modelo
Usaremos la función tune() para definir el hiperparámetro que vamos ajustar para el algoritmo KNN
knn_spec<- nearest_neighbor() |>
set_engine("kknn") |>
set_args(neighbors= tune()) |>
set_mode("regression")Creación de la receta
rec_spec <- recipe(cnt ~ atemp + hum + windspeed, data = data) |>
step_normalize(all_numeric_predictors())Definición del Flujo de Trabajo
cv_ft <- workflow() |>
add_recipe(rec_spec) |>
add_model(knn_spec)Definición de objeto de validación cruzada
set.seed(100)
obj_rem <- vfold_cv(dato_entre, v = 10)Creación del objeto Grilla
Se crea el objeto para busqueda del hiperparámetro
vecinos <- tibble(neighbors = seq(1, 10))Afinar el hiperparámetro
tune_res<- tune_grid(
object = cv_ft,
resamples = obj_rem,
grid = vecinos)Revisión gráfica del ajuste del hiperparámetro
autoplot(tune_res)
Visualización de los mejores valores
show_best(tune_res, metric = "rmse")# A tibble: 5 × 7
neighbors .metric .estimator mean n std_err .config
<int> <chr> <chr> <dbl> <int> <dbl> <chr>
1 10 rmse standard 1356. 10 13.9 Preprocessor1_Model10
2 9 rmse standard 1366. 10 13.1 Preprocessor1_Model09
3 8 rmse standard 1378. 10 12.6 Preprocessor1_Model08
4 7 rmse standard 1392. 10 13.0 Preprocessor1_Model07
5 6 rmse standard 1409. 10 15.0 Preprocessor1_Model06Selección del mejor hiperparámetro
mejor_hip <- select_by_one_std_err(tune_res, neighbors, metric = "rmse")
mejor_hip# A tibble: 1 × 9
neighbors .metric .estimator mean n std_err .config .best .bound
<int> <chr> <chr> <dbl> <int> <dbl> <chr> <dbl> <dbl>
1 9 rmse standard 1366. 10 13.1 Preprocessor1_M… 1356. 1370.Actualización del Flujo de Trabajo
final_ft <- finalize_workflow(cv_ft, mejor_hip)
final_ft══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: nearest_neighbor()
── Preprocessor ────────────────────────────────────────────────────────────────
1 Recipe Step
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
K-Nearest Neighbor Model Specification (regression)
Main Arguments:
neighbors = 9
Computational engine: kknn Ajustar el modelo con datos del entrenamiento
final_fit <- fit(final_ft, dato_entre)
final_fit══ Workflow [trained] ══════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: nearest_neighbor()
── Preprocessor ────────────────────────────────────────────────────────────────
1 Recipe Step
• step_normalize()
── Model ───────────────────────────────────────────────────────────────────────
Call:
kknn::train.kknn(formula = ..y ~ ., data = data, ks = min_rows(9L, data, 5))
Type of response variable: continuous
minimal mean absolute error: 1112.761
Minimal mean squared error: 1849353
Best kernel: optimal
Best k: 9Análisis del rendimiento con los datos de prueba
fit_test <- augment(final_fit, new_data = dato_test)
fit_test# A tibble: 147 × 18
.pred .resid instant dteday season yr mnth holiday weekday workingday
<dbl> <dbl> <int> <chr> <int> <int> <int> <int> <int> <int>
1 3049. -1449. 5 2011-01-05 1 0 1 0 3 1
2 1700. -700. 17 2011-01-17 1 0 1 1 1 0
3 3446. -1519. 20 2011-01-20 1 0 1 0 4 1
4 1643. -545. 29 2011-01-29 1 0 1 0 6 0
5 1757. -231. 33 2011-02-02 1 0 2 0 3 1
6 3499. -2027. 43 2011-02-12 1 0 2 0 6 0
7 5275. -2348. 49 2011-02-18 1 0 2 0 5 1
8 3248. -1436. 51 2011-02-20 1 0 2 0 0 0
9 3757. -2650. 52 2011-02-21 1 0 2 1 1 0
10 3922. -1953. 57 2011-02-26 1 0 2 0 6 0
# ℹ 137 more rows
# ℹ 8 more variables: weathersit <int>, temp <dbl>, atemp <dbl>, hum <dbl>,
# windspeed <dbl>, casual <int>, registered <int>, cnt <int>Visualización del rendimiento
fit_test |>
metrics(truth = cnt, estimate = .pred)# A tibble: 3 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 rmse standard 1313.
2 rsq standard 0.530
3 mae standard 1071. Gráfico de predicción vs. valores reales
ggplot(data = fit_test, aes(x = .pred, y = cnt)) +
geom_point() +
geom_abline(intercept = 0, slope = 1, color = "red") +
labs(x = "Predicción", y = "Valor real", title = "Predicción vs. Valores reales")