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 lineak 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.

Dos de los puntos fuertes de este método son, por un lado, la sencilla representación gráfica mediante árboles y, por otro, el formato compacto de las reglas de lenguaje natural.

Se distinguen dos casos en que estas técnicas de modelado deben utilizarse: - Utilizar árboles de clasificación para explicar y predecir la pertenencia de los objetos (observaciones, individuos) a una clase, sobre la base de variables explicativas cuantitativas y cualitativas.

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.

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(0432)

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
172 164.5 20.9 47.4 14.5
175 222.4 3.4 13.1 11.5
176 276.9 48.9 41.8 27.0
177 248.4 30.2 20.3 20.2
178 170.2 7.8 35.2 11.7
179 276.7 2.3 23.7 11.8
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
190 18.7 12.1 23.4 6.7
193 17.2 4.1 31.6 5.9
194 166.8 42.0 3.6 19.6
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
1 230.1 37.8 69.2 22.1
2 44.5 39.3 45.1 10.4
6 8.7 48.9 75.0 7.2
7 57.5 32.8 23.5 11.8
8 120.2 19.6 11.6 13.2
11 66.1 5.8 24.2 8.6
18 281.4 39.6 55.8 24.4
20 147.3 23.9 19.1 14.6
23 13.2 15.9 49.6 5.6
25 62.3 12.6 18.3 9.7
30 70.6 16.0 40.8 10.5
31 292.9 28.3 43.2 21.4
34 265.6 20.0 0.3 17.4
36 290.7 4.1 8.5 12.8
37 266.9 43.8 5.0 25.4
40 228.0 37.7 32.0 21.5
43 293.6 27.7 1.8 20.7
45 25.1 25.7 43.3 8.5
56 198.9 49.4 60.0 23.7
60 210.7 29.5 9.3 18.4

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
126 87.2 11.8 25.9 10.6
136 48.3 47.0 8.5 11.6
137 25.6 39.0 9.3 9.5
151 280.7 13.9 37.0 16.1
153 197.6 23.3 14.2 16.6
154 171.3 39.7 37.7 19.0
158 149.8 1.3 24.3 10.1
161 172.5 18.1 30.7 14.4
163 188.4 18.1 25.6 14.9
164 163.5 36.8 7.4 18.0
170 284.3 10.6 6.4 15.0
173 19.6 20.1 17.0 7.6
174 168.4 7.1 12.8 11.7
180 165.6 10.0 17.6 12.6
181 156.6 2.6 8.3 10.5
189 286.0 13.9 3.7 15.9
191 39.5 41.1 5.8 10.8
192 75.5 10.8 6.0 9.9
195 149.7 35.6 6.0 17.3
199 283.6 42.0 66.2 25.5

4.6 Consruir el modelo

Se contruye el modelo con la funció rpart

modelo_ar <- rpart(data = datos.entrenamiento,
                    formula = Sales ~ TV,Radio,Newspaper )
modelo_ar
## n= 141 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 141 68313.6600 15.479410  
##    2) TV< 119.3 60  8896.4640 10.719230  
##      4) TV< 67.35 19  1200.4010  8.136016 *
##      5) TV>=67.35 41  2175.6470 12.511590 *
##    3) TV>=119.3 81 15924.6700 18.382360  
##      6) TV< 181.7 20  2296.8450 16.725560 *
##      7) TV>=181.7 61 11647.3900 18.993750  
##       14) TV>=218.05 29  4816.5550 18.275030  
##         28) TV< 237.8 13   769.2592 16.421880 *
##         29) TV>=237.8 16  2734.7180 19.453950 *
##       15) TV< 218.05 32  6295.1010 19.515700  
##         30) TV< 213.45 24  4465.3250 18.735140  
##           60) TV>=197.25 17  1431.8790 17.424750 *
##           61) TV< 197.25 7  1931.2940 20.308150 *
##         31) TV>=213.45 8   908.6653 20.942110 *

4.6.1 resumen del modelo

summary(modelo_ar)
## Call:
## rpart(formula = Sales ~ TV, data = datos.entrenamiento, weights = Radio, 
##     subset = Newspaper)
##   n= 141 
## 
##           CP nsplit rel error    xerror        xstd
## 1 0.63665933      0 1.0000000 1.0315839 0.019909418
## 2 0.08080983      1 0.3633407 0.3946123 0.008532266
## 3 0.02899033      2 0.2825308 0.2987577 0.007473823
## 4 0.01416836      3 0.2535405 0.2863153 0.006831147
## 5 0.01000000      7 0.1968671 0.2951292 0.006426935
## 
## Variable importance
##  TV 
## 100 
## 
## Node number 1: 141 observations,    complexity param=0.6366593
##   mean=15.47941, MSE=21.70479 
##   left son=2 (60 obs) right son=3 (81 obs)
##   Primary splits:
##       TV < 119.3  to the left,  improve=0.6366593, (1 missing)
## 
## Node number 2: 60 observations,    complexity param=0.08080983
##   mean=10.71923, MSE=7.461599 
##   left son=4 (19 obs) right son=5 (41 obs)
##   Primary splits:
##       TV < 67.35  to the left,  improve=0.6205179, (1 missing)
## 
## Node number 3: 81 observations,    complexity param=0.02899033
##   mean=18.38236, MSE=8.145193 
##   left son=6 (20 obs) right son=7 (61 obs)
##   Primary splits:
##       TV < 181.7  to the left,  improve=0.1243628, (0 missing)
## 
## Node number 4: 19 observations
##   mean=8.136016, MSE=2.457825 
## 
## Node number 5: 41 observations
##   mean=12.51159, MSE=3.090847 
## 
## Node number 6: 20 observations
##   mean=16.72556, MSE=4.358339 
## 
## Node number 7: 61 observations,    complexity param=0.01416836
##   mean=18.99375, MSE=8.155862 
##   left son=14 (29 obs) right son=15 (32 obs)
##   Primary splits:
##       TV < 218.05 to the right, improve=0.04599571, (0 missing)
## 
## Node number 14: 29 observations,    complexity param=0.01416836
##   mean=18.27503, MSE=8.016903 
##   left son=28 (13 obs) right son=29 (16 obs)
##   Primary splits:
##       TV < 237.8  to the left,  improve=0.2725138, (0 missing)
## 
## Node number 15: 32 observations,    complexity param=0.01416836
##   mean=19.5157, MSE=7.609212 
##   left son=30 (24 obs) right son=31 (8 obs)
##   Primary splits:
##       TV < 213.45 to the left,  improve=0.1463219, (0 missing)
## 
## Node number 28: 13 observations
##   mean=16.42188, MSE=3.293062 
## 
## Node number 29: 16 observations
##   mean=19.45395, MSE=7.44749 
## 
## Node number 30: 24 observations,    complexity param=0.01416836
##   mean=18.73514, MSE=8.351084 
##   left son=60 (17 obs) right son=61 (7 obs)
##   Primary splits:
##       TV < 197.25 to the right, improve=0.2468245, (0 missing)
## 
## Node number 31: 8 observations
##   mean=20.94211, MSE=3.105486 
## 
## Node number 60: 17 observations
##   mean=17.42475, MSE=4.908739 
## 
## Node number 61: 7 observations
##   mean=20.30815, MSE=7.947711

4.6.2 Representar visualmente el arbol 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
## 1   230.1  37.8      69.2  22.1    16.421875
## 2    44.5  39.3      45.1  10.4     8.136016
## 6     8.7  48.9      75.0   7.2     8.136016
## 7    57.5  32.8      23.5  11.8     8.136016
## 8   120.2  19.6      11.6  13.2    16.725560
## 11   66.1   5.8      24.2   8.6     8.136016
## 18  281.4  39.6      55.8  24.4    19.453949
## 20  147.3  23.9      19.1  14.6    16.725560
## 23   13.2  15.9      49.6   5.6     8.136016
## 25   62.3  12.6      18.3   9.7     8.136016
## 30   70.6  16.0      40.8  10.5    12.511593
## 31  292.9  28.3      43.2  21.4    19.453949
## 34  265.6  20.0       0.3  17.4    19.453949
## 36  290.7   4.1       8.5  12.8    19.453949
## 37  266.9  43.8       5.0  25.4    19.453949
## 40  228.0  37.7      32.0  21.5    16.421875
## 43  293.6  27.7       1.8  20.7    19.453949
## 45   25.1  25.7      43.3   8.5     8.136016
## 56  198.9  49.4      60.0  23.7    17.424751
## 60  210.7  29.5       9.3  18.4    17.424751
## 62  261.3  42.7      54.7  24.2    19.453949
## 68  139.3  14.5      10.2  13.4    16.725560
## 70  216.8  43.9      27.2  22.3    20.942105
## 77   27.5   1.6      20.7   6.9     8.136016
## 79    5.4  29.9       9.4   5.3     8.136016
## 80  116.0   7.7      23.1  11.0    12.511593
## 81   76.4  26.7      22.3  11.8    12.511593
## 84   68.4  44.5      35.6  13.6    12.511593
## 94  250.9  36.5      72.3  22.2    19.453949
## 97  197.6   3.5       5.9  11.7    17.424751
## 98  184.9  21.0      22.0  15.5    20.308148
## 101 222.4   4.3      49.8  11.7    16.421875
## 107  25.0  11.0      29.7   7.2     8.136016
## 108  90.4   0.3      23.2   8.7    12.511593
## 117 139.2  14.3      25.6  12.2    16.725560
## 120  19.4  16.0      22.3   6.6     8.136016
## 122  18.8  21.7      50.4   7.0     8.136016
## 124 123.1  34.6      12.4  15.2    16.725560
## 126  87.2  11.8      25.9  10.6    12.511593
## 136  48.3  47.0       8.5  11.6     8.136016
## 137  25.6  39.0       9.3   9.5     8.136016
## 151 280.7  13.9      37.0  16.1    19.453949
## 153 197.6  23.3      14.2  16.6    17.424751
## 154 171.3  39.7      37.7  19.0    16.725560
## 158 149.8   1.3      24.3  10.1    16.725560
## 161 172.5  18.1      30.7  14.4    16.725560
## 163 188.4  18.1      25.6  14.9    20.308148
## 164 163.5  36.8       7.4  18.0    16.725560
## 170 284.3  10.6       6.4  15.0    19.453949
## 173  19.6  20.1      17.0   7.6     8.136016
## 174 168.4   7.1      12.8  11.7    16.725560
## 180 165.6  10.0      17.6  12.6    16.725560
## 181 156.6   2.6       8.3  10.5    16.725560
## 189 286.0  13.9       3.7  15.9    19.453949
## 191  39.5  41.1       5.8  10.8     8.136016
## 192  75.5  10.8       6.0   9.9    12.511593
## 195 149.7  35.6       6.0  17.3    16.725560
## 199 283.6  42.0      66.2  25.5    19.453949

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 que fue de 1.590948 y este modelo de árbol de regresión se obtiene un valor de rmse de 1.455681, por lo tanto bajo este criterio el modelo de árbol de regresión es mejor comparado con el modelo de regresión múltiple.

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

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 
## 16.72556 16.72556

5 Interpretación

Para la realización del Caso 4 que es Árbol de Regresión se siguió usando los datos del FIFA, de forma continua se sigue utilizando el conjunto de datos que de Advertising. Como en los casos anteriores se busca con los datos de entrenamiento entrenar al algoritmo y validar los datos y resultados con los mismos datos utilizando la semilla 2022, pero para estos casos se recure a los últimos 4 dígitos del numero del control. Para ello se utiliza los datos de entrenamiento permitiendo tener 141 observaciones. Teniendo un total de 15 nodos para el árbol de regresión. En la construcción del árbol se nos especifica como esta formado el árbol, lo que es node), split, n, deviance, yval, * denotes terminal node. Tomando como variable de importancia la TV.

El árbol de regresiones tambien nos permite hacer predicciones para poder evaluar si de cierta forma el algorimo utilizado esta funcinando y utilizando los datos de forma correcta. Tambien se pudo evaluar las preducciones con el rmse obtiendo una metrica de 3.5174634. La grafica ayuda bastante a ver lo cercano o lejano que estuvo las predicciones de los datos reales, y se puede observar que en ciertos puntos los valores que fueron predecidos no se acercaron bastante a los valores reales o incluso en algunos casos llegaron a sobrepasarlos.