Objetivo

Construir y evaluar un modelo de regresión lineal múltiple para realizar predicciones.

Descripción

Las métricas a valorar serán:

Marco teórico

En la mayoría de los problemas de investigación en los que se aplica el análisis de regresión se necesita más de una variable independiente para el modelo de regresión. La complejidad de la mayoría de mecanismos científicos es tal que, con el fin de predecir una respuesta importante, se requiere un modelo de regresión múltiple. Cuando un modelo es lineal en los coeficientes se denomina modelo de regresión lineal múltiple.

Para el caso de k variables independientes, el modelo que da \(x_1, x_2,..., x_k\), y \(y\) como la variable dependiente.\(x_1, x_,..., x_k\) son las variable s que afectan a la variable dependiente en el modelo de regresión lineal múltiple. [@walpole2012a]

Muchos problemas de de investigación y de la industria, requieren la estimación de las relaciones existentes entre el patrón de variabilidad de una variable aleatoria y los valores de una o más variables aleatorias. [@urrutiamosquera2011]

[@urrutia_mosquera_evaluacion_2011]

Al generar un modelo de regresión lineal múltiple es importante identificar los estadísticos de \(R^2\), que se denomina coeficiente de determinación y es una medida de la proporción de la variabilidad explicada por el modelo ajustado.

De igual forma, el valor de R2 ajustado o coeficiente de determinación ajustado, es una variación de R2 que proporciona un ajuste para los grados de libertad [@walpole_probabilidad_2012]. R Ajustado está diseñado para proporcionar un estadístico que castigue un modelo sobreajustado, de manera que se puede esperar que favorezca al modelo.[@walpole2012].

Una variable \(Y\) puede predecirse conforme y de cuerdo con

\[ y = b_0 + b_1{x_1} + b_2{x_2} + b_3{x_3}+ .....b_k{x_k} \]

Desarrollo

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

Cargar datos

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

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.

Limpiar datos

Quitar la variable x que no es de interés

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

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

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

Datos de entrenamiento y validación

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

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, ]

tail()

kable(tail(datos.entrenamiento, 20), caption = "Datos de entrenamiento ültimos 20 registros")
Datos de entrenamiento ültimos 20 registros
TV Radio Newspaper Sales
168 206.8 5.2 19.4 12.2
170 284.3 10.6 6.4 15.0
171 50.0 11.6 18.4 8.4
174 168.4 7.1 12.8 11.7
175 222.4 3.4 13.1 11.5
177 248.4 30.2 20.3 20.2
178 170.2 7.8 35.2 11.7
180 165.6 10.0 17.6 12.6
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
185 253.8 21.3 30.0 17.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
191 39.5 41.1 5.8 10.8
192 75.5 10.8 6.0 9.9
194 166.8 42.0 3.6 19.6
195 149.7 35.6 6.0 17.3
199 283.6 42.0 66.2 25.5

Datos de validación

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

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
4 151.5 41.3 58.5 18.5
7 57.5 32.8 23.5 11.8
10 199.8 2.6 21.2 10.6
13 23.8 35.1 65.9 9.2
15 204.1 32.9 46.0 19.0
22 237.4 5.1 23.5 12.5
30 70.6 16.0 40.8 10.5
32 112.9 17.4 38.6 11.9
33 97.2 1.5 30.0 9.6
36 290.7 4.1 8.5 12.8
46 175.1 22.5 31.5 14.9
50 66.9 11.7 36.8 9.7
53 216.4 41.7 39.6 22.6
54 182.6 46.2 58.7 21.2
61 53.5 2.0 21.4 8.1
64 102.7 29.6 8.4 14.0
66 69.0 9.3 0.9 9.3
70 216.8 43.9 27.2 22.3
71 199.1 30.6 38.7 18.3
80 116.0 7.7 23.1 11.0

tail()

kable(tail(datos.validacion, 20), caption = "Datos de validació últimos 20 registros")
Datos de validació últimos 20 registros
TV Radio Newspaper Sales
136 48.3 47.0 8.5 11.6
142 193.7 35.4 75.6 19.2
148 243.2 49.0 44.3 25.4
151 280.7 13.9 37.0 16.1
158 149.8 1.3 24.3 10.1
161 172.5 18.1 30.7 14.4
166 234.5 3.4 84.8 11.9
169 215.4 23.6 57.6 17.1
172 164.5 20.9 47.4 14.5
173 19.6 20.1 17.0 7.6
176 276.9 48.9 41.8 27.0
179 276.7 2.3 23.7 11.8
184 287.6 43.0 71.8 26.2
186 205.0 45.1 19.6 22.6
190 18.7 12.1 23.4 6.7
193 17.2 4.1 31.6 5.9
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

Construir el modelo

El modelo se construye con la función lm() en donde participa en la fórmula que la variable Sales (Sales ~ TV + Radio + Newspaper) está en función de las variables independientes del conjunto de datos de entrenamiento.

modelo.rm <- lm(data = datos.entrenamiento, formula = Sales ~ TV + Radio + Newspaper)
modelo.rm
## 
## Call:
## lm(formula = Sales ~ TV + Radio + Newspaper, data = datos.entrenamiento)
## 
## Coefficients:
## (Intercept)           TV        Radio    Newspaper  
##    2.711476     0.048195     0.177289    -0.000502

Summary modelo

summary(modelo.rm)
## 
## Call:
## lm(formula = Sales ~ TV + Radio + Newspaper, data = datos.entrenamiento)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -8.1615 -0.9784  0.2366  1.2456  2.8720 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.711476   0.381095   7.115 5.55e-11 ***
## TV           0.048195   0.001640  29.383  < 2e-16 ***
## Radio        0.177289   0.010771  16.460  < 2e-16 ***
## Newspaper   -0.000502   0.006768  -0.074    0.941    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.691 on 138 degrees of freedom
## Multiple R-squared:  0.8944, Adjusted R-squared:  0.8921 
## F-statistic: 389.8 on 3 and 138 DF,  p-value: < 2.2e-16

Con respecto a los coeficientes se observa que todos tienen un nivel de confianza por encima del 99% excepto la variable Newspaper.

Con respecto a la métrica R Square y R Square ajustada, se tiene: Multiple R-squared: 0.8984, Adjusted R-squared: 0.896 que está por encima del 80% por lo que se acepta el modelo.

Predicciones

Las predicciones de las ventas ‘Sales’ matemáticamente serían: \[ Sales = 2.620e00 + 4.809e-02\cdot{TV} + 1.873e-01\cdot{Radio} + 4.830e-06\cdot{Newspaper} \]

Se hará predicciones con la función predict() utilizando para ello los datos de validación, luego se observará la diferencia que existe entre los datos reales con los datos de predichos determinando el Root Mean Standar Error (rmse), la raiz del error estándar medio es decir, la deferencia entre los valores predichos y los reales estadísticamente.

Se hace un data.frame de comparaciones con lo cual se presentan los valores reales y los valores de las predicciones. Se presenta solo las primeras 20 y últimas 20 predicciones.

predicciones <- predict(object = modelo.rm, newdata = datos.validacion)
comparaciones <- data.frame(datos.validacion, predicciones)

head()

 kable(x = head(comparaciones, 20), caption = "Predicciones")
Predicciones
TV Radio Newspaper Sales predicciones
4 151.5 41.3 58.5 18.5 17.305750
7 57.5 32.8 23.5 11.8 11.285999
10 199.8 2.6 21.2 10.6 12.791216
13 23.8 35.1 65.9 9.2 10.048295
15 204.1 32.9 46.0 19.0 18.357871
22 237.4 5.1 23.5 12.5 15.045429
30 70.6 16.0 40.8 10.5 8.930213
32 112.9 17.4 38.6 11.9 11.218186
33 97.2 1.5 30.0 9.6 7.646936
36 290.7 4.1 8.5 12.8 17.444483
46 175.1 22.5 31.5 14.9 15.123677
50 66.9 11.7 36.8 9.7 7.991554
53 216.4 41.7 39.6 22.6 20.514032
54 182.6 46.2 58.7 21.2 19.673242
61 53.5 2.0 21.4 8.1 5.633762
64 102.7 29.6 8.4 14.0 12.904685
66 69.0 9.3 0.9 9.3 7.685294
70 216.8 43.9 27.2 22.3 20.929572
71 199.1 30.6 38.7 18.3 17.712794
80 116.0 7.7 23.1 11.0 9.655667

tail()

 kable(x = head(comparaciones, 20), caption = "Predicciones")
Predicciones
TV Radio Newspaper Sales predicciones
4 151.5 41.3 58.5 18.5 17.305750
7 57.5 32.8 23.5 11.8 11.285999
10 199.8 2.6 21.2 10.6 12.791216
13 23.8 35.1 65.9 9.2 10.048295
15 204.1 32.9 46.0 19.0 18.357871
22 237.4 5.1 23.5 12.5 15.045429
30 70.6 16.0 40.8 10.5 8.930213
32 112.9 17.4 38.6 11.9 11.218186
33 97.2 1.5 30.0 9.6 7.646936
36 290.7 4.1 8.5 12.8 17.444483
46 175.1 22.5 31.5 14.9 15.123677
50 66.9 11.7 36.8 9.7 7.991554
53 216.4 41.7 39.6 22.6 20.514032
54 182.6 46.2 58.7 21.2 19.673242
61 53.5 2.0 21.4 8.1 5.633762
64 102.7 29.6 8.4 14.0 12.904685
66 69.0 9.3 0.9 9.3 7.685294
70 216.8 43.9 27.2 22.3 20.929572
71 199.1 30.6 38.7 18.3 17.712794
80 116.0 7.7 23.1 11.0 9.655667

Valores Reales Sales Vs Prediciones

ggplot(data = comparaciones) +
  geom_line(aes(x = 1:nrow(comparaciones), y = Sales), col='red') +
  geom_line(aes(x = 1:nrow(comparaciones), y = predicciones), col='blue')

Evaluando con métrica rmse

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

El valor de Root Mean Square Error de 1.7535893, habrá que evaluarlo y compararlo con otro modelo para ver eficiencia de los modelos.

Interpretación

El valor final de RMSE fue de 1.75 y si vemos en la grafica de comparaciones, las predicciones siguieron la tendencia de los datos originales por lo que se puede decir que el modelo fue cercano a los valores reales como por ejemplo en el caso de la TV 151.5 del cual se predijo un valor de ventas de 17.3 y su valor real fue de 18.5 siendo la diferencia de 1.2, en este caso aunque parezca una gran diferencia en el ambito de ventas es una gran aproximacion ya que se manejan por numeros grandes.