Construir y evaluar un modelo de regresión lineal múltiple para realizar predicciones.
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.
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} \]
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
datos <- read.csv("https://raw.githubusercontent.com/rpizarrog/Analisis-Inteligente-de-datos/main/datos/Advertising.csv")
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.
Quitar la variable x que no es de interés
datos <- datos %>%
select (TV, Radio, Newspaper, Sales)
kable(head(datos, 20), caption = "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 |
kable(tail(datos, 20), caption = "Ú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 |
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, ]
kable(head(datos.entrenamiento, 20), caption = "Datos de Entrenamiento. Primeros 20 registros")
| TV | Radio | Newspaper | Sales | |
|---|---|---|---|---|
| 3 | 17.2 | 45.9 | 69.3 | 9.3 |
| 4 | 151.5 | 41.3 | 58.5 | 18.5 |
| 5 | 180.8 | 10.8 | 58.4 | 12.9 |
| 9 | 8.6 | 2.1 | 1.0 | 4.8 |
| 10 | 199.8 | 2.6 | 21.2 | 10.6 |
| 12 | 214.7 | 24.0 | 4.0 | 17.4 |
| 13 | 23.8 | 35.1 | 65.9 | 9.2 |
| 14 | 97.5 | 7.6 | 7.2 | 9.7 |
| 15 | 204.1 | 32.9 | 46.0 | 19.0 |
| 16 | 195.4 | 47.7 | 52.9 | 22.4 |
| 17 | 67.8 | 36.6 | 114.0 | 12.5 |
| 19 | 69.2 | 20.5 | 18.3 | 11.3 |
| 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 |
| 28 | 240.1 | 16.7 | 22.9 | 15.9 |
| 29 | 248.8 | 27.1 | 22.9 | 18.9 |
| 32 | 112.9 | 17.4 | 38.6 | 11.9 |
kable(tail(datos.entrenamiento, 20), caption = "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 |
Los datos de validación deben ser diferentes a los datos den entrenamiento.
kable(head(datos.validacion, 20), caption = "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 |
kable(tail(datos.validacion, 20), caption = "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 |
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
## 3.074487 0.045389 0.191655 -0.004896
summary(modelo.rm)
##
## Call:
## lm(formula = Sales ~ TV + Radio + Newspaper, data = datos.entrenamiento)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9.0532 -0.9034 0.2647 1.1303 2.8015
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.074487 0.378578 8.121 2.31e-13 ***
## TV 0.045389 0.001735 26.163 < 2e-16 ***
## Radio 0.191655 0.010228 18.738 < 2e-16 ***
## Newspaper -0.004896 0.006866 -0.713 0.477
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.702 on 138 degrees of freedom
## Multiple R-squared: 0.8916, Adjusted R-squared: 0.8893
## F-statistic: 378.5 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.
Las predicciones de las ventas ‘Sales’ matemáticamente serían: \[ Sales = 3.074487 + 0.045389\cdot{TV} + 0.191655\cdot{Radio} + -0.004896\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)
kable(x = head(comparaciones, 20), caption = "Predicciones")
| TV | Radio | Newspaper | Sales | predicciones | |
|---|---|---|---|---|---|
| 1 | 230.1 | 37.8 | 69.2 | 22.1 | 20.424363 |
| 2 | 44.5 | 39.3 | 45.1 | 10.4 | 12.405564 |
| 6 | 8.7 | 48.9 | 75.0 | 7.2 | 12.474123 |
| 7 | 57.5 | 32.8 | 23.5 | 11.8 | 11.855621 |
| 8 | 120.2 | 19.6 | 11.6 | 13.2 | 12.229949 |
| 11 | 66.1 | 5.8 | 24.2 | 8.6 | 7.067845 |
| 18 | 281.4 | 39.6 | 55.8 | 24.4 | 23.163427 |
| 20 | 147.3 | 23.9 | 19.1 | 14.6 | 14.247400 |
| 23 | 13.2 | 15.9 | 49.6 | 5.6 | 6.478105 |
| 25 | 62.3 | 12.6 | 18.3 | 9.7 | 8.227509 |
| 30 | 70.6 | 16.0 | 40.8 | 10.5 | 9.145709 |
| 31 | 292.9 | 28.3 | 43.2 | 21.4 | 21.581389 |
| 34 | 265.6 | 20.0 | 0.3 | 17.4 | 18.961559 |
| 36 | 290.7 | 4.1 | 8.5 | 12.8 | 17.013364 |
| 37 | 266.9 | 43.8 | 5.0 | 25.4 | 23.558954 |
| 40 | 228.0 | 37.7 | 32.0 | 21.5 | 20.492013 |
| 43 | 293.6 | 27.7 | 1.8 | 20.7 | 21.700866 |
| 45 | 25.1 | 25.7 | 43.3 | 8.5 | 8.927308 |
| 56 | 198.9 | 49.4 | 60.0 | 23.7 | 21.276460 |
| 60 | 210.7 | 29.5 | 9.3 | 18.4 | 18.246342 |
kable(x = head(comparaciones, 20), caption = "Predicciones")
| TV | Radio | Newspaper | Sales | predicciones | |
|---|---|---|---|---|---|
| 1 | 230.1 | 37.8 | 69.2 | 22.1 | 20.424363 |
| 2 | 44.5 | 39.3 | 45.1 | 10.4 | 12.405564 |
| 6 | 8.7 | 48.9 | 75.0 | 7.2 | 12.474123 |
| 7 | 57.5 | 32.8 | 23.5 | 11.8 | 11.855621 |
| 8 | 120.2 | 19.6 | 11.6 | 13.2 | 12.229949 |
| 11 | 66.1 | 5.8 | 24.2 | 8.6 | 7.067845 |
| 18 | 281.4 | 39.6 | 55.8 | 24.4 | 23.163427 |
| 20 | 147.3 | 23.9 | 19.1 | 14.6 | 14.247400 |
| 23 | 13.2 | 15.9 | 49.6 | 5.6 | 6.478105 |
| 25 | 62.3 | 12.6 | 18.3 | 9.7 | 8.227509 |
| 30 | 70.6 | 16.0 | 40.8 | 10.5 | 9.145709 |
| 31 | 292.9 | 28.3 | 43.2 | 21.4 | 21.581389 |
| 34 | 265.6 | 20.0 | 0.3 | 17.4 | 18.961559 |
| 36 | 290.7 | 4.1 | 8.5 | 12.8 | 17.013364 |
| 37 | 266.9 | 43.8 | 5.0 | 25.4 | 23.558954 |
| 40 | 228.0 | 37.7 | 32.0 | 21.5 | 20.492013 |
| 43 | 293.6 | 27.7 | 1.8 | 20.7 | 21.700866 |
| 45 | 25.1 | 25.7 | 43.3 | 8.5 | 8.927308 |
| 56 | 198.9 | 49.4 | 60.0 | 23.7 | 21.276460 |
| 60 | 210.7 | 29.5 | 9.3 | 18.4 | 18.246342 |
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')
rmse <- rmse(actual = comparaciones$Sales, predicted = comparaciones$predicciones)
rmse
## [1] 1.655584
El valor de Root Mean Square Error de 1.655584, habrá que evaluarlo y compararlo con otro modelo para ver eficiencia de los modelos.
Para la realización del Caso 3 que es Regresión Lineal Múltiple se siguió usando los datos del FIFA, pero para este caso se utilizo un conjunto de datos que de Advertising. El data.frame contiene 200 observaciones y 4 variables para su utilización, siendo TV, Radio, Newspapes y Sales. 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. El resultado de los coeficientes obtuvo que TV es de 0.045389, para Radio es 0.191655 y Newspaper es de -0.00496.
¿Que es lo que se busca? Se busca hacer predicciones con los datos de validación observando la diferencia que existe entre los datos reales con los datos de predichos determinando el Root Mean Standar Error (rmse), la raíz del error estándar medio es decir, la deferencia entre los valores predichos y los reales estadísticamente.
Se saca la métrica que es la raíz cuadrada del error estándar medio, que es la sumatoria de ciertos datos datos, elevados al cuadrado y se le saca el cuadrado, dividiéndolo entre n-1, obteniendo una métrica de 1.655584. Para saber el significado que tiene el rmse se tiene que evaluar con otro modelo que actué de manera similar para hacer una predicción de varias variables contra una sola.
Urrutia Mosquera, Jorge Andrés. 2011. “Evaluación de La Robustez de Un Modelo de Regresión múltiple Para Predecir Las Ventas Diarias de Un Hipermercado En Pereira, Risaralda.” https://www.researchgate.net/publication/237041228_EVALUACION_DE_LA_ROBUSTEZ_DE_UN_MODELO_DE_REGRESION_MULTIPLE_PARA_PREDECIR_LAS_VENTAS_DIARIAS_DE_UN_HIPERMERCADO_EN_PEREIRA_RISARALDA.
Walpole, Ronald E., Raymond H. Myers, and Sharon L. Myers. 2012b. Probabilidad y Estadística Para Ingeniería y Ciencias. Novena Edición. México: Pearson. ———. 2012c. Probabilidad y Estadística Para Ingeniería y Ciencias. Novena Edición. México: Pearson. ———. 2012a. Probabilidad y Estadística Para Ingeniería y Ciencias. Novena Edición. México: Pearson