La técnica de aprendizaje supervisado Árboles Aleatorios permite realizar tanto regresión como clasificación. Para el estudio de esta técnica, utilicemos el conjunto \(\texttt{clima}\) del paquete \(\texttt{datos}\).

library(datos)
dat <- clima |> 
  glimpse()
## Rows: 26,115
## Columns: 15
## $ origen           <chr> "EWR", "EWR", "EWR", "EWR", "EWR", "EWR", "EWR", "EWR…
## $ anio             <int> 2013, 2013, 2013, 2013, 2013, 2013, 2013, 2013, 2013,…
## $ mes              <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ dia              <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ hora             <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17…
## $ temperatura      <dbl> 39.02, 39.02, 39.02, 39.92, 39.02, 37.94, 39.02, 39.9…
## $ punto_rocio      <dbl> 26.06, 26.96, 28.04, 28.04, 28.04, 28.04, 28.04, 28.0…
## $ humedad          <dbl> 59.37, 61.63, 64.43, 62.21, 64.43, 67.21, 64.43, 62.2…
## $ direccion_viento <dbl> 270, 250, 240, 250, 260, 240, 240, 250, 260, 260, 260…
## $ velocidad_viento <dbl> 10.35702, 8.05546, 11.50780, 12.65858, 12.65858, 11.5…
## $ velocidad_rafaga <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…
## $ precipitacion    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ presion          <dbl> 1012.0, 1012.3, 1012.5, 1012.2, 1011.9, 1012.4, 1012.…
## $ visibilidad      <dbl> 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 1…
## $ fecha_hora       <dttm> 2013-01-01 01:00:00, 2013-01-01 02:00:00, 2013-01-01…

Esta técnica se basa en ramificar el conjunto de observaciones, es decir, en realizar sucesivas particiones del conjunto en forma de árboles, esta técnica presenta la gran ventaja de presentar una interpretación intuitiva, sin necesidad de requerir hipótesis iniciales. Los árboles aleatorios analizan en cada momento la mejor variable para separar en ese vértice sin considerar qué ocurrirá en los vértices posteriores. Además, en cada proceso de decisición, esto es, en cada vértice se elije la variable predictora \(X_j\) y un valor para la misma \(t\), construyendo dos ramas \(R_{1,j} = \lbrace X_j \leq t \rbrace\) y \(R_{2,j} = \lbrace X_j > t \rbrace\).

Árboles Aleatorios para Regresión

Paso 1. Depuración del conjunto de datos

Para poder aplicar esta técnica como regresión es necesario disponer de variables cuantitativas, por ello vamos a depurar los datos, centrándonos en un único aeropuerto y eliminando las variables que no tienen relación con el clima, además de eliminar los valores ausentes. En concreto, vamos a considerar las variables que hemos comprobado que sí influyen sobre el punto de rocío.

dat_interes <- dat |> 
  filter(
    origen == "JFK"
  ) |> 
  select(punto_rocio,temperatura,humedad,precipitacion,velocidad_rafaga) |> 
  drop_na() |> 
  glimpse()
## Rows: 1,507
## Columns: 5
## $ punto_rocio      <dbl> 17.96, 17.06, 14.00, 10.94, 8.06, 8.06, 8.06, 8.06, 8…
## $ temperatura      <dbl> 37.94, 37.04, 33.08, 30.02, 26.96, 26.06, 26.06, 24.9…
## $ humedad          <dbl> 44.00, 43.85, 44.92, 44.41, 44.25, 45.93, 45.93, 48.0…
## $ precipitacion    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ velocidad_rafaga <dbl> 24.16638, 25.31716, 24.16638, 29.92028, 35.67418, 29.…

Paso 2. Búsqueda óptima para los parámetros: profundidad y complejidad

Los árboles aleatorios se construyen a través del paquete \(\texttt{rpart}\) pero es necesario realizar un entrenamiento del modelo para decidir la profundidad máxima del árbol o el parámetro de complejidad. Para ello, basta utilizar la función \(\texttt{train()}\) del paquete \(\texttt{caret}\), de modo que se optimice ambos parámetros utilizando las técnicas de validación. Para realizar validación cruzada para la profundidad del árbol se emplean los argumentos \(\texttt{method} = ``\texttt{rpart2}''\) y \(\texttt{tuneGrid}\) para indicar el rango de valores para el parámetro.

library(caret)
## Loading required package: lattice
## 
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
## 
##     lift
RT_10FCV_maxdepth <- dat_interes |> 
  train(punto_rocio ~ .,
        data = _,
        method = "rpart2",
        metric = "RMSE",
        trControl = trainControl(method = "cv", number = 10),
        tuneGrid = data.frame(maxdepth = 1:20)
  )

RT_10FCV_maxdepth |> 
  ggplot() +
  labs(x = "Profundidad máxima del Árbol Aleatorio",
       y = "RMSE",
       title = "10-Folds CV")

Se puede observar que a partir de una profundidad máxima igual a 10, el \(RMSE\) se estabiliza, considerando así este valor como la profundidad máxima del árbol que minimiza el error cuadrático medio.

tibble(maxdepth = RT_10FCV_maxdepth$bestTune$maxdepth,
       RMSE = mean(RT_10FCV_maxdepth$resample$RMSE))
## # A tibble: 1 × 2
##   maxdepth  RMSE
##      <int> <dbl>
## 1       10  6.14

Respecto al parámetro de complejidad, también es necesario comprobar cuál es el valor óptimo, para ello se emplean los argumentos \(\texttt{method} = ``\texttt{rpart}''\) y \(\texttt{tuneLength}\) para indicar la longitud máxima.

RT_10FCV_complexity <- dat_interes |> 
  train(punto_rocio ~ .,
        data = _,
        method = "rpart",
        metric = "RMSE",
        trControl = trainControl(method = "cv", number = 10),
        tuneLength = 10
  )
## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.
RT_10FCV_complexity |> 
  ggplot() +
  labs(x = "Parámetro de Complejidad",
       y = "RMSE",
       title = "10-Folds CV")

Como se observa a medida que aumenta el parámetro de complejidad, el \(RMSE\) también aumenta, indicando que una mayor complejidad implica un mayor error cuadrático medio.

tibble(complexity = RT_10FCV_complexity$bestTune$cp,
       RMSE = mean(RT_10FCV_complexity$resample$RMSE))
## # A tibble: 1 × 2
##   complexity  RMSE
##        <dbl> <dbl>
## 1    0.00900  5.95

Paso 3. Aplicación de la Técnica de Regresión: Árboles Aleatorios

Conjuntos de Entrenamiento y Validación

Una vez que encontramos los parámetros óptimos, podemos proceder a aplicar el modelo de regresión Árboles Aleatorios en los distintos conjuntos de entrenamiento y validación.

set.seed(1234)
library(rsample)
dat_split <- dat_interes |> 
  initial_split(prop = 0.7)

dat_train <- dat_split |> 
  training() |> 
  glimpse()
## Rows: 1,054
## Columns: 5
## $ punto_rocio      <dbl> 12.02, 51.08, 46.04, 62.96, 8.06, 59.00, 5.00, 48.92,…
## $ temperatura      <dbl> 33.98, 82.94, 69.98, 84.02, 44.06, 60.80, 41.00, 75.9…
## $ humedad          <dbl> 39.72, 33.20, 42.29, 49.22, 22.45, 96.22, 21.97, 38.5…
## $ precipitacion    <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.23, 0.00, 0.00, 0.00,…
## $ velocidad_rafaga <dbl> 24.16638, 17.26170, 23.01560, 23.01560, 29.92028, 23.…
dat_test <- dat_split |> 
  testing() |> 
  glimpse()
## Rows: 453
## Columns: 5
## $ punto_rocio      <dbl> 17.96, 17.06, 14.00, 8.06, 8.06, 8.06, 10.04, 10.04, …
## $ temperatura      <dbl> 37.94, 37.04, 33.08, 26.96, 26.06, 24.08, 30.92, 33.9…
## $ humedad          <dbl> 44.00, 43.85, 44.92, 44.25, 45.93, 49.87, 41.13, 36.3…
## $ precipitacion    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ velocidad_rafaga <dbl> 24.16638, 25.31716, 24.16638, 35.67418, 27.61872, 24.…

Aplicación del modelo Árboles Aleatorios

A continuación, aplicamos el método Árboles Aleatorios sobre el conjunto de entrenamiento para posteriormente aplicar sobre el conjunto de validación las predicciones para determinar las medidas de precisión \(MSE\) y \(RMSE\). Para aplicar el modelo emplearemos la función \(\texttt{rpart(control)}\).

library(rpart)

model_RT <- dat_train |> 
  rpart(punto_rocio ~ .,
         data = _,
         control = rpart.control(maxdepth = RT_10FCV_maxdepth$bestTune$maxdepth,
                                 cp = RT_10FCV_complexity$bestTune$cp))

model_RT |> 
  summary()
## Call:
## rpart(formula = punto_rocio ~ ., data = dat_train, control = rpart.control(maxdepth = RT_10FCV_maxdepth$bestTune$maxdepth, 
##     cp = RT_10FCV_complexity$bestTune$cp))
##   n= 1054 
## 
##             CP nsplit  rel error    xerror        xstd
## 1  0.531705930      0 1.00000000 1.0009426 0.034760115
## 2  0.106379784      1 0.46829407 0.4699170 0.017196418
## 3  0.101323506      2 0.36191429 0.3823875 0.015218936
## 4  0.043856528      3 0.26059078 0.2777952 0.010814703
## 5  0.042050509      4 0.21673425 0.2429907 0.009632814
## 6  0.031844111      5 0.17468374 0.1657495 0.006437925
## 7  0.019383369      6 0.14283963 0.1507861 0.005986759
## 8  0.013529304      7 0.12345626 0.1427204 0.005647111
## 9  0.011607535      8 0.10992696 0.1188816 0.005101300
## 10 0.008999876      9 0.09831942 0.1028040 0.004448967
## 
## Variable importance
##      temperatura          humedad velocidad_rafaga    precipitacion 
##               60               29                6                5 
## 
## Node number 1: 1054 observations,    complexity param=0.5317059
##   mean=29.36677, MSE=355.1963 
##   left son=2 (587 obs) right son=3 (467 obs)
##   Primary splits:
##       temperatura      < 48.11    to the left,  improve=0.53170590, (0 missing)
##       humedad          < 55.695   to the left,  improve=0.33270510, (0 missing)
##       precipitacion    < 0.005    to the left,  improve=0.05745937, (0 missing)
##       velocidad_rafaga < 27.04333 to the right, improve=0.02356854, (0 missing)
##   Surrogate splits:
##       humedad          < 55.695   to the left,  agree=0.614, adj=0.128, (0 split)
##       velocidad_rafaga < 21.28943 to the right, agree=0.587, adj=0.069, (0 split)
##       precipitacion    < 0.075    to the left,  agree=0.565, adj=0.019, (0 split)
## 
## Node number 2: 587 observations,    complexity param=0.1063798
##   mean=17.10906, MSE=136.8486 
##   left son=4 (377 obs) right son=5 (210 obs)
##   Primary splits:
##       humedad          < 50.38    to the left,  improve=0.49578100, (0 missing)
##       temperatura      < 32.54    to the left,  improve=0.37841620, (0 missing)
##       precipitacion    < 0.005    to the left,  improve=0.19473730, (0 missing)
##       velocidad_rafaga < 28.19411 to the right, improve=0.01468729, (0 missing)
##   Surrogate splits:
##       precipitacion < 0.005    to the left,  agree=0.717, adj=0.21, (0 split)
## 
## Node number 3: 467 observations,    complexity param=0.1013235
##   mean=44.77422, MSE=203.4013 
##   left son=6 (176 obs) right son=7 (291 obs)
##   Primary splits:
##       humedad          < 42.745   to the left,  improve=0.399345500, (0 missing)
##       temperatura      < 60.62    to the left,  improve=0.367496600, (0 missing)
##       precipitacion    < 0.005    to the left,  improve=0.040852770, (0 missing)
##       velocidad_rafaga < 21.28943 to the left,  improve=0.006735286, (0 missing)
##   Surrogate splits:
##       velocidad_rafaga < 21.28943 to the left,  agree=0.657, adj=0.091, (0 split)
##       temperatura      < 92.03    to the right, agree=0.627, adj=0.011, (0 split)
## 
## Node number 4: 377 observations,    complexity param=0.03184411
##   mean=10.96149, MSE=68.05389 
##   left son=8 (142 obs) right son=9 (235 obs)
##   Primary splits:
##       temperatura      < 31.46    to the left,  improve=0.4646692, (0 missing)
##       humedad          < 32.13    to the left,  improve=0.1872091, (0 missing)
##       velocidad_rafaga < 28.19411 to the right, improve=0.0735842, (0 missing)
##   Surrogate splits:
##       humedad          < 47.455   to the right, agree=0.637, adj=0.035, (0 split)
##       velocidad_rafaga < 38.55113 to the right, agree=0.637, adj=0.035, (0 split)
## 
## Node number 5: 210 observations,    complexity param=0.01938337
##   mean=28.14543, MSE=70.70312 
##   left son=10 (104 obs) right son=11 (106 obs)
##   Primary splits:
##       humedad          < 67.03    to the left,  improve=0.4887429, (0 missing)
##       temperatura      < 34.52    to the left,  improve=0.4430141, (0 missing)
##       precipitacion    < 0.005    to the left,  improve=0.1889118, (0 missing)
##       velocidad_rafaga < 31.64645 to the left,  improve=0.0525302, (0 missing)
##   Surrogate splits:
##       precipitacion    < 0.005    to the left,  agree=0.705, adj=0.404, (0 split)
##       velocidad_rafaga < 28.19411 to the left,  agree=0.671, adj=0.337, (0 split)
##       temperatura      < 42.44    to the left,  agree=0.614, adj=0.221, (0 split)
## 
## Node number 6: 176 observations,    complexity param=0.04385653
##   mean=33.18534, MSE=130.7006 
##   left son=12 (107 obs) right son=13 (69 obs)
##   Primary splits:
##       temperatura      < 64.49    to the left,  improve=0.71376130, (0 missing)
##       humedad          < 30.44    to the left,  improve=0.15918960, (0 missing)
##       velocidad_rafaga < 24.74177 to the right, improve=0.06703431, (0 missing)
##   Surrogate splits:
##       humedad          < 38.385   to the left,  agree=0.648, adj=0.101, (0 split)
##       velocidad_rafaga < 20.13865 to the right, agree=0.636, adj=0.072, (0 split)
## 
## Node number 7: 291 observations,    complexity param=0.04205051
##   mean=51.7833, MSE=117.0168 
##   left son=14 (131 obs) right son=15 (160 obs)
##   Primary splits:
##       temperatura      < 60.44    to the left,  improve=0.46231610, (0 missing)
##       humedad          < 66.225   to the left,  improve=0.20425070, (0 missing)
##       precipitacion    < 0.115    to the left,  improve=0.01346686, (0 missing)
##       velocidad_rafaga < 27.04333 to the right, improve=0.01060293, (0 missing)
##   Surrogate splits:
##       velocidad_rafaga < 27.04333 to the right, agree=0.656, adj=0.237, (0 split)
##       precipitacion    < 0.005    to the right, agree=0.608, adj=0.130, (0 split)
##       humedad          < 88.63    to the right, agree=0.601, adj=0.115, (0 split)
## 
## Node number 8: 142 observations
##   mean=3.727324, MSE=34.09012 
## 
## Node number 9: 235 observations
##   mean=15.33277, MSE=37.84604 
## 
## Node number 10: 104 observations
##   mean=22.21077, MSE=35.36355 
## 
## Node number 11: 106 observations
##   mean=33.96811, MSE=36.9166 
## 
## Node number 12: 107 observations
##   mean=25.42916, MSE=28.12706 
## 
## Node number 13: 69 observations
##   mean=45.21304, MSE=51.80931 
## 
## Node number 14: 131 observations,    complexity param=0.0135293
##   mean=43.65466, MSE=55.27358 
##   left son=28 (65 obs) right son=29 (66 obs)
##   Primary splits:
##       humedad          < 71.485   to the left,  improve=0.69951280, (0 missing)
##       precipitacion    < 0.005    to the left,  improve=0.23092620, (0 missing)
##       temperatura      < 56.03    to the left,  improve=0.22308620, (0 missing)
##       velocidad_rafaga < 37.40035 to the left,  improve=0.08075783, (0 missing)
##   Surrogate splits:
##       precipitacion    < 0.005    to the left,  agree=0.725, adj=0.446, (0 split)
##       velocidad_rafaga < 28.19411 to the left,  agree=0.626, adj=0.246, (0 split)
##       temperatura      < 53.33    to the left,  agree=0.557, adj=0.108, (0 split)
## 
## Node number 15: 160 observations,    complexity param=0.01160753
##   mean=58.43862, MSE=69.17699 
##   left son=30 (101 obs) right son=31 (59 obs)
##   Primary splits:
##       temperatura      < 72.5     to the left,  improve=0.39261550, (0 missing)
##       humedad          < 56.615   to the left,  improve=0.28794390, (0 missing)
##       velocidad_rafaga < 23.59099 to the left,  improve=0.05915840, (0 missing)
##       precipitacion    < 0.005    to the left,  improve=0.01780661, (0 missing)
##   Surrogate splits:
##       humedad          < 43.02    to the right, agree=0.644, adj=0.034, (0 split)
##       velocidad_rafaga < 37.40035 to the left,  agree=0.637, adj=0.017, (0 split)
## 
## Node number 28: 65 observations
##   mean=37.38892, MSE=17.77502 
## 
## Node number 29: 66 observations
##   mean=49.82545, MSE=15.46066 
## 
## Node number 30: 101 observations
##   mean=54.45545, MSE=46.79228 
## 
## Node number 31: 59 observations
##   mean=65.25729, MSE=33.84245

Al mostrar el resumen del modelo, se puede observar que se estudia un árbol aleatorio con una profundidad inferior a 10 nodos, además se indica cuáles variables predictoras presentan una mayor importancia sobre el resto. Finalmente, para cada vértice se muestra cómo realiza las particiones. Visualmente se puede utilizar la función \(\texttt{rpart.plot()}\) del paquete \(\texttt{rpart.plot}\).

library(rpart.plot)

model_RT |> 
  rpart.plot()

En el árbol se observa que la variable predictora \(\texttt{temperatura}\) presenta la primera partición, de modo que subdivide el conjunto considerando las observaciones con un valor de esta variable inferior a 48, de modo que para las observaciones que cumplen dicha condición, el valor predicho para la variable respuesta sería 17, además el 56% de las observaciones se han agrupado en ese nuevo nodo.

Paso 4. Predicción y Medidas de Precisión

Finalmente, se puede construir las predicciones a partir del modelo.

dat_predict <- dat_test |> 
  mutate(
    predictions_RT = model_RT |> 
      predict(newdata = dat_test)
  ) |> 
  glimpse()
## Rows: 453
## Columns: 6
## $ punto_rocio      <dbl> 17.96, 17.06, 14.00, 8.06, 8.06, 8.06, 10.04, 10.04, …
## $ temperatura      <dbl> 37.94, 37.04, 33.08, 26.96, 26.06, 24.08, 30.92, 33.9…
## $ humedad          <dbl> 44.00, 43.85, 44.92, 44.25, 45.93, 49.87, 41.13, 36.3…
## $ precipitacion    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ velocidad_rafaga <dbl> 24.16638, 25.31716, 24.16638, 35.67418, 27.61872, 24.…
## $ predictions_RT   <dbl> 15.332766, 15.332766, 15.332766, 3.727324, 3.727324, …
dat_predict |> 
  summarise(
    MSE = mean((punto_rocio - predictions_RT)^2),
    RSME = sqrt(MSE)
  ) |> 
  glimpse()
## Rows: 1
## Columns: 2
## $ MSE  <dbl> 37.33765
## $ RSME <dbl> 6.110454

De manera que las predicciones obtenidas tienen un error medio de \(\pm\) 6.1105 ºF respecto a los valores reales.

Árboles Aleatorios para Clasificación

Paso 1. Depuración del conjunto de datos

En esta ocasión, vamos a aplicar la técnica KNN para clasificar las observaciones para la variable \(\texttt{visibilidad}\) a partir de la información proporcionada por las variables \(\texttt{humedad}\) y \(\texttt{precipitacion}\). En primer lugar, vamos a observar qué valores toma la variable respuesta.

dat_interes <- dat |> 
  select(visibilidad,humedad,precipitacion) |> 
  drop_na() |> 
  glimpse()
## Rows: 26,114
## Columns: 3
## $ visibilidad   <dbl> 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, …
## $ humedad       <dbl> 59.37, 61.63, 64.43, 62.21, 64.43, 67.21, 64.43, 62.21, …
## $ precipitacion <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…

Vemos que es una variable cuantitativa y para poder aplicar las técnicas de clasificación es necesario disponer de una variable cualitativa. Por ello, vamos a transformar dicha variable a partir de una condición. En concreto, diremos que Sí hay visibilidad si presenta valores inferiores a su mediana, y diremos que No hay visibilidad si son superiores a la mediana.

dat_interes <- dat_interes |> 
  mutate(
    visibilidad_fact = factor(ifelse(visibilidad < median(visibilidad),
                              "Yes",
                              "No"))
  ) |> 
  glimpse()
## Rows: 26,114
## Columns: 4
## $ visibilidad      <dbl> 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 1…
## $ humedad          <dbl> 59.37, 61.63, 64.43, 62.21, 64.43, 67.21, 64.43, 62.2…
## $ precipitacion    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ visibilidad_fact <fct> No, No, No, No, No, No, No, No, No, No, No, No, No, N…

Además, debemos comprobar cómo está codificada la variable respuesta.

dat_interes |> 
  pull(visibilidad_fact) |> 
  contrasts()
##     Yes
## No    0
## Yes   1

Observando que la categoría Yes está codificada como 1 y la categoría No como 0. Una vez comprobado, quedémonos con las variables de interés para nuestro modelo.

dat_interes <- dat_interes |> 
  select(visibilidad_fact,humedad,precipitacion) |> 
  glimpse()
## Rows: 26,114
## Columns: 3
## $ visibilidad_fact <fct> No, No, No, No, No, No, No, No, No, No, No, No, No, N…
## $ humedad          <dbl> 59.37, 61.63, 64.43, 62.21, 64.43, 67.21, 64.43, 62.2…
## $ precipitacion    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…

Paso 2. Búsqueda óptima para los parámetros: profundidad y complejidad

Ahora ya podemos clasificar la variable \(\texttt{visibilidad}\) a partir de las variables predictoras utilizando árboles aleatorios. Esta técnica asigna una observación a la categoría predominante en los puntos de la región. En esta ocasión es necesario indicar la profundidad máxima del árbol y el parámetro de complejidad. En concreto, se buscan los valores que maximicen la exactitud del modelo.

Para realizar validación cruzada para la profundidad del árbol se emplean los argumentos \(\texttt{method} = ``\texttt{rpart2}''\) y \(\texttt{tuneGrid}\) para indicar el rango de valores para el parámetro.

library(caret)

CRT_10FCV_maxdepth <- dat_interes |> 
  train(visibilidad_fact ~ .,
        data = _,
        method = "rpart2",
        metric = "Accuracy",
        trControl = trainControl(method = "cv", number = 10),
        tuneGrid = data.frame(maxdepth = 1:20)
  )

CRT_10FCV_maxdepth |> 
  ggplot() +
  labs(x = "Profundidad máxima del Árbol Aleatorio",
       y = "Accuracy",
       title = "10-Folds CV")

Se puede observar que a partir de una profundidad máxima igual a 2, la exactitud del modelo se estabiliza, considerando así este valor como la profundidad máxima del árbol que minimiza el error de clasificación.

tibble(maxdepth = CRT_10FCV_maxdepth$bestTune$maxdepth,
       Accuracy = mean(CRT_10FCV_maxdepth$results$Accuracy))
## # A tibble: 1 × 2
##   maxdepth Accuracy
##      <int>    <dbl>
## 1        2    0.903

Respecto al parámetro de complejidad, también es necesario comprobar cuál es el valor óptimo, para ello se emplean los argumentos \(\texttt{method} = ``\texttt{rpart}''\) y \(\texttt{tuneLength}\) para indicar la longitud máxima.

CRT_10FCV_complexity <- dat_interes |> 
  train(visibilidad_fact ~ .,
        data = _,
        method = "rpart",
        metric = "Accuracy",
        trControl = trainControl(method = "cv", number = 10),
        tuneLength = 10
  )

CRT_10FCV_complexity |> 
  ggplot() +
  labs(x = "Parámetro de Complejidad",
       y = "Accuracy",
       title = "10-Folds CV")

Como se observa a medida que aumenta el parámetro de complejidad, la exactitud del modelo disminuye, indicando que una mayor complejidad implica un menor error de clasificación.

tibble(complexity = CRT_10FCV_complexity$bestTune$cp,
       Accuracy = mean(CRT_10FCV_complexity$results$Accuracy))
## # A tibble: 1 × 2
##   complexity Accuracy
##        <dbl>    <dbl>
## 1   0.000644    0.899

Paso 3. Aplicación de la Técnica de Clasificación: Árboles Aleatorios

Conjuntos de Entrenamiento y Validación

Para aplicar el modelo de clasificación Árboles Aleatorios es necesario obtener los distintos conjuntos de entrenamiento y validación.

set.seed(1234)
library(rsample)
dat_split <- dat_interes |> 
  initial_split(prop = 0.7)

dat_train <- dat_split |> 
  training() |> 
  glimpse()
## Rows: 18,279
## Columns: 3
## $ visibilidad_fact <fct> No, Yes, No, Yes, No, No, No, No, No, Yes, No, No, No…
## $ humedad          <dbl> 35.80, 61.63, 53.63, 87.28, 33.61, 43.00, 61.72, 83.4…
## $ precipitacion    <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00,…
dat_test <- dat_split |> 
  testing() |> 
  glimpse()
## Rows: 7,835
## Columns: 3
## $ visibilidad_fact <fct> No, No, No, No, No, No, No, No, No, No, No, No, No, N…
## $ humedad          <dbl> 61.63, 62.21, 64.43, 62.21, 62.21, 57.06, 69.67, 54.6…
## $ precipitacion    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…

Aplicación del modelo Árboles Aleatorios

A continuación, aplicamos el método Árboles Aleatorios para clasificar observaciones de la variable respuesta utilizando \(maxdepth\) = 2 y un parámetro de complejidad \(cp\) = 6.444809^{-4} sobre el conjunto de entrenamiento para posteriormente aplicar sobre el conjunto de validación las clasificaciones para determinar las medidas de precisión a partir de la matriz de confusión.

Para aplicar el modelo emplearemos la función \(\texttt{rpart(control)}\) del paquete \(\texttt{rpart}\). Además, para representar el árbol utilizamos la función \(\texttt{rpart.plot()}\) del paquete \(\texttt{rpart.plot}\).

library(rpart)
library(rpart.plot)

model_CRT <- dat_train |> 
  rpart(visibilidad_fact ~ .,
        data = _,
        control = rpart.control(maxdepth = CRT_10FCV_maxdepth$bestTune$maxdepth,
                                cp = CRT_10FCV_complexity$bestTune$cp)
        )

model_CRT |> 
  rpart.plot()

Podemos observar en el árbol que la variable predictora \(\texttt{humedad}\) es la que permite clasificar las observaciones en las categorías de la variable respuesta. En cada nodo se muestran las proporciones de las observaciones que pertenecen a cada categoría y la proporción de observaciones que han sido agrupadas en dicho nodo. Por ejemplo, observando el segundo nodo de la derecha (Yes) se tiene que:

  • La regla de decisión para crear los siguientes nodos es: \(\texttt{humedad} < 91\).
  • En dicho nodo se han agrupado el 18% de las observaciones, esto es, aquellas observaciones que no cumplen la regla de decisión anterior (\(\texttt{humedad}<84\)).
  • 64% de las observaciones pertenecen a este nodo.

Paso 4. Clasificación y Medidas de Precisión

Para clasificar las observaciones vamos a utilizar la función \(\texttt{predict(model)}\) pero añadiéndole el argumento \(\texttt{type} = \texttt{"class"}\).

library(caret)

dat_clasification <- dat_test |> 
  mutate(
    clasification_RT = model_CRT |> 
      predict(newdata = dat_test,
              type = "class")
  ) |> 
  glimpse()
## Rows: 7,835
## Columns: 4
## $ visibilidad_fact <fct> No, No, No, No, No, No, No, No, No, No, No, No, No, N…
## $ humedad          <dbl> 61.63, 62.21, 64.43, 62.21, 62.21, 57.06, 69.67, 54.6…
## $ precipitacion    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ clasification_RT <fct> No, No, No, No, No, No, No, No, No, No, No, No, No, N…

Una vez que se han clasificado nuevas observaciones podemos proceder a calcular las medidas de precisión a través de la matriz de confusión. Para calcular dicha matriz utilizamos la función \(\texttt{confusionMatrix(positive,mode="everything")}\) del paquete \(\texttt{caret}\) indicando con el argumento \(\texttt{positive}\) la categoría de observaciones positivas (en nuestro caso, observaciones que sí tienen visibilidad).

Es necesario tener en cuenta que debemos seleccionar las variables de interés, en esta ocasión, las clasificaciones (como factor) y la variable respuesta, además debemos construir la tabla de frecuencias con la función \(\texttt{table()}\).

library(caret)

dat_clasification |> 
  select(clasification_RT, visibilidad_fact) |> #Se utiliza el conjunto de clasificaciones predichas en primer lugar
  table() |> 
  confusionMatrix(positive = "Yes",
                  mode = "everything") 
## Confusion Matrix and Statistics
## 
##                 visibilidad_fact
## clasification_RT   No  Yes
##              No  6438  780
##              Yes   81  536
##                                         
##                Accuracy : 0.8901        
##                  95% CI : (0.883, 0.897)
##     No Information Rate : 0.832         
##     P-Value [Acc > NIR] : < 2.2e-16     
##                                         
##                   Kappa : 0.5011        
##                                         
##  Mcnemar's Test P-Value : < 2.2e-16     
##                                         
##             Sensitivity : 0.40729       
##             Specificity : 0.98757       
##          Pos Pred Value : 0.86872       
##          Neg Pred Value : 0.89194       
##               Precision : 0.86872       
##                  Recall : 0.40729       
##                      F1 : 0.55458       
##              Prevalence : 0.16796       
##          Detection Rate : 0.06841       
##    Detection Prevalence : 0.07875       
##       Balanced Accuracy : 0.69743       
##                                         
##        'Positive' Class : Yes           
##

Podemos observar que:

  • \(VP\) = 6438 observaciones que No tienen visibilidad y se han clasificado correctamente.
  • \(FN\) = 780 observaciones que Sí tienen visibilidad y se han clasificado incorrectamente.
  • \(FP\) = 81 observaciones que No tienen visibilidad y se han clasificado incorrectamente.
  • \(VN\) = 536 observaciones que Sí tienen visibilidad y se han clasificado correctamente.

En cuanto a las medidas de precisión, tenemos que:

  • \(Precision\) = 0.8687, esto es, el 86.87 % de las observaciones que se han clasificado con visibilidad realmente la tienen.
  • \(Recall\) = 0.4073, es decir, el 40.73 % de las observaciones con visibilidad se han clasificado correctamente.
  • \(Specificity\) = 0.9876, por tanto el 98.76 % de las observaciones sin visibilidad se han clasificado correctamente.
  • \(Accuracy\) = 0.8901, de modo que el modelo proporciona el 89.01 % de clasificaciones correctas.
  • \(F1-Score\) = 0.5546, el modelo proporciona un balance moderado entre su precisión y su sensibilidad.