Informe de Aplicación de Regresión Lineal Multiple
MAESTRÍA EN CIENCIA DE DATOS UNIVERSIDAD JAVERIANA DE CALI
MÉTODOS ESTADÍSTICOS PARA LA TOMA DE DECISIONES
Carolina Galindres Bernal, Adrian Rodriguez Amaya
APLICACIÓN DE REGRESIÓN LINEAL MÚLTIPLE
El presente informe se ha elaborado a partir de los datos descargados a través de una herramienta de web scraping para la página OLX, puntualmente se han descargado todas las publicaciones referente al modelo de auto Mazda 2 para toda Colombia. A continuación, presentamos los datos obtenidos:
head(data)## # A tibble: 6 × 6
## precio kilometraje modelo transmision ciudad departamento
## <dbl> <dbl> <dbl> <chr> <chr> <chr>
## 1 51900000 30300 2016 Mecánica Manizales Caldas
## 2 33900000 103000 2011 Automática Usaquén Bogotá
## 3 33500000 124000 2011 Mecánica Floridablanca Santander
## 4 90000000 13471 2022 Automática Medellín Antioquia
## 5 34000000 119700 2009 Mecánica Manizales Caldas
## 6 78500000 21000 2021 <NA> Cali Valle del CaucaUna vez cargados los datos, procedemos a realizar una exploración de estos, con la finalidad de obtener el tipo de dato y otra información relevante relacionada. Así:
summary(data)## precio kilometraje modelo transmision
## Min. :22000000 Min. : 5000 Min. :2007 Length:80
## 1st Qu.:36225000 1st Qu.: 42000 1st Qu.:2011 Class :character
## Median :44250000 Median : 77942 Median :2015 Mode :character
## Mean :49762875 Mean : 75372 Mean :2015
## 3rd Qu.:62625000 3rd Qu.:102250 3rd Qu.:2018
## Max. :90000000 Max. :148000 Max. :2022
## ciudad departamento
## Length:80 Length:80
## Class :character Class :character
## Mode :character Mode :character
##
##
## Como podemos observar, las variables modelo, transmisión, ciudad y departamento son de tipo “character”, por tanto, es necesario modificar el tipo de dato a “factor”.
data$modelo = as.factor(data$modelo)
data$transmision = as.factor(data$transmision)
data$ciudad = as.factor(data$ciudad)
data$departamento = as.factor(data$departamento)
summary(data)## precio kilometraje modelo transmision
## Min. :22000000 Min. : 5000 2011 : 9 Automática :36
## 1st Qu.:36225000 1st Qu.: 42000 2015 : 8 Automática Secuencial: 4
## Median :44250000 Median : 77942 2019 : 8 Mecánica :37
## Mean :49762875 Mean : 75372 2010 : 6 NA's : 3
## 3rd Qu.:62625000 3rd Qu.:102250 2014 : 6
## Max. :90000000 Max. :148000 2016 : 6
## (Other):37
## ciudad departamento
## Medellín :15 Antioquia :21
## Cali :12 Valle del Cauca:12
## Manizales : 7 Bogotá :11
## Bucaramanga: 4 Caldas : 7
## Ibagué : 4 Santander : 7
## Suba : 4 Colombia : 6
## (Other) :34 (Other) :16Ahora, para la variable transmisión observamos que contiene algunos valores faltantes; estos valores deben ser eliminados, ya que al reemplazarlos por la moda pudieran generar información impresisa al comprador.
df = data[!(is.na(data$transmision)), ]
summary(df)## precio kilometraje modelo transmision
## Min. :22000000 Min. : 5000 2011 : 9 Automática :36
## 1st Qu.:36000000 1st Qu.: 42000 2019 : 8 Automática Secuencial: 4
## Median :44500000 Median : 76885 2015 : 7 Mecánica :37
## Mean :49630260 Mean : 75386 2010 : 6
## 3rd Qu.:62500000 3rd Qu.:102000 2016 : 6
## Max. :90000000 Max. :148000 2017 : 6
## (Other):35
## ciudad departamento
## Medellín :15 Antioquia :21
## Cali :11 Bogotá :11
## Manizales : 6 Valle del Cauca:11
## Bucaramanga: 4 Santander : 7
## Ibagué : 4 Caldas : 6
## Suba : 4 Colombia : 5
## (Other) :33 (Other) :16En este punto contamos con el dataset correcto para iniciar con el análisis exploratorio entre el precio y las demás variables dentro del conjunto de datos. Así:
plt_precio_km = ggplot(mapping = aes(x = df$kilometraje, y = df$precio)) + geom_point() +
ylab('Precio') + xlab('Kilometraje') + ggtitle(label = 'Análisis Precio vs Kilometraje') +
theme(plot.title = element_text(hjust = 0.5))
plt_precio_modelo = ggplot(mapping = aes(x = df$modelo, y = df$precio, fill = df$modelo)) + geom_boxplot() +
ylab('Precio') + xlab('Modelo') + ggtitle(label = 'Análisis Precio vs Modelo') +
theme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + theme(legend.position="none") + labs(fill = element_blank())
plt_precio_transmision = ggplot(mapping = aes(x = df$transmision, y = df$precio, fill = df$transmision)) + geom_boxplot() +
ylab('Precio') + xlab('Transmisión') + ggtitle(label = 'Análisis Precio vs Transmisión') +
theme(plot.title = element_text(hjust = 0.5)) + theme(legend.position="none") + labs(fill = '')
plt_precio_depto = ggplot(mapping = aes(x = df$departamento, y = df$precio, fill = df$departamento)) + geom_boxplot() +
ylab('Precio') + xlab('Departamento') + ggtitle(label = 'Análisis Precio vs Departamento') +
theme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + theme(legend.position="none") + labs(fill = element_blank())plt_precio_km
De acuerdo con la gráfica entre el “Precio vs Kilometraje” podemos apreciar que a medida que el kilometraje del vehículo es menor, su precio de venta aumenta; lo contrario sucede cuando el kilometraje es mayor, el precio tiende a disminuir.
ggplotly(plt_precio_modelo)Con respeco a la gráfica entre el “Precio vs Modelo” podemos evidenciar que los modelos más recientes tienden a tener un precio mayor, lo que es lógico; mientras que modelos mucho más antiguos su precio disminuye considerablemente.
ggplotly(plt_precio_transmision)Ahora, la gráfica entre el “Precio vs Transmisión” nos ilustra que los modelos de autos con transmisión automática la media del precio de vehículos de este tipo es la mayor; sucede lo contrario con los vehículos transmisión mecánica, su media es menor. Los autos con transmisión Automática Secuencial mantienen su media de precio entre ambos extremos.
ggplotly(plt_precio_depto)En esta última gráfica del “Precio vs Departamento” podemos observar que algunos departamentos manejan un precio medio inferior al de los demás departamentos; este es el caso para Antioquia, Caldas, Nariño y Bogotá D.C.
Una vez realizada la exploración de los datos, procederemos a plantear un modelo de regresión lineal múltiple que nos permita calcular el precio de acuerdo con ciertas variables como modelo, kilometraje, transmisión, entre otros que se definan.
Partiremos aplicando un escenario 80-20, 80% de los datos para realizar el modelamiento y el 20% para validar dicho modelo. Iniciamos segementando los datos objeto del estudio:
muestra = sample(1:77, 61)
df_mod = df[muestra, ]
df_val = df[-muestra, ]Luego de definir los datos que se usarán para el modelamiento y los que se utilizarán para la validación, plantaremos algunas combinaciones para encontrar el modelo que mejor se ajuste a nuestra necesidades. A continuación modelos observar los resultados para cada uno de los modelos:
Modelo 1
mod_1 = lm(precio ~ kilometraje, data = df_mod)
summary(mod_1)##
## Call:
## lm(formula = precio ~ kilometraje, data = df_mod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -18342163 -5027160 -590244 4963463 18365425
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.758e+07 2.110e+06 36.76 <2e-16 ***
## kilometraje -3.717e+02 2.494e+01 -14.90 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7381000 on 59 degrees of freedom
## Multiple R-squared: 0.7901, Adjusted R-squared: 0.7865
## F-statistic: 222 on 1 and 59 DF, p-value: < 2.2e-16Modelo 2
mod_2 = lm(precio ~ kilometraje + transmision, data = df_mod)
summary(mod_2)##
## Call:
## lm(formula = precio ~ kilometraje + transmision, data = df_mod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -16383658 -4930628 58261 5193362 16521804
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 78714307.0 2178017.9 36.140 <2e-16 ***
## kilometraje -358.8 25.0 -14.355 <2e-16 ***
## transmisionAutomática Secuencial 1102182.9 4388640.9 0.251 0.8026
## transmisionMecánica -4123577.5 1950608.3 -2.114 0.0389 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7197000 on 57 degrees of freedom
## Multiple R-squared: 0.8072, Adjusted R-squared: 0.797
## F-statistic: 79.53 on 3 and 57 DF, p-value: < 2.2e-16Modelo 3
mod_3 = lm(precio ~ kilometraje + transmision + modelo, data = df_mod)
summary(mod_3)##
## Call:
## lm(formula = precio ~ kilometraje + transmision + modelo, data = df_mod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9492438 -1789618 0 1651297 10395921
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.096e+07 6.898e+06 5.938 4.88e-07 ***
## kilometraje -2.659e+01 3.739e+01 -0.711 0.480911
## transmisionAutomática Secuencial -3.343e+05 2.474e+06 -0.135 0.893163
## transmisionMecánica -2.024e+06 1.117e+06 -1.812 0.077062 .
## modelo2008 -7.618e+06 4.342e+06 -1.754 0.086644 .
## modelo2009 -1.753e+06 5.510e+06 -0.318 0.752000
## modelo2010 -3.875e+06 4.634e+06 -0.836 0.407738
## modelo2011 -1.165e+06 4.317e+06 -0.270 0.788618
## modelo2012 -1.457e+06 4.762e+06 -0.306 0.761127
## modelo2013 2.646e+06 4.812e+06 0.550 0.585260
## modelo2014 3.285e+06 4.811e+06 0.683 0.498450
## modelo2015 7.382e+06 4.926e+06 1.499 0.141458
## modelo2016 1.641e+07 5.372e+06 3.055 0.003900 **
## modelo2017 2.115e+07 5.688e+06 3.718 0.000589 ***
## modelo2018 2.605e+07 5.943e+06 4.383 7.66e-05 ***
## modelo2019 2.561e+07 5.698e+06 4.494 5.40e-05 ***
## modelo2020 2.678e+07 6.805e+06 3.936 0.000306 ***
## modelo2021 3.261e+07 6.570e+06 4.964 1.20e-05 ***
## modelo2022 4.754e+07 7.150e+06 6.648 4.64e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3823000 on 42 degrees of freedom
## Multiple R-squared: 0.9599, Adjusted R-squared: 0.9427
## F-statistic: 55.86 on 18 and 42 DF, p-value: < 2.2e-16Modelo 4
df_mod2 = df_mod[!df_mod$transmision == 'Automática Secuencial', ]
mod_4 = lm(precio ~ kilometraje + transmision, data = df_mod2)
summary(mod_4)##
## Call:
## lm(formula = precio ~ kilometraje + transmision, data = df_mod2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -16370233 -4843291 142769 4834984 16560288
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 78489425.6 2142111.5 36.641 <2e-16 ***
## kilometraje -355.4 24.7 -14.390 <2e-16 ***
## transmisionMecánica -4183244.9 1907070.4 -2.194 0.0325 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7033000 on 55 degrees of freedom
## Multiple R-squared: 0.8127, Adjusted R-squared: 0.8059
## F-statistic: 119.3 on 2 and 55 DF, p-value: < 2.2e-16Una vez evaluadas algunas combinaciones para el mejor modelo de regresión lineal múltiple para calcular el precios de vehículos Mazda 2, concluimos el mejor modelo que representa al dataset es el número 3; en donde obtuvimos un R-squared de ~0.93.
A partir del modelo calculado, realizaremos una validación cruzada con respecto a los datos de validación (20%). Así:
#df_val2 = df_val[!df_val$transmision == 'Automática Secuencial', ]
data_val = predict(mod_3, newdata = df_val)
error = (df_val$precio - data_val)
res = data.frame('Precio Real' = df_val$precio, 'Precio Calculado' = data_val, 'Error' = error)
head(res)## Precio.Real Precio.Calculado Error
## 1 33900000 37055532 -3155532
## 2 64900000 60270372 4629628
## 3 31900000 36535061 -4635061
## 4 41500000 44548668 -3048668
## 5 64000000 58804983 5195017
## 6 57500000 58630012 -1130012MAE = mean(abs(res$Error))
MAE## [1] 3346927RMSE = sqrt(sum(res$Error^2)/length(res$Error))
RMSE## [1] 4057747porc_error_mae = MAE / (mean(df_val$precio))
porc_error_mae## [1] 0.0665848porc_error_rmse = RMSE / (mean(df_val$precio))
porc_error_rmse## [1] 0.08072608Se concluye que el modelo nos permite predecir el precio de un vehículo Mazda 2 de acuerdo a las variables predictoras: Kilometraje, Transmisión y Modelo. Esto nos ayuda a estimar si el precio propuesto para un modelo en particular se ajusta al precio del mercado y que no se encuentra sub o sobre valorado.
A partir de este modelo podemos representar el precio en un ~93%, con un MAE de ~3,3 millones y un RMSE de ~3,8 millones, lo cuál corresponde a errores del 6,6% y 7,7% respectivamente; este resultado se considera aceptable para estimar el valor de este tipo de vehículo.