MODELO DE REGRESIÓN CON DATOS DE VENTA DE VEHÍCULOS EN CALI

knitr::opts_chunk$set(echo = TRUE)

#cargar librerias necesarias
library(tidyverse)
library(caret)
library(GGally)
library(readxl)
library(ggplot2)
library(plotly)
library(lmtest)
## Warning: package 'lmtest' was built under R version 4.4.2
## Warning: package 'zoo' was built under R version 4.4.2

1. Análisis exploratorio de los datos

En este informe, nos enfocaremos en el análisis sobre diversos vehículos en la ciudad de Cali. Nuestro objetivo será identificar patrones y relaciones entre diferentes variables como kilometraje, modelo, vehículos, transmisión y combustile para entender mejor cómo se determinan los precios de estos vehículos.

#cargar los datos y revisar los primeros registros y estructura de los datos

library(readxl)
Datos_Vehiculos <- read_excel("C:/Users/valen/Datos_Vehiculos.xlsx")

View(Datos_Vehiculos)
head(Datos_Vehiculos)
str(Datos_Vehiculos)
summary(Datos_Vehiculos)
view(Datos_Vehiculos)
## # A tibble: 6 × 6
##     precio     km modelo vehiculos  transmision combustible
##      <dbl>  <dbl>  <dbl> <chr>      <chr>       <chr>      
## 1 38000000 111000   2011 kia cerato Mecánica    Gasolina   
## 2 46500000  65000   2014 kia cerato Mecánica    Gasolina   
## 3 43000000  86500   2013 kia cerato Mecánica    Gasolina   
## 4 35000000 134000   2011 kia cerato Mecánica    Gasolina   
## 5 48500000 112000   2015 kia cerato Mecánica    Gasolina   
## 6 43000000 105000   2012 kia cerato Automática  Gasolina   
## tibble [125 × 6] (S3: tbl_df/tbl/data.frame)
##  $ precio     : num [1:125] 38000000 46500000 43000000 35000000 48500000 43000000 52000000 56000000 74000000 40000000 ...
##  $ km         : num [1:125] 111000 65000 86500 134000 112000 105000 88000 78000 50000 140000 ...
##  $ modelo     : num [1:125] 2011 2014 2013 2011 2015 ...
##  $ vehiculos  : chr [1:125] "kia cerato" "kia cerato" "kia cerato" "kia cerato" ...
##  $ transmision: chr [1:125] "Mecánica" "Mecánica" "Mecánica" "Mecánica" ...
##  $ combustible: chr [1:125] "Gasolina" "Gasolina" "Gasolina" "Gasolina" ...
##      precio               km             modelo      vehiculos        
##  Min.   :24800000   Min.   :    90   Min.   :2010   Length:125        
##  1st Qu.:33000000   1st Qu.: 69000   1st Qu.:2013   Class :character  
##  Median :37000000   Median : 95000   Median :2015   Mode  :character  
##  Mean   :40887920   Mean   : 94908   Mean   :2015                     
##  3rd Qu.:46500000   3rd Qu.:117000   3rd Qu.:2017                     
##  Max.   :83000000   Max.   :228000   Max.   :2022                     
##  transmision        combustible       
##  Length:125         Length:125        
##  Class :character   Class :character  
##  Mode  :character   Mode  :character  
##                                       
##                                       
## 
#Convertir columnas categóricas a factor. Este paso es necesario para correr el modelo lineal como el de regresión. Así se entiende que esas variables son dummy

Datos_Vehiculos <- Datos_Vehiculos %>%
  mutate(
    vehiculos = as.factor(vehiculos),
    transmision = as.factor(transmision),
    combustible = as.factor(combustible)
  )
g1=ggplot(data =Datos_Vehiculos,mapping = aes(x= precio))+geom_histogram(fill="pink")+theme_bw()
ggplotly(g1)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

En el presente histograma podemos observar que la mayoria de los precios de los vehículos Kia cerato y chevrolet sail se encuentran en un rango promedio de 40 millones de pesos. La mayor cantidad de vehículos (17) tienen un precio aproximado de 34 millones. Tambien se puede observar que a medida que el precio de los vehículos aumenta, la cantidad de estos se reduce, por lo cual se puede concluir que hay una relación inversa entre estas dos variables.

2. Anális bivariado

Gráfico de dispersión

Precio y Modelo

ggplot(Datos_Vehiculos, aes(x = modelo, y = precio)) +
  geom_point(color = "purple") +
  geom_smooth(method = "lm", se = FALSE, color = "green") +
  labs(title = "Regresión Lineal Simple: Precio vs. Modelo",
       x = "Modelo", y = "Precio (Millones)")
## `geom_smooth()` using formula = 'y ~ x'

cor(Datos_Vehiculos$modelo,Datos_Vehiculos$precio , use = "complete.obs")
## [1] 0.3869018

El presente gráfico nos muestra la relación que hay entre la variable del precio y modelo donde se aprecia una relación lineal positiva no tan fuerte. Con una correlación de 0.38. Es posible que los modelos más recientes estén en mejor estado y tengan menor kilometraje lo que justificaria un mayor precio de venta.

Precio y km

g2=ggplot(data=Datos_Vehiculos,mapping = aes(x=km,y=precio))+geom_point()+theme_bw()+
  geom_smooth()
ggplotly(g2)
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
cor(Datos_Vehiculos$km,Datos_Vehiculos$precio, use = "complete.obs")
## [1] -0.2625166

Al revisar la relación entre las variables precio y kilometraje se aprecia una relación lineal negativa, con un coeficiente de correlación de -0.26, esto tiene sentido ya que, teniendo en cuenta que a mayor kilometraje hay mayor desgaste en el vehículo y el tiempo de salido del concesionario es mayor, por lo tanto el precio disminuye.

También encontramos valores atípicos que pueden corresponder a versiones especiales en valores superiores a $70.000.000 en la parte superior izquierda de la gráfica

Precio y Trasmisión

g4=ggplot(Datos_Vehiculos, mapping=aes(x=transmision, y=precio, fill=transmision)) + geom_boxplot()

ggplotly(g4)

Al analizar en conjunto las variables precio y transmisión se aprecia una mayor variación en los precios en los vehículos de transmisión automática, así mismo se aprecia una media de precio mayor en este tipo de transmisión ($56.000.000), también los vehículos de mayor precio tienen esta característica. A diferencia de la transmisión mecánica con una media de ($36.000.000).

3. Estimación del modelo de regresión lineal simple

A continuación vamos a estimar tres modelos de regresión lineal simple.

Precio vs kilometraje

Para el primer modelo de regresión lineal simple se ha escogido al kilometraje como variable predictora del precio.

Modelo_km=lm(precio~km , data=Datos_Vehiculos)
Modelo_km
## 
## Call:
## lm(formula = precio ~ km, data = Datos_Vehiculos)
## 
## Coefficients:
## (Intercept)           km  
##   4.825e+07   -7.753e+01

Podemos interpretar que por el incremento en 1 km del vehiculo el precio del vehículo disminuye en 0.07 pesos, tiene sentido ya que, cuando un vehiculo es nuevo y va aumentando su kilometraje así mismo se va depreciando su precio.

summary(Modelo_km)
## 
## Call:
## lm(formula = precio ~ km, data = Datos_Vehiculos)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -23438630  -8183000  -4732745   7616093  38397646 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.825e+07  2.653e+06  18.183   <2e-16 ***
## km          -7.753e+01  2.570e+01  -3.017   0.0031 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11690000 on 123 degrees of freedom
## Multiple R-squared:  0.06891,    Adjusted R-squared:  0.06135 
## F-statistic: 9.104 on 1 and 123 DF,  p-value: 0.003101

Podemos observar que este primer modelo es significativo y se logra explicar el 6.1%% de la variabilidad en el precio de venta. Es el de menor r2 de los 3 modelos.

AIC (Modelo_km)
## [1] 4427.232
BIC(Modelo_km)
## [1] 4435.717

Precio vs Modelo

Para el segundo modelo de regresión lineal simple se ha escogido al modelo como variable predictora del precio.

Modelo_modelo=lm(precio~modelo , data=Datos_Vehiculos)
Modelo_modelo
## 
## Call:
## lm(formula = precio ~ modelo, data = Datos_Vehiculos)
## 
## Coefficients:
## (Intercept)       modelo  
##  -3.792e+09    1.902e+06

Aquí se puede interpretar que por cada año adicional en el modelo del vehículo, quiere decir, que el vehículo sea más nuevo, su precio aumentará $1.902.000 pesos.

summary(Modelo_modelo)
## 
## Call:
## lm(formula = precio ~ modelo, data = Datos_Vehiculos)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -13985519  -9289326  -5489326   7916385  32906867 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -3.792e+09  8.236e+08  -4.604 1.02e-05 ***
## modelo       1.902e+06  4.087e+05   4.653 8.31e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11170000 on 123 degrees of freedom
## Multiple R-squared:  0.1497, Adjusted R-squared:  0.1428 
## F-statistic: 21.65 on 1 and 123 DF,  p-value: 8.308e-06

Podemos observar que este segundo modelo es significativo y se logra explicar el 14.28%% de la variabilidad en el precio de venta.

AIC (Modelo_modelo)
## [1] 4415.888
BIC(Modelo_modelo)
## [1] 4424.373

Precio vs Transmisión

Para el tercer modelo de regresión lineal simple se ha escogido al tipo de transimision como variable predictora del precio.

Modelo_trasmision=lm(precio~transmision , data=Datos_Vehiculos)
Modelo_trasmision
## 
## Call:
## lm(formula = precio ~ transmision, data = Datos_Vehiculos)
## 
## Coefficients:
##         (Intercept)  transmisionMecánica  
##            55590909            -17843433

Podemos interpretar que en promedio un carro con transmisión automática tiene un precio de $55.590.909, y si el vehículo tiene transmisón mecánica en promedio su precio será $17.843.433 más barato.

summary(Modelo_trasmision)
## 
## Call:
## lm(formula = precio ~ transmision, data = Datos_Vehiculos)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -29090909  -5847476  -1247476   4252524  37752524 
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          55590909    2129771  26.102  < 2e-16 ***
## transmisionMecánica -17843433    2346223  -7.605 6.34e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9990000 on 123 degrees of freedom
## Multiple R-squared:  0.3198, Adjusted R-squared:  0.3143 
## F-statistic: 57.84 on 1 and 123 DF,  p-value: 6.343e-12

Se observa en la tabla del modelo 3 que la variable transmisión es significativa en el modelo, el modelo logra explicar el 31.43% de la variabilidad en el precio de venta.

AIC (Modelo_trasmision)
## [1] 4387.98
BIC(Modelo_trasmision)
## [1] 4396.465

4. Mejor modelo

Para determinar el mejor modelo, se utilizó el criterio de información Akaika (AIC) y bayesiano (BIC) y se interpretó que el modelo de transmisión de vehículos es el mejor.También teniendo en cuenta que el mayor R2 lo tiene el modelo 3.

Validación cruzada

Se realiza validación cruzada con un escenario 70-30 (modelar validar) para evaluar el poder predictivo del modelo con MAE.

MAE
## function (pred, obs, na.rm = FALSE) 
## mean(abs(pred - obs), na.rm = na.rm)
## <bytecode: 0x000001748cf49128>
## <environment: namespace:caret>
set.seed(123) 
id_modelar = sample(1:nrow(Datos_Vehiculos), size = floor(0.7 * nrow(Datos_Vehiculos))) 
datos_modelar = Datos_Vehiculos[id_modelar,]
datos_validar = Datos_Vehiculos[-id_modelar,]


mod_mrls3_modelar = lm(precio ~ transmision, data = datos_modelar)


precio_pred = predict(mod_mrls3_modelar, newdata = datos_validar)

precio_real = datos_validar$precio
error = precio_real - precio_pred
res = data.frame(precio_real, precio_pred, error)

MAE = mean(abs(error)) 
MAE
## [1] 6984029

La validación cruzada en un primer paso, se segmenta los datos dejando 70% para el modelo y 30% aleatorios para validar. Luego se ajusta el modelo con el 70%. Comparando el resultado del modelo contra los reales por medio del MAE encontramos que el modelo tiene un error de predicción en el precio de venta de $6.984.029 pesos.

Regresión Lineal Multiple

1. Propuesta de 2 modelos de regresión lineal múltiple

A continuación vamos a estimar 2 modelos de regresión lineal multiple.

Modelo de Regresión Lineal Multiple 1

y=Datos_Vehiculos$precio
x=Datos_Vehiculos$km
x1=Datos_Vehiculos$modelo
x2=Datos_Vehiculos$transmision
x3=Datos_Vehiculos$vehiculos


m4=lm(y~x+x1+x2+x3)

summary(m4)
## 
## Call:
## lm(formula = y ~ x + x1 + x2 + x3)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -7329070 -2679042  -159273  2091920 20499075 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -6.797e+09  4.149e+08 -16.382  < 2e-16 ***
## x             1.723e+01  1.128e+01   1.528 0.129176    
## x1            3.390e+06  2.054e+05  16.502  < 2e-16 ***
## x2Mecánica   -4.608e+06  1.188e+06  -3.880 0.000171 ***
## x3kia cerato  1.998e+07  9.678e+05  20.645  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4348000 on 120 degrees of freedom
## Multiple R-squared:  0.8743, Adjusted R-squared:  0.8701 
## F-statistic: 208.6 on 4 and 120 DF,  p-value: < 2.2e-16
AIC(m4)
## [1] 4182.95

Se observa en la tabla del summary se hace presente la multicolinealidad al incluir todos las variables,excepto combustible ya que solo tiene un valor que es “gasolina” por lo que no sería relevante, asimismo, se tiene una mayor complejidad en el modelo. Las variables significativas con un intervalo de confianza del 95% son modelo (x1), vehículos (x2) y transmisión (x3). Este modelo logra explicar el 87.43% de la variabilidad en el precio de venta de los vehículos en Cali.

Así mismo posee un criterio de Akaike (AIC) de 4182,95 muestra de la complejidad del mismo.

mae1 <- predict(m4)

errores1 <- abs(y - mae1)

MAEE1 <- mean(errores1)

print(MAEE1)
## [1] 3153239

Tras calcular el MAE del modelo 1 de regresión lineal múltiple encontramos un valor de $3.153.239, monto por el que en promedio era el modelo en la predicción.

Supuestos del Modelo de RLM 1

par(mfrow=c(2,2))
plot(m4)

bptest(m4)
## 
##  studentized Breusch-Pagan test
## 
## data:  m4
## BP = 25.082, df = 4, p-value = 4.845e-05
shapiro.test(resid(m4))
## 
##  Shapiro-Wilk normality test
## 
## data:  resid(m4)
## W = 0.92786, p-value = 4.756e-06
residuos = residuals(m4)
media_residuos = mean(residuos)
print(media_residuos)
## [1] 2.269226e-10

Tras la revisión de gráficos para evaluar los supuestos de normalidad y homocedasticidad se encuentra que el modelo 1, cumple razonablemente con el supuesto de normalidad, donde los residuales se ajustan a a la línea en el gráfico Q-Q a pesar de una desviación en la mitad, pero al realizar el test Shapiro Wilk encontramos un Valor p menor a 5% por lo tanto los errores no siguen una distribución normal, violando este supuesto.lo cual puede afectar la validez de los intervalos de confianza y las pruebas de hipótesis.

Para el supuesto de homocedasticiadad encontramos en los gráficos indicios de heterocedasticidad, al revisar los resultados de la prueba Breusch Pagan encontramos un valor p de 0.00004845. por lo tanto se rechaza la hipótesis nula de homocedasticidaad, lo que indica que si hay heterocedasticidad en el modelo.

Finalmente para el supuesto de media del error = 0 encontramos que el valor de la media en el modelo 1 es muy cercano a cero.

Modelo de Regresión Lineal Multiple 2

Para el segundo modelo de regresión lineal múltiple, se ha aplicado proceso de selección de variables, este indica que el modelo que incluye las variables kilometraje (x), modelo (x1), vehículos (x2) y transmisión (x3) es suficiente para explicar el precio de venta.

m5=step(m4)
## Start:  AIC=3826.21
## y ~ x + x1 + x2 + x3
## 
##        Df  Sum of Sq        RSS    AIC
## <none>               2.2688e+15 3826.2
## - x     1 4.4136e+13 2.3129e+15 3826.6
## - x2    1 2.8458e+14 2.5534e+15 3839.0
## - x1    1 5.1488e+15 7.4176e+15 3972.3
## - x3    1 8.0587e+15 1.0328e+16 4013.7
summary(m5)
## 
## Call:
## lm(formula = y ~ x + x1 + x2 + x3)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -7329070 -2679042  -159273  2091920 20499075 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -6.797e+09  4.149e+08 -16.382  < 2e-16 ***
## x             1.723e+01  1.128e+01   1.528 0.129176    
## x1            3.390e+06  2.054e+05  16.502  < 2e-16 ***
## x2Mecánica   -4.608e+06  1.188e+06  -3.880 0.000171 ***
## x3kia cerato  1.998e+07  9.678e+05  20.645  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4348000 on 120 degrees of freedom
## Multiple R-squared:  0.8743, Adjusted R-squared:  0.8701 
## F-statistic: 208.6 on 4 and 120 DF,  p-value: < 2.2e-16

Se observa en la tabla del summary del modelo 2 que se hace presente la multicolinealidad al incluir la variable kilometraje y modelo como variables predictoras, estas presentan un coeficiente de correlación de -0.69. En este caso, la variable kilometraje (x) no es significativa estando la variable modelo.

Este modelo logra explicar el 87.43% de la variabilidad en el precio de venta.

Así mismo posee un criterio de Akaike (AIC) de 3826.21 de acuerdo a la selección de variables, inferior al modelo 1.

mae2 <- predict(m5)

errores2 <- abs(y - mae2)

MAEE2 <- mean(errores2)

print(MAEE2)
## [1] 3153239

Tras calcular el MAE del modelo 2 de regresión lineal múltiple encontramos un valor de $3.153.239, monto por el que en promedio era el modelo en la predicción.

Supuestos del Modelo de RLM 2

par(mfrow=c(2,2))
plot(m5)

bptest(m5)
## 
##  studentized Breusch-Pagan test
## 
## data:  m5
## BP = 25.082, df = 4, p-value = 4.845e-05
shapiro.test(resid(m5))
## 
##  Shapiro-Wilk normality test
## 
## data:  resid(m5)
## W = 0.92786, p-value = 4.756e-06
residuos1 = residuals(m5)
media_residuos1 = mean(residuos1)
print(media_residuos1)
## [1] 2.269226e-10

Tras la revisión de gráficos para evaluar los supuestos de normalidad y homocedasticidad se encuentra que el modelo 2, cumple razonablemente con el supuesto de normalidad, donde los residuales se ajustan a a la línea en el gráfico Q-Q a pesar de una desviación en los extremos, pero al realizar el test Shapiro Wilk encontramos un Valor p menor a 5% por lo tanto los errores no siguen una distribución normal, violando este supuesto.

Para el supuesto de homocedasticiadad encontramos en los gráficos indicios de heterocedasticidad, al revisar los resultados de la prueba Breusch Pagan encontramos un valor p de 0.00004845. por lo tanto no se cumple el supuesto de homocedasticiadad

Finalmente para el supuesto de media del error = 0 encontramos que el valor de la media en el modelo 1 es muy cercano a cero.

2. Mejor modelo MRLM (MRLM 2)

Todos los modelos presentados no cumplen con el supuesto de normalidad, ninguno cumple con el supuesto de homocedasticidad, pero si se cumple el supuesto de media del error = 0.

Aunque los 2 presenta un R2 de (87.43%), el modelo 2 presenta un valor AIC menor, es menos complejo.

Por estas razones se elige al modelo 2 cómo el mejor modelo de regresión lineal múltiple.

2. Transformación de Modelo de RLM 2

Teniendo en cuenta que el modelo 2 no cumple con el supuesto de normalidad, se aplicara una transformación Lin-Log, aplicando logaritmo a las variables predictoras cuantitativas para intentar mejorar la normalidad de los residuos.

library(readxl)

constante=1

x_transformado <- x + constante
x1_transformado <- x1 + constante

x_log <- log(x_transformado)
x1_log <- log(x1_transformado)

m5l <- lm(y ~ x_log + x1_log + x2)

summary(m5l)
## 
## Call:
## lm(formula = y ~ x_log + x1_log + x2)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -26359694  -6460322  -2989347   6866054  26595342 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -2.587e+10  5.394e+09  -4.797 4.64e-06 ***
## x_log        5.694e+05  7.633e+05   0.746    0.457    
## x1_log       3.407e+09  7.086e+08   4.808 4.43e-06 ***
## x2Mecánica  -1.668e+07  2.179e+06  -7.656 5.21e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9220000 on 121 degrees of freedom
## Multiple R-squared:   0.43,  Adjusted R-squared:  0.4159 
## F-statistic: 30.43 on 3 and 121 DF,  p-value: 9.926e-15
AIC(m5l)
## [1] 4369.888
mae4 <- predict(m5l)

errores4 <- abs(y - mae4)

MAEE4 <- mean(errores4)

print(MAEE4)
## [1] 7610527

Tras calcular el MAE del modelo 2 de regresión lineal múltiple encontramos un valor de $7.610,monto por el que en promedio era el modelo en la predicción, este MAE es superior al del modelo sin transformación que posee un valor de $3.153.239

Supuestos del Modelo de RLM 2

par(mfrow=c(2,2))
plot(m5)

bptest(m5)
## 
##  studentized Breusch-Pagan test
## 
## data:  m5
## BP = 25.082, df = 4, p-value = 4.845e-05
shapiro.test(resid(m5))
## 
##  Shapiro-Wilk normality test
## 
## data:  resid(m5)
## W = 0.92786, p-value = 4.756e-06
residuos1 = residuals(m5)
media_residuos1 = mean(residuos1)
print(media_residuos1)
## [1] 2.269226e-10

Tras la revisión de gráficos para evaluar los supuestos de normalidad y homocedasticidad se encuentra que el modelo 2 transformado, no mejora la distribución de los residuales, con un valor p de la prueba Shapiro Wilk que rechaza que los datos provienen de una distribución normal.

Continua cumpliendo la media = 0 de los errores y tampoco mejora la homocedasticidad.

Predicción

Aunque el modelo transformado (MRLM 2 Lin-Log) tiene un R2 ligeramente mayor, el modelo sin transformación (MRLM 2) tiene un AIC considerablemente inferior y un MAE comparable. Por lo tanto, se prioriza la simplicidad del modelo y un buen ajuste a los datos usando para la predicción el modelo sin transformación MRLM 2.