1 Objetivo

Construir y evaluar un modelo de árbol de regresión para realizar predicciones y comparar resultados con el modelo de regresión lineal múltiple

2 Descripción

  • Se cargan las librerías necesarias

  • Se cargan los datos Se exploran los datos

  • Se crear los datos de entrenamiento y validación 70% y 30% respectivamente

Las métricas a valorar serán:

  • Que los coeficientes sean estadísticamente significativos por encima del 95%.

  • R Squared Ajustado el modelo se acepta si sobrepasa en el 80%

  • rmse comparado con otro modelo mismos datos se acepta o se establece que un modelo es mejor que otro.

  • Comparaciones con el modelo de regresión lineal múltiple

3 Marco teórico

Los algoritmos de aprendizaje basados en árbol se consideran uno de los mejores y más utilizados métodos de aprendizaje supervisado. Potencian modelos predictivos con alta precisión, estabilidad y facilidad de interpretación.

Los árboles de clasificación y regresión son métodos que proporcionan modelos que satisfacen objetivos tanto predictivos como explicativos.

Algunas ventajas son su sencillez y la representación gráfica mediante árboles y, por otro, la definición de reglas de asociación entre variables que incluye expresiones de condición que permiten explicar las predicciones.

Se pueden usar para regresiones con variables dependientes que tienen valores numéricos continuos o para clasificaciones con variables categóricas.

Utilizar un árbol de regresión para crear un modelo explicativo y predictivo para una variable cuantitativa dependiente basada en variables explicativas independientes cuantitativas y cualitativas (XLSTAT by Addinsoft, n.d.).

Un árbol de regresión consiste en hacer preguntas de tipo \(¿x_k < c?\) para cada una de las covariables, de esta forma el espacio de las covariables es divido en hiper-rectángulos (con el resultado de las condicionales) de las observaciones que queden dentro de un hiper-rectángulo tendrán el mismo valor estimado \(\hat{y}\) o \(Y\). (Hernández 2021).

Por otra parte, bajo el paradigma divide y vencerás, usando árboles de regresión y decisión y correspondientes reglas, el árbol representa el modelo similar a un diagrama de flujo en el que los nodos de decisión, los nodos de hoja y las ramas definen una serie de decisiones que se pueden usar para generar predicciones. Siguiendo las reglas se encuentran predicciones en la hoja final. (Lantz 2013)

4 Desarrollo

4.1 Cargar librerías

library(readr) # Para importar datos
library(dplyr) # Para filtrar   
library(knitr) # Para datos tabulares
library(ggplot2) # Para visualizar
library(plotly)
library(caret)  # Para particionar
library(Metrics) # Para determinar rmse

library(rpart) # Para árbol
library(rpart.plot) # Para árbol

4.2 Cargar datos

datos <- read.csv("https://raw.githubusercontent.com/rpizarrog/Analisis-Inteligente-de-datos/main/datos/Advertising.csv")

4.3 Explorando los datos

summary(datos)
##        X                TV             Radio          Newspaper     
##  Min.   :  1.00   Min.   :  0.70   Min.   : 0.000   Min.   :  0.30  
##  1st Qu.: 50.75   1st Qu.: 74.38   1st Qu.: 9.975   1st Qu.: 12.75  
##  Median :100.50   Median :149.75   Median :22.900   Median : 25.75  
##  Mean   :100.50   Mean   :147.04   Mean   :23.264   Mean   : 30.55  
##  3rd Qu.:150.25   3rd Qu.:218.82   3rd Qu.:36.525   3rd Qu.: 45.10  
##  Max.   :200.00   Max.   :296.40   Max.   :49.600   Max.   :114.00  
##      Sales      
##  Min.   : 1.60  
##  1st Qu.:10.38  
##  Median :12.90  
##  Mean   :14.02  
##  3rd Qu.:17.40  
##  Max.   :27.00
str(datos)
## 'data.frame':    200 obs. of  5 variables:
##  $ X        : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ TV       : num  230.1 44.5 17.2 151.5 180.8 ...
##  $ Radio    : num  37.8 39.3 45.9 41.3 10.8 48.9 32.8 19.6 2.1 2.6 ...
##  $ Newspaper: num  69.2 45.1 69.3 58.5 58.4 75 23.5 11.6 1 21.2 ...
##  $ Sales    : num  22.1 10.4 9.3 18.5 12.9 7.2 11.8 13.2 4.8 10.6 ...

Son 200 registros tres variables independientes y una variable dependiente.

La variable dependiente o variable objetivo es Sales que deberá estar en función de la inversión que se hace en TV, Radio o Newspaper.

4.4 Limpiar datos

Quitar la variable x que no es de interés

datos <- datos %>%
  select (TV, Radio, Newspaper, Sales)

4.4.1 head(datos)

kable(head(datos, 20), caption = "Primeros 20 registros")
Primeros 20 registros
TV Radio Newspaper Sales
230.1 37.8 69.2 22.1
44.5 39.3 45.1 10.4
17.2 45.9 69.3 9.3
151.5 41.3 58.5 18.5
180.8 10.8 58.4 12.9
8.7 48.9 75.0 7.2
57.5 32.8 23.5 11.8
120.2 19.6 11.6 13.2
8.6 2.1 1.0 4.8
199.8 2.6 21.2 10.6
66.1 5.8 24.2 8.6
214.7 24.0 4.0 17.4
23.8 35.1 65.9 9.2
97.5 7.6 7.2 9.7
204.1 32.9 46.0 19.0
195.4 47.7 52.9 22.4
67.8 36.6 114.0 12.5
281.4 39.6 55.8 24.4
69.2 20.5 18.3 11.3
147.3 23.9 19.1 14.6

4.4.2 tail(datos)

kable(tail(datos, 20), caption = "Últimos 20 registros")
Últimos 20 registros
TV Radio Newspaper Sales
181 156.6 2.6 8.3 10.5
182 218.5 5.4 27.4 12.2
183 56.2 5.7 29.7 8.7
184 287.6 43.0 71.8 26.2
185 253.8 21.3 30.0 17.6
186 205.0 45.1 19.6 22.6
187 139.5 2.1 26.6 10.3
188 191.1 28.7 18.2 17.3
189 286.0 13.9 3.7 15.9
190 18.7 12.1 23.4 6.7
191 39.5 41.1 5.8 10.8
192 75.5 10.8 6.0 9.9
193 17.2 4.1 31.6 5.9
194 166.8 42.0 3.6 19.6
195 149.7 35.6 6.0 17.3
196 38.2 3.7 13.8 7.6
197 94.2 4.9 8.1 9.7
198 177.0 9.3 6.4 12.8
199 283.6 42.0 66.2 25.5
200 232.1 8.6 8.7 13.4

4.5 Datos de entrenamiento y validación

4.5.1 Datos de entrenamiento

n <- nrow(datos)

# Modificar la semilla estableciendo como parámetro los útimos cuatro dígitos de su no de control. 
# Ej. set.seed(0732), o set.seed(1023)
# set.seed(2022) 
set.seed(2022)

De manera aleatoria se construyen los datos de entrenamiento y los datos de validación.

En la variable entrena se generan los registros que van a ser los datos de entrenamiento, de tal forma que los datos de validación serán los que no sena de entrenamiento [-entrena].

entrena <- createDataPartition(y = datos$Sales, p = 0.70, list = FALSE, times = 1)

# Datos entrenamiento
datos.entrenamiento <- datos[entrena, ]  # [renglones, columna]

# Datos validación
datos.validacion <- datos[-entrena, ]

4.5.1.2 tail()

kable(tail(datos.entrenamiento, 20), caption = "Datos de entrenamiento ültimos 20 registros")
Datos de entrenamiento ültimos 20 registros
TV Radio Newspaper Sales
175 222.4 3.4 13.1 11.5
176 276.9 48.9 41.8 27.0
179 276.7 2.3 23.7 11.8
180 165.6 10.0 17.6 12.6
181 156.6 2.6 8.3 10.5
183 56.2 5.7 29.7 8.7
184 287.6 43.0 71.8 26.2
185 253.8 21.3 30.0 17.6
186 205.0 45.1 19.6 22.6
187 139.5 2.1 26.6 10.3
188 191.1 28.7 18.2 17.3
189 286.0 13.9 3.7 15.9
190 18.7 12.1 23.4 6.7
192 75.5 10.8 6.0 9.9
193 17.2 4.1 31.6 5.9
195 149.7 35.6 6.0 17.3
196 38.2 3.7 13.8 7.6
197 94.2 4.9 8.1 9.7
198 177.0 9.3 6.4 12.8
200 232.1 8.6 8.7 13.4

4.5.2 Datos de validación

Los datos de validación deben ser diferentes a los datos den entrenamiento.

4.5.2.1 head()

kable(head(datos.validacion, 20), caption = "Datos de Validación Primeros 20 registros")
Datos de Validación Primeros 20 registros
TV Radio Newspaper Sales
10 199.8 2.6 21.2 10.6
20 147.3 23.9 19.1 14.6
21 218.4 27.7 53.4 18.0
22 237.4 5.1 23.5 12.5
24 228.3 16.9 26.2 15.5
26 262.9 3.5 19.5 12.0
27 142.9 29.3 12.6 15.0
30 70.6 16.0 40.8 10.5
31 292.9 28.3 43.2 21.4
33 97.2 1.5 30.0 9.6
34 265.6 20.0 0.3 17.4
35 95.7 1.4 7.4 9.5
36 290.7 4.1 8.5 12.8
42 177.0 33.4 38.7 17.1
48 239.9 41.5 18.5 23.2
50 66.9 11.7 36.8 9.7
54 182.6 46.2 58.7 21.2
55 262.7 28.8 15.9 20.2
60 210.7 29.5 9.3 18.4
63 239.3 15.5 27.3 15.7

4.5.2.2 tail()

kable(tail(datos.validacion, 20), caption = "Datos de validació últimos 20 registros")
Datos de validació últimos 20 registros
TV Radio Newspaper Sales
118 76.4 0.8 14.8 9.4
120 19.4 16.0 22.3 6.6
125 229.5 32.3 74.2 19.7
128 80.2 0.0 9.2 8.8
130 59.6 12.0 43.1 9.7
133 8.4 27.2 2.1 5.7
139 43.0 25.9 20.5 9.6
140 184.9 43.9 1.7 20.7
144 104.6 5.7 34.4 10.4
149 38.0 40.3 11.9 10.9
151 280.7 13.9 37.0 16.1
153 197.6 23.3 14.2 16.6
171 50.0 11.6 18.4 8.4
172 164.5 20.9 47.4 14.5
177 248.4 30.2 20.3 20.2
178 170.2 7.8 35.2 11.7
182 218.5 5.4 27.4 12.2
191 39.5 41.1 5.8 10.8
194 166.8 42.0 3.6 19.6
199 283.6 42.0 66.2 25.5

4.6 Construir el modelo

Se construye el modelo con la función rpart

modelo_ar <- rpart(data = datos.entrenamiento,formula = Sales ~ TV + Radio + Newspaper )
modelo_ar
## n= 142 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 142 4117.76800 14.077460  
##    2) TV< 122.05 58  520.13120  9.725862  
##      4) TV< 32.75 21   79.17238  6.752381 *
##      5) TV>=32.75 37  149.90320 11.413510  
##       10) Radio< 13.45 14   18.11429  9.657143 *
##       11) Radio>=13.45 23   62.31304 12.482610 *
##    3) TV>=122.05 84 1740.96300 17.082140  
##      6) Radio< 26.85 44  188.94980 13.497730  
##       12) Radio< 10.05 21   18.96667 11.766670 *
##       13) Radio>=10.05 23   49.59913 15.078260 *
##      7) Radio>=26.85 40  364.85500 21.025000  
##       14) TV< 194.55 12   17.66917 17.641670 *
##       15) TV>=194.55 28  150.95250 22.475000  
##         30) Radio< 35.3 9    6.44000 19.766670 *
##         31) Radio>=35.3 19   47.22632 23.757890 *

4.6.1 resumen del modelo

summary(modelo_ar)
## Call:
## rpart(formula = Sales ~ TV + Radio + Newspaper, data = datos.entrenamiento)
##   n= 142 
## 
##           CP nsplit  rel error    xerror       xstd
## 1 0.45089318      0 1.00000000 1.0132336 0.10752048
## 2 0.28830145      1 0.54910682 0.7169968 0.06569588
## 3 0.07068285      2 0.26080537 0.3808481 0.04645636
## 4 0.04765527      3 0.19012252 0.2664784 0.02717328
## 5 0.02923525      4 0.14246725 0.2326955 0.02375388
## 6 0.02362595      5 0.11323200 0.2270240 0.02334504
## 7 0.01687223      6 0.08960605 0.1772675 0.01984244
## 8 0.01000000      7 0.07273382 0.1472676 0.01638832
## 
## Variable importance
##        TV     Radio Newspaper 
##        54        33        13 
## 
## Node number 1: 142 observations,    complexity param=0.4508932
##   mean=14.07746, MSE=28.99837 
##   left son=2 (58 obs) right son=3 (84 obs)
##   Primary splits:
##       TV        < 122.05 to the left,  improve=0.4508932, (0 missing)
##       Radio     < 39.65  to the left,  improve=0.2641203, (0 missing)
##       Newspaper < 50.9   to the left,  improve=0.1007850, (0 missing)
##   Surrogate splits:
##       Radio < 1.75   to the left,  agree=0.606, adj=0.034, (0 split)
## 
## Node number 2: 58 observations,    complexity param=0.07068285
##   mean=9.725862, MSE=8.967779 
##   left son=4 (21 obs) right son=5 (37 obs)
##   Primary splits:
##       TV        < 32.75  to the left,  improve=0.55958110, (0 missing)
##       Radio     < 40.1   to the left,  improve=0.13279470, (0 missing)
##       Newspaper < 31.65  to the left,  improve=0.04804439, (0 missing)
##   Surrogate splits:
##       Radio     < 1.8    to the left,  agree=0.655, adj=0.048, (0 split)
##       Newspaper < 49.45  to the right, agree=0.655, adj=0.048, (0 split)
## 
## Node number 3: 84 observations,    complexity param=0.2883014
##   mean=17.08214, MSE=20.72575 
##   left son=6 (44 obs) right son=7 (40 obs)
##   Primary splits:
##       Radio     < 26.85  to the left,  improve=0.6818975, (0 missing)
##       Newspaper < 37.3   to the left,  improve=0.2368093, (0 missing)
##       TV        < 193.45 to the left,  improve=0.2120854, (0 missing)
##   Surrogate splits:
##       Newspaper < 37.3   to the left,  agree=0.738, adj=0.450, (0 split)
##       TV        < 189.75 to the left,  agree=0.607, adj=0.175, (0 split)
## 
## Node number 4: 21 observations
##   mean=6.752381, MSE=3.770113 
## 
## Node number 5: 37 observations,    complexity param=0.01687223
##   mean=11.41351, MSE=4.051439 
##   left son=10 (14 obs) right son=11 (23 obs)
##   Primary splits:
##       Radio     < 13.45  to the left,  improve=0.4634717, (0 missing)
##       TV        < 66.95  to the left,  improve=0.2811344, (0 missing)
##       Newspaper < 45.4   to the left,  improve=0.2653206, (0 missing)
##   Surrogate splits:
##       Newspaper < 8.25   to the left,  agree=0.703, adj=0.214, (0 split)
## 
## Node number 6: 44 observations,    complexity param=0.02923525
##   mean=13.49773, MSE=4.294313 
##   left son=12 (21 obs) right son=13 (23 obs)
##   Primary splits:
##       Radio     < 10.05  to the left,  improve=0.63712160, (0 missing)
##       TV        < 170.45 to the left,  improve=0.24450570, (0 missing)
##       Newspaper < 28.3   to the left,  improve=0.04083687, (0 missing)
##   Surrogate splits:
##       Newspaper < 20.4   to the left,  agree=0.614, adj=0.190, (0 split)
##       TV        < 170.45 to the left,  agree=0.591, adj=0.143, (0 split)
## 
## Node number 7: 40 observations,    complexity param=0.04765527
##   mean=21.025, MSE=9.121375 
##   left son=14 (12 obs) right son=15 (28 obs)
##   Primary splits:
##       TV        < 194.55 to the left,  improve=0.53783920, (0 missing)
##       Radio     < 42     to the left,  improve=0.39216040, (0 missing)
##       Newspaper < 39.15  to the left,  improve=0.05520939, (0 missing)
##   Surrogate splits:
##       Newspaper < 73.95  to the right, agree=0.725, adj=0.083, (0 split)
## 
## Node number 10: 14 observations
##   mean=9.657143, MSE=1.293878 
## 
## Node number 11: 23 observations
##   mean=12.48261, MSE=2.709263 
## 
## Node number 12: 21 observations
##   mean=11.76667, MSE=0.9031746 
## 
## Node number 13: 23 observations
##   mean=15.07826, MSE=2.156484 
## 
## Node number 14: 12 observations
##   mean=17.64167, MSE=1.472431 
## 
## Node number 15: 28 observations,    complexity param=0.02362595
##   mean=22.475, MSE=5.391161 
##   left son=30 (9 obs) right son=31 (19 obs)
##   Primary splits:
##       Radio     < 35.3   to the left,  improve=0.6444821, (0 missing)
##       TV        < 258.35 to the left,  improve=0.2648266, (0 missing)
##       Newspaper < 39.15  to the left,  improve=0.1296573, (0 missing)
##   Surrogate splits:
##       Newspaper < 12.55  to the left,  agree=0.714, adj=0.111, (0 split)
## 
## Node number 30: 9 observations
##   mean=19.76667, MSE=0.7155556 
## 
## Node number 31: 19 observations
##   mean=23.75789, MSE=2.485596

4.6.2 Representar visualmente el árbol de regresión

rpart.plot(modelo_ar)

4.7 Predecir valores con datos de validación

predicciones <- predict(object = modelo_ar, newdata = datos.validacion)

Construir un data frame para comparar y luego evaluar

comparaciones <- data.frame(datos.validacion, predicciones)
comparaciones
##        TV Radio Newspaper Sales predicciones
## 10  199.8   2.6      21.2  10.6    11.766667
## 20  147.3  23.9      19.1  14.6    15.078261
## 21  218.4  27.7      53.4  18.0    19.766667
## 22  237.4   5.1      23.5  12.5    11.766667
## 24  228.3  16.9      26.2  15.5    15.078261
## 26  262.9   3.5      19.5  12.0    11.766667
## 27  142.9  29.3      12.6  15.0    17.641667
## 30   70.6  16.0      40.8  10.5    12.482609
## 31  292.9  28.3      43.2  21.4    19.766667
## 33   97.2   1.5      30.0   9.6     9.657143
## 34  265.6  20.0       0.3  17.4    15.078261
## 35   95.7   1.4       7.4   9.5     9.657143
## 36  290.7   4.1       8.5  12.8    11.766667
## 42  177.0  33.4      38.7  17.1    17.641667
## 48  239.9  41.5      18.5  23.2    23.757895
## 50   66.9  11.7      36.8   9.7     9.657143
## 54  182.6  46.2      58.7  21.2    17.641667
## 55  262.7  28.8      15.9  20.2    19.766667
## 60  210.7  29.5       9.3  18.4    19.766667
## 63  239.3  15.5      27.3  15.7    15.078261
## 66   69.0   9.3       0.9   9.3     9.657143
## 67   31.5  24.6       2.2   9.5     6.752381
## 69  237.4  27.5      11.0  18.9    19.766667
## 76   16.9  43.7      89.4   8.7     6.752381
## 83   75.3  20.3      32.5  11.3    12.482609
## 84   68.4  44.5      35.6  13.6    12.482609
## 87   76.3  27.5      16.0  12.0    12.482609
## 90  109.8  47.8      51.4  16.7    12.482609
## 93  217.7  33.5      59.0  19.4    19.766667
## 95  107.4  14.0      10.9  11.5    12.482609
## 101 222.4   4.3      49.8  11.7    11.766667
## 104 187.9  17.2      17.9  14.7    15.078261
## 107  25.0  11.0      29.7   7.2     6.752381
## 109  13.1   0.4      25.6   5.3     6.752381
## 111 225.8   8.2      56.5  13.4    11.766667
## 112 241.7  38.0      23.2  21.8    23.757895
## 114 209.6  20.6      10.7  15.9    15.078261
## 116  75.1  35.0      52.7  12.6    12.482609
## 118  76.4   0.8      14.8   9.4     9.657143
## 120  19.4  16.0      22.3   6.6     6.752381
## 125 229.5  32.3      74.2  19.7    19.766667
## 128  80.2   0.0       9.2   8.8     9.657143
## 130  59.6  12.0      43.1   9.7     9.657143
## 133   8.4  27.2       2.1   5.7     6.752381
## 139  43.0  25.9      20.5   9.6    12.482609
## 140 184.9  43.9       1.7  20.7    17.641667
## 144 104.6   5.7      34.4  10.4     9.657143
## 149  38.0  40.3      11.9  10.9    12.482609
## 151 280.7  13.9      37.0  16.1    15.078261
## 153 197.6  23.3      14.2  16.6    15.078261
## 171  50.0  11.6      18.4   8.4     9.657143
## 172 164.5  20.9      47.4  14.5    15.078261
## 177 248.4  30.2      20.3  20.2    19.766667
## 178 170.2   7.8      35.2  11.7    11.766667
## 182 218.5   5.4      27.4  12.2    11.766667
## 191  39.5  41.1       5.8  10.8    12.482609
## 194 166.8  42.0       3.6  19.6    17.641667
## 199 283.6  42.0      66.2  25.5    23.757895

4.8 rmse Root Mean Stándard Error (Root-mean-square deviation),

Este valor normalmente se compara contra otro modelo y el que esté mas cerca de cero es mejor.

La raiz del Error Cuadrático Medio (rmse) es una métrica que dice qué tan lejos están los valores predichos de los valores observados o reales en un análisis de regresión, en promedio. Se calcula como:

\[ rmse = \sqrt{\frac{\sum(predicho_i - real_i)^{2}}{n}} \]

RMSE es una forma útil de ver qué tan bien un modelo de regresión puede ajustarse a un conjunto de datos.

Cuanto mayor sea el rmse, mayor será la diferencia entre los valores predichos y reales, lo que significa que peor se ajusta un modelo de regresión a los datos. Por el contrario, cuanto más pequeño sea el rmse, mejor podrá un modelo ajustar los datos.

Se compara este valor de rmse con respecto al modelo de regresión múltiple

En el modelo de regresión múltiple https://rpubs.com/rpizarro/878398 con los datos Adverstising se tuvo un valor de rmse de: 1.590948.

Con este modelo de árbol de regresión, los mismos datos, mismas particiones se tuvo un valor de 1.455681 por lo que se puede interpretar que este modelo de regresión fué mejor con respecto a la métrica rmse.

rmse <- rmse(actual = comparaciones$Sales, predicted = comparaciones$predicciones)
rmse
## [1] 1.455681

4.9 Graficar predicciones contra valores reales

ggplot(data = comparaciones) +
  geom_line(aes(x = 1:nrow(comparaciones), y = Sales), col='blue') +
  geom_line(aes(x = 1:nrow(comparaciones), y = predicciones), col='yellow') +
  ggtitle(label="Valores reales vs predichos Adverstising", subtitle = "Arbol de Regresión")

4.10 Predicciones con datos nuevos

TV <- c(140, 160)
Radio <- c(60, 40)
Newspaper <- c(80, 90) 

nuevos <- data.frame(TV, Radio, Newspaper)  
nuevos
##    TV Radio Newspaper
## 1 140    60        80
## 2 160    40        90
Y.predicciones <- predict(object = modelo_ar, newdata = nuevos)
Y.predicciones
##        1        2 
## 17.64167 17.64167

5 Interpretación

Comentarios sobre el caso

Bibliografía

Hernández, Freddy. 2021. Modelos Predictivos. https://fhernanb.github.io/libro_mod_pred/;
Lantz, Brett. 2013. Aprendizaje Automático Con r. Publicación de paquetes. Edición de Kindle. Publicación de paquetes. Edición de Kindle.
XLSTAT by Addinsoft. n.d. “Árboles de Clasificación y Regresión.” https://www.xlstat.com/es/soluciones/funciones/arboles-de-clasificacion-y-de-regresion.