Práctica - Random Forest
Julia R
2023-02-18
Predicción del valor medio de viviendas en California
Librerias
library(tidymodels) ## Warning: package 'tidymodels' was built under R version 4.2.1## ── Attaching packages ────────────────────────────────────── tidymodels 1.0.0 ──## ✔ broom 1.0.1 ✔ recipes 1.0.1
## ✔ dials 1.0.0 ✔ rsample 1.1.0
## ✔ dplyr 1.0.9 ✔ tibble 3.1.7
## ✔ ggplot2 3.3.6 ✔ tidyr 1.2.0
## ✔ infer 1.0.3 ✔ tune 1.0.1
## ✔ modeldata 1.0.1 ✔ workflows 1.1.0
## ✔ parsnip 1.0.2 ✔ workflowsets 1.0.0
## ✔ purrr 0.3.4 ✔ yardstick 1.1.0## Warning: package 'broom' was built under R version 4.2.1## Warning: package 'dials' was built under R version 4.2.1## Warning: package 'infer' was built under R version 4.2.1## Warning: package 'modeldata' was built under R version 4.2.1## Warning: package 'parsnip' was built under R version 4.2.1## Warning: package 'recipes' was built under R version 4.2.1## Warning: package 'rsample' was built under R version 4.2.1## Warning: package 'tune' was built under R version 4.2.2## Warning: package 'workflows' was built under R version 4.2.1## Warning: package 'workflowsets' was built under R version 4.2.1## Warning: package 'yardstick' was built under R version 4.2.1## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ recipes::step() masks stats::step()
## • Use suppressPackageStartupMessages() to eliminate package startup messageslibrary(tidyverse) ## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──## ✔ readr 2.1.2 ✔ forcats 0.5.1
## ✔ stringr 1.4.0## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ stringr::fixed() masks recipes::fixed()
## ✖ dplyr::lag() masks stats::lag()
## ✖ readr::spec() masks yardstick::spec()library(magrittr) ##
## Attaching package: 'magrittr'## The following object is masked from 'package:tidyr':
##
## extract## The following object is masked from 'package:purrr':
##
## set_nameslibrary(corrr) ## Warning: package 'corrr' was built under R version 4.2.2library(ranger)## Warning: package 'ranger' was built under R version 4.2.2library(ggplot2)Dataset
Se utilizó la configuración scipen=999 para visualizar números en vez de la notación científica, y Digits=2 para redondear redondear los decimales a dos.
options(scipen=999)
options(digits=2)
houses <- read_csv("https://raw.githubusercontent.com/data-datum/datasets/main/california_houses.csv" )## Rows: 20640 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (14): Median_House_Value, Median_Income, Median_Age, Tot_Rooms, Tot_Bedr...
##
## ℹ 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.1)
Exploración de datos
Visualización del dataset
head(houses)## # A tibble: 6 × 14
## Median_House_Value Median_Income Median_Age Tot_Rooms Tot_Bedrooms Population
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 452600 8.33 41 880 129 322
## 2 358500 8.30 21 7099 1106 2401
## 3 352100 7.26 52 1467 190 496
## 4 341300 5.64 52 1274 235 558
## 5 342200 3.85 52 1627 280 565
## 6 269700 4.04 52 919 213 413
## # … with 8 more variables: Households <dbl>, Latitude <dbl>, Longitude <dbl>,
## # Distance_to_coast <dbl>, Distance_to_LA <dbl>, Distance_to_SanDiego <dbl>,
## # Distance_to_SanJose <dbl>, Distance_to_SanFrancisco <dbl>Información sobre las variables
Se trata de un dataset de variables continuas, de tipo numérico por lo tanto el modelo utilizado será un modelo de regresión logística.
Variables predictoras:
-Valor medio de la vivienda: (Median house value)valor medio de la vivienda para los hogares dentro de un bloque (medido en dólares estadounidenses) [$]
-Ingresos medios: (Median Income) ingresos medios de los hogares dentro de una cuadra de casas (mdidos en decenas de miles de dólares estadounidenses) [10k $]
-Edad promedio:(Median Age) Edad promedio de una casa dentro de una cuadra; un número menor es un edificio más nuevo [años]
-Total de habitaciones:(Total Rooms) número total de habitaciones dentro de un barrio
-Total de dormitorios: (Total Bedrooms)número total de dormitorios dentro de un barrio
-Población:(Population) Número total de personas que residen dentro de una cuadra.
-Hogares: (Households) número total de hogares, un grupo de personas que residen dentro de una unidad de hogar, para un barrio.
-Latitud
-Longitud
-Distancia a la costa: Distancia al punto de la costa más cercano [m]
-Distancia a Los Ángeles: Distancia al centro de Los Ángeles [m]
-Distancia a San Diego: Distancia al centro de San Diego [m]
-Distancia a San José: Distancia al centro de San José [m]
-Distancia a San Francisco: Distancia al centro de San Francisco [m]
Análisis de los dato
cor(houses)## Median_House_Value Median_Income Median_Age Tot_Rooms
## Median_House_Value 1.000 0.6881 0.106 0.1342
## Median_Income 0.688 1.0000 -0.119 0.1980
## Median_Age 0.106 -0.1190 1.000 -0.3613
## Tot_Rooms 0.134 0.1980 -0.361 1.0000
## Tot_Bedrooms 0.051 -0.0081 -0.320 0.9299
## Population -0.025 0.0048 -0.296 0.8571
## Households 0.066 0.0130 -0.303 0.9185
## Latitude -0.144 -0.0798 0.011 -0.0361
## Longitude -0.046 -0.0152 -0.108 0.0446
## Distance_to_coast -0.469 -0.2434 -0.227 -0.0015
## Distance_to_LA -0.131 -0.0654 -0.031 -0.0198
## Distance_to_SanDiego -0.093 -0.0553 0.036 -0.0389
## Distance_to_SanJose -0.042 -0.0368 -0.090 0.0319
## Distance_to_SanFrancisco -0.031 -0.0224 -0.101 0.0329
## Tot_Bedrooms Population Households Latitude Longitude
## Median_House_Value 0.0506 -0.0246 0.066 -0.144 -0.0460
## Median_Income -0.0081 0.0048 0.013 -0.080 -0.0152
## Median_Age -0.3205 -0.2962 -0.303 0.011 -0.1082
## Tot_Rooms 0.9299 0.8571 0.918 -0.036 0.0446
## Tot_Bedrooms 1.0000 0.8780 0.980 -0.066 0.0684
## Population 0.8780 1.0000 0.907 -0.109 0.0998
## Households 0.9798 0.9072 1.000 -0.071 0.0553
## Latitude -0.0663 -0.1088 -0.071 1.000 -0.9247
## Longitude 0.0684 0.0998 0.055 -0.925 1.0000
## Distance_to_coast -0.0223 -0.0403 -0.062 0.304 0.0079
## Distance_to_LA -0.0558 -0.1104 -0.062 0.942 -0.8920
## Distance_to_SanDiego -0.0676 -0.1097 -0.069 0.992 -0.9583
## Distance_to_SanJose 0.0597 0.0791 0.048 -0.855 0.9240
## Distance_to_SanFrancisco 0.0602 0.0886 0.050 -0.897 0.9549
## Distance_to_coast Distance_to_LA Distance_to_SanDiego
## Median_House_Value -0.4694 -0.131 -0.093
## Median_Income -0.2434 -0.065 -0.055
## Median_Age -0.2266 -0.031 0.036
## Tot_Rooms -0.0015 -0.020 -0.039
## Tot_Bedrooms -0.0223 -0.056 -0.068
## Population -0.0403 -0.110 -0.110
## Households -0.0620 -0.062 -0.069
## Latitude 0.3036 0.942 0.992
## Longitude 0.0079 -0.892 -0.958
## Distance_to_coast 1.0000 0.198 0.215
## Distance_to_LA 0.1977 1.000 0.951
## Distance_to_SanDiego 0.2145 0.951 1.000
## Distance_to_SanJose -0.0775 -0.794 -0.888
## Distance_to_SanFrancisco -0.0682 -0.849 -0.928
## Distance_to_SanJose Distance_to_SanFrancisco
## Median_House_Value -0.042 -0.031
## Median_Income -0.037 -0.022
## Median_Age -0.090 -0.101
## Tot_Rooms 0.032 0.033
## Tot_Bedrooms 0.060 0.060
## Population 0.079 0.089
## Households 0.048 0.050
## Latitude -0.855 -0.897
## Longitude 0.924 0.955
## Distance_to_coast -0.078 -0.068
## Distance_to_LA -0.794 -0.849
## Distance_to_SanDiego -0.888 -0.928
## Distance_to_SanJose 1.000 0.990
## Distance_to_SanFrancisco 0.990 1.000Las variables predictoras que considero más importantes son:
Median_Income
Distance_to_coast
Latitude
Distance_to_LA
Tot_Rooms
Median_Age
p1 <-houses %>%
ggplot(aes(Median_House_Value , Median_Income)) +
geom_point(alpha = 0.5, color = "darkgreen") +
labs(title="Ingreso Medio",
x="Valor Medio de la vivienda",
y="Ingreso Medio")+
theme_minimal()
p2 <-houses %>%
ggplot(aes(Median_House_Value , Median_Age )) +
geom_point(alpha = 0.5, color = "darkgreen") +
labs(title="Edad del Inmueble",
x="Valor Medio de la vivienda",
y="Edad del Inmueble")+
theme_minimal()
p3 <-houses %>%
ggplot(aes(Median_House_Value , Latitude )) +
geom_point(alpha = 0.5, color = "darkgreen") +
labs(title="Latitud",
x="Valor Medio de la vivienda",
y="Población")+
theme_minimal()
p4 <-houses %>%
ggplot(aes(Median_House_Value , Distance_to_coast)) +
geom_point(alpha = 0.5, color = "darkgreen") +
labs(title="Distancia a la costa",
x="Valor Medio de la vivienda",
y="Distancia a la costa")+
theme_minimal()
p5 <-houses %>%
ggplot(aes(Median_House_Value , Tot_Rooms)) +
geom_point(alpha = 0.5, color = "darkgreen") +
labs(title="Distancia a la costa",
x="Valor Medio de la vivienda",
y="Distancia a la costa")+
theme_minimal()
p6 <-houses %>%
ggplot(aes(Median_House_Value , Distance_to_LA)) +
geom_point(alpha = 0.5, color = "darkgreen") +
labs(title="Distancia a los Angeles",
x="Valor Medio de la vivienda",
y="Distancia a la Los Angeles")+
theme_minimal()
library("gridExtra")## Warning: package 'gridExtra' was built under R version 4.2.2##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combinegrid.arrange(p1,p2,p3,p4,p5)
2)
División del dataset (método holdout)
Validación Cruzada
set.seed(33)
p_split <- houses %>%
initial_split(prop=0.75)
p_train <- training(p_split)
p_test <- testing(p_split)
p_split## <Training/Testing/Total>
## <15480/5160/20640>head(p_train)## # A tibble: 6 × 14
## Median_House_Value Median_Income Median_Age Tot_Rooms Tot_Bedrooms Population
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 101200 2.96 17 3502 655 1763
## 2 350000 6.37 6 3023 518 1225
## 3 223900 3.37 31 3205 727 1647
## 4 85600 3.12 52 889 162 273
## 5 366000 4.36 14 1472 291 876
## 6 132700 5.31 25 2185 370 1558
## # … with 8 more variables: Households <dbl>, Latitude <dbl>, Longitude <dbl>,
## # Distance_to_coast <dbl>, Distance_to_LA <dbl>, Distance_to_SanDiego <dbl>,
## # Distance_to_SanJose <dbl>, Distance_to_SanFrancisco <dbl>head(p_test)## # A tibble: 6 × 14
## Median_House_Value Median_Income Median_Age Tot_Rooms Tot_Bedrooms Population
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 341300 5.64 52 1274 235 558
## 2 269700 4.04 52 919 213 413
## 3 213500 3.08 52 2491 474 1098
## 4 159800 1.71 42 1639 367 929
## 5 99700 2.18 52 1688 337 853
## 6 132600 2.6 52 2224 437 1006
## # … with 8 more variables: Households <dbl>, Latitude <dbl>, Longitude <dbl>,
## # Distance_to_coast <dbl>, Distance_to_LA <dbl>, Distance_to_SanDiego <dbl>,
## # Distance_to_SanJose <dbl>, Distance_to_SanFrancisco <dbl>Folds para la validación cruzada:
p_folds <- vfold_cv(p_train, v=2, repeats = 2)
p_folds$splits## [[1]]
## <Analysis/Assess/Total>
## <7740/7740/15480>
##
## [[2]]
## <Analysis/Assess/Total>
## <7740/7740/15480>
##
## [[3]]
## <Analysis/Assess/Total>
## <7740/7740/15480>
##
## [[4]]
## <Analysis/Assess/Total>
## <7740/7740/15480>Preprocesamiento - Receta
La variable a predecir es: Median_House_Value
recipe_rf <- p_train %>%
recipe(Median_House_Value~.) %>%
step_corr(all_predictors()) %>%
step_center(all_predictors(), -all_outcomes()) %>%
step_scale(all_predictors(), -all_outcomes()) %>%
prep()
recipe_rf## Recipe
##
## Inputs:
##
## role #variables
## outcome 1
## predictor 13
##
## Training data contained 15480 data points and no missing data.
##
## Operations:
##
## Correlation filter on Tot_Bedrooms, Households, Distance_to_San... [trained]
## Centering for Median_Income, Median_Age, Tot_Rooms, Distance_... [trained]
## Scaling for Median_Income, Median_Age, Tot_Rooms, Distance_... [trained]Modelo ML: Random Forest
set.seed(33)
rf_spec <- rand_forest() %>%
set_engine("ranger") %>%
set_mode("regression")
rf_spec## Random Forest Model Specification (regression)
##
## Computational engine: rangerTraining
Workflow
rf_wf <- workflow() %>%
add_recipe(recipe_rf) %>%
add_model(rf_spec)
rf_wf## ══ Workflow ════════════════════════════════════════════════════════════════════
## Preprocessor: Recipe
## Model: rand_forest()
##
## ── Preprocessor ────────────────────────────────────────────────────────────────
## 3 Recipe Steps
##
## • step_corr()
## • step_center()
## • step_scale()
##
## ── Model ───────────────────────────────────────────────────────────────────────
## Random Forest Model Specification (regression)
##
## Computational engine: rangerTraining con validación cruzada
set.seed(33)
rf_res <- rf_wf %>%
fit_resamples(
p_folds,
control = control_resamples(save_pred = TRUE),
metrics = metric_set(mae, rmse))
rf_res## # Resampling results
## # 2-fold cross-validation repeated 2 times
## # A tibble: 4 × 6
## splits id id2 .metrics .notes .predictions
## <list> <chr> <chr> <list> <list> <list>
## 1 <split [7740/7740]> Repeat1 Fold1 <tibble [2 × 4]> <tibble> <tibble>
## 2 <split [7740/7740]> Repeat1 Fold2 <tibble [2 × 4]> <tibble> <tibble>
## 3 <split [7740/7740]> Repeat2 Fold1 <tibble [2 × 4]> <tibble> <tibble>
## 4 <split [7740/7740]> Repeat2 Fold2 <tibble [2 × 4]> <tibble> <tibble>Resultados del Training
rf_res %>%
collect_metrics()## # A tibble: 2 × 6
## .metric .estimator mean n std_err .config
## <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 mae standard 34959. 4 185. Preprocessor1_Model1
## 2 rmse standard 51744. 4 598. Preprocessor1_Model13) Metricas para valorar el modelo
MAE y RMSE
final_model <- finalize_model(rf_spec, select_best(rf_res, metric = "rmse"))
final_model## Random Forest Model Specification (regression)
##
## Computational engine: rangerTesting
final_ts <- last_fit(final_model, Median_House_Value ~., p_split,
metrics = metric_set(mae, rmse))
final_ts## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [15480/5160]> train/test spl… <tibble> <tibble> <tibble> <workflow>final_ts %>%
collect_metrics()## # A tibble: 2 × 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <chr>
## 1 mae standard 28526. Preprocessor1_Model1
## 2 rmse standard 44299. Preprocessor1_Model1final_ts %>%
collect_predictions()## # A tibble: 5,160 × 5
## id .pred .row Median_House_Value .config
## <chr> <dbl> <int> <dbl> <chr>
## 1 train/test split 362858. 4 341300 Preprocessor1_Model1
## 2 train/test split 272988. 6 269700 Preprocessor1_Model1
## 3 train/test split 249263. 13 213500 Preprocessor1_Model1
## 4 train/test split 149646. 22 159800 Preprocessor1_Model1
## 5 train/test split 142249. 24 99700 Preprocessor1_Model1
## 6 train/test split 166282. 25 132600 Preprocessor1_Model1
## 7 train/test split 133993. 26 107500 Preprocessor1_Model1
## 8 train/test split 126432. 30 132000 Preprocessor1_Model1
## 9 train/test split 117949. 34 104900 Preprocessor1_Model1
## 10 train/test split 175979. 35 109700 Preprocessor1_Model1
## # … with 5,150 more rowsPLOT - Random Forest
collect_predictions(final_ts) %>%
ggplot(aes(Median_House_Value, .pred)) +
geom_abline(lty = 2, color = "gray50") +
geom_point(alpha = 0.5, color = "midnightblue") +
coord_fixed()
4)
Variables más importantes para el modelo
Las variables más importantes para nuestro modelo son:
Ingreso medio
Distancia a la costa
Distancia a San Jose
Distancia a Los Ángeles
Antigüedad del inmueble
Habitaciones por barrio
library(vip)## Warning: package 'vip' was built under R version 4.2.2##
## Attaching package: 'vip'## The following object is masked from 'package:utils':
##
## vifinal_model %>%
set_engine("ranger", importance = "permutation") %>%
fit(Median_House_Value ~ .,
data = juice(recipe_rf)) %>%
vip(geom = "point", aesthetics =
list(color = "turquoise", shape = 16, size = 5))+
theme_light()+
ggtitle("Relevancia de las variables del modelo")