#Cargar librerías necesarias
library(tidyverse)
library(GGally)
library(caret)
## Warning: package 'caret' was built under R version 4.4.2
library(readxl)
library(ggplot2)
library(readxl)
library(plotly)
library(lsr)
## Warning: package 'lsr' was built under R version 4.4.2
Tenemos a mano las bases de datos relacionadas al precio de la venta de carros Mazda 2 que se publicaron en la plataforma OLX. Nuestro objectivo entonces sera encontrar un modelo de regresion lineal que explique lo mejor posible el comportamiento de los precios de estos autos, y podamos, en lo mejor posible, utilizarlo para hacer predicciones y sacar conclusiones acertadas.
Para esto haremos un analisis de regresion lineal simple (se propondran 3 modelos) y un analisis de regresion multiple (se propondran tres modelos), se haran evaluaciones y al final escogeremos cual es el mejor para nuestros objetivos.
Datos <- read_excel("C:/Users/santi/Downloads/base1_mazdacol.xlsx")
#Estructura general de los datos
summary(Datos)
## web-scraper-order web-scraper-start-url link link-href
## Length:314 Length:314 Length:314 Length:314
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## precio kilometraje transmision modelo
## Min. : 6800000 Min. : 0 Length:314 Min. :1995
## 1st Qu.: 35000000 1st Qu.: 39125 Class :character 1st Qu.:2011
## Median : 42000000 Median : 79000 Mode :character Median :2015
## Mean : 50467516 Mean : 74996 Mean :2015
## 3rd Qu.: 63000000 3rd Qu.:107375 3rd Qu.:2018
## Max. :169800000 Max. :280000 Max. :2022
## color ciudad Dpto
## Length:314 Length:314 Length:314
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
Veamos si los datos poseen valores faltantes (o NA)
colSums(is.na(Datos))
## web-scraper-order web-scraper-start-url link
## 0 0 0
## link-href precio kilometraje
## 0 0 0
## transmision modelo color
## 0 0 0
## ciudad Dpto
## 0 0
Luego vemos que no asi que no es necesario aplicarle un proceso de depuracion o limpieza para eliminar este tipo de datos. Trabajamos con la base original.
# Convertir columnas categóricas a factor. Este paso es necesario para correr un modelo lineal como el de regresión. Asi se entiende que esas variables son dummy.
Datos <- Datos %>%
mutate(
transmision = as.factor(transmision),
Dpto = as.factor(Dpto),
ciudad = as.factor(ciudad),
color = as.factor(color)
)
El primer paso es analizar de forma individual que relaciones tendrian cada una de las variables con respecto a los precios, el primer caso planteado sera el kilometraje. Exploremos la relacion:
Precio <- Datos$precio
Kilo <- Datos$kilometraje
plot(Kilo,Precio)
Viendo esta grafica observamos que, en efecto, los precios mas altos estan en los autos con 0 o casi nada de kilometraje, y estos van bajando conforme el kilometraje del auto en cuestion siga aumentando (salvo por unos datos atipicos), sin embargo esto no es suficiente, obsservemos si hay una posible correlacion lineal entre las variables
cor(Kilo,Precio)
## [1] -0.6543672
El valor indica una correlacion negativa, es decir que existe una tendencia lineal negativa entre el precio y el kilometraje (tal y como sospechabamos), sin embargo el nivel de tendencia es moderado, no es demasiado significativo como para concluir que el comportamiento del precio se explica totalmente con el kilometraje del auto.
Observemos un ggplot
g1=ggplot(data = Datos,aes(y=Precio, x=Kilo)) + geom_point() + geom_smooth()
ggplotly(g1)
Luego este grafico, la linea (o el modelo usado) se ajusta bien a la mayor parte de los datos, implicando en esto que hay una relacion existente entre las variable dependiente (precio) con la independiente (el kilometraje)
Las conclusiones de las observaciones anteriores son suficientes para justificar un analisis inicial en el modelo de regresion lineal simple entre el kilometraje y el peso. Lo definimos a continuacion:
modelo_S1 <- lm(Precio ~ Kilo, data = Datos)
modelo_S1
##
## Call:
## lm(formula = Precio ~ Kilo, data = Datos)
##
## Coefficients:
## (Intercept) Kilo
## 72271766.3 -290.7
La interpretacion a este modelo nos dice que el precio inicial de los vehiculos es de aproximadamente 72271766 cuando tienen 0 kilometraje. Sin embargo, este precio ira disminuyendo en aproximadamente 290 unidades por cada kilometraje adicional que el auto posea.
# Interpretación gráfica
ggplot(Datos, aes(x = Kilo, y = Precio)) +
geom_point(color = "blue") +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = "Regresión Lineal Simple: Precio vs. Kilometraje",
x = "Kilometraje", y = "Precio (unidades)")
summary(modelo_S1)
##
## Call:
## lm(formula = Precio ~ Kilo, data = Datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -60471042 -6914624 -489462 6727120 108002424
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.227e+07 1.675e+06 43.15 <2e-16 ***
## Kilo -2.907e+02 1.902e+01 -15.29 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 15560000 on 312 degrees of freedom
## Multiple R-squared: 0.4282, Adjusted R-squared: 0.4264
## F-statistic: 233.6 on 1 and 312 DF, p-value: < 2.2e-16
Apliquemos ahora la validacion de supuestos
#Evaluación de supuestos
par(mfrow = c(2, 2)) # Configurar para ver gráficos de diagnóstico
plot(modelo_S1)
- Viendo el grafico de los residuos vs valores ajustados observamos que
la mayor parte de los puntos estan dispersos de manera aleatorio
alrededor de la linea principal, esto indica homocedasticidad y el
modelo estaria capturando correctamente la relacion entre las
variables
shapiro.test(modelo_S1$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_S1$residuals
## W = 0.83648, p-value < 2.2e-16
El valor P es menor a 0.05 luego esto indica que en efecto los residuos NO siguen una distribucion normal tal como la grafica lo sospechaba, esto evidencia que es necesario aplicar una transformacion al modelo antes de continuar con las predicciones. La transformacion usada sera la aplicacion del logaritmo en la variable dependiente (Los precios)
modelo_S1 <- lm(log(Precio) ~ Kilo, data = Datos)
summary(modelo_S1)
##
## Call:
## lm(formula = log(Precio) ~ Kilo, data = Datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2370 -0.1206 0.0125 0.1674 1.0803
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.806e+01 3.148e-02 573.8 <2e-16 ***
## Kilo -5.291e-06 3.574e-07 -14.8 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2924 on 312 degrees of freedom
## Multiple R-squared: 0.4125, Adjusted R-squared: 0.4107
## F-statistic: 219.1 on 1 and 312 DF, p-value: < 2.2e-16
modelo_S1
##
## Call:
## lm(formula = log(Precio) ~ Kilo, data = Datos)
##
## Coefficients:
## (Intercept) Kilo
## 1.806e+01 -5.291e-06
NOTA: Para interpretar correctamente los coeficientes en un modelo log-lin (logaritmo en la variable dependiente y variables no transformadas en los predictores), debemos aplicar la transformación exponencial inversa (también conocida como la “anti-transformación exponencial”) a los coeficientes. Esto nos dará la interpretación en términos de cambios porcentuales exactos
# Calcular la interpretación en términos porcentuales aplicando la exponencial
exp_coef <- exp(coef(modelo_S1)) - 1 # Resta 1 para expresar como porcentaje
# Crear un dataframe para facilitar la interpretación
interpretacion_coef <- data.frame(
Coeficiente = names(coef(modelo_S1)),
Estimacion = coef(modelo_S1),
Cambio_Porcentual = round(exp_coef * 100, 2)
)
# Mostrar la interpretación en términos de cambio porcentual
interpretacion_coef
## Coeficiente Estimacion Cambio_Porcentual
## (Intercept) (Intercept) 1.806045e+01 6975180616
## Kilo Kilo -5.290855e-06 0
Lamentablemente dado que el cambio porcentual es nulo no podemos hacer una interpretacion correcta de los coeficientes de este modelo logaritmico
#Evaluación de supuestos
par(mfrow = c(2, 2)) # Configurar para ver gráficos de diagnóstico
plot(modelo_S1)
Luego el grafico de los residuales Q-Q tiene una diferencia un poco mas notable y es que los datos en los extremos ya no se desvian demasiado de la linea central(a comparacion del modelo anterior), lo que es bueno y nos indica que efectivamente podria haberse corregido el problema de la No normalidad, comprobemos esto con el test shapiro
shapiro.test(modelo_S1$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_S1$residuals
## W = 0.84634, p-value < 2.2e-16
Sin embargo nuevamente la prueba Shapiro nos muestra que los residuos NO siguen una distribucion normal, esto desafortunadamente nos indica que hay alta probabilidad de que los resultados de nuestro modelo no sean confiables, incluso aunque le apliquemos una transformacion logaritmica, pues los valores atipicos en nuestro modelo son tan distantes de los valores generales, que distorsionan de manera significativa el nivel de prediccion aceptable de nuestro modelo lineal simple, afectando la validez de los intervalos de confianza y las pruebas de hipótesis. por ende se concluye que el modelo de regresiòn lineal no seria òptimo para modelar esos datos.
Precio <- Datos$precio
Modelo <- Datos$modelo
plot(Modelo,Precio)
Observando esta grafica, notamos una ligera relacion entre el modelo del vehiculo y el precio que tiene, aumentando en su mayoria cada vez mas conforme el modelo sea de años mas recientes (salvo por ciertos valores atipicos), revisemos el coeficiente de correlacion
cor(Modelo, Precio)
## [1] 0.8295419
Vemos que el coeficiente de correlacion es sorpresivamente cercano a 1, lo que detona una correlacion lineal fuertemente positiva entre el modelo del vehiculo y le precio que este posea. Observemos un ggplot
g1=ggplot(data = Datos,aes(y=Precio, x=Modelo)) + geom_point() + geom_smooth()
ggplotly(g1)
Luego este grafico, la linea (o el modelo usado) se ajusta de forma decente a buena parte de los datos, implicando en esto que hay una posible relacion existente entre las variable dependiente(precio) con la independiente (el modelo)
Con todo lo analizado anteriormente, concluimos que ambas variables comparten una relacion lineal, de tendencia positiva. Estas ultimas conclusiones son suficientes para justificar un analisis inicial al modelo de regresion lineal simple planteado entre el precio y el modelo. Lo definimos a continuacion
modelo_S2 <- lm(Precio ~ Modelo, data = Datos)
modelo_S2
##
## Call:
## lm(formula = Precio ~ Modelo, data = Datos)
##
## Coefficients:
## (Intercept) Modelo
## -7.889e+09 3.940e+06
Lamentablemente los coeficientes de la variable dependiente son negativos, por ende no hay posibilidad de dar una interpretacion clara. Sin embargo, sabemos que por cada año que el modelo sea mas reciente, el precio de los vehiculos aumentara en 3940325 unidades respecto al modelo del año anterior.
# Interpretación gráfica
ggplot(Datos, aes(x = Modelo, y = Precio)) +
geom_point(color = "blue") +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = "Regresión Lineal Simple: Precio vs. Modelo",
x = "Kilometraje", y = "Precio (unidades)")
summary(modelo_S2)
##
## Call:
## lm(formula = Precio ~ Modelo, data = Datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -71764290 -4601367 -772342 3182090 103056684
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7.889e+09 3.026e+08 -26.07 <2e-16 ***
## Modelo 3.940e+06 1.502e+05 26.24 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11490000 on 312 degrees of freedom
## Multiple R-squared: 0.6881, Adjusted R-squared: 0.6871
## F-statistic: 688.4 on 1 and 312 DF, p-value: < 2.2e-16
Haciendo la prueba del valor P podemos determinar que la variableModelo si es significativa en la relacion que tiene con los precios de los vehiculos, por ende es indispensable tenerla en cuenta asi que conservamos el modelo.
Analizando el R cuadrado ajustado nos damos cuenta que el modelo explica casi el 70% aproximadamente de la variabilidad de los precios de los vehiculos, es un rango muy alto y facilmente podriamos concluir que esta es la variable que mejor relacion tiene con los precios.
Apliquemos ahora la validacion de supuestos
#Evaluación de supuestos
par(mfrow = c(2, 2)) # Configurar para ver gráficos de diagnóstico
plot(modelo_S2)
Viendo el grafico de los residuos vs valores ajustados observamos que la mayor parte de los puntos estan dispersos de manera aleatoria alrededor de la linea principal, esto indica homocedasticidad y el modelo estaria capturando correctamente la relacion entre las variables
Viendo el grafico de Q-Q, observamos que la mayor parte de los puntos siguen una linea recta, sin embargo, hay ciertas desviaciones en los extremos, lo que pone en duda si los residuos siguen o no una distribucion normal. Para asegurarnos de esto ultimo, complementenos con una prueba Shapiro
shapiro.test(modelo_S2$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_S2$residuals
## W = 0.60941, p-value < 2.2e-16
El valor P es menor a 0.05 luego esto indica que en efecto los residuos no siguen una distribucion normal tal como la grafica lo sospechaba, esto evidencia que es necesario aplicar una transformacion al modelo antes de continuar con las predicciones. La transformacion usada sera la aplicacion del logaritmo en la variable dependiente (Los precios)
modelo_S2 <- lm(log(Precio) ~ Modelo, data = Datos)
summary(modelo_S2)
##
## Call:
## lm(formula = log(Precio) ~ Modelo, data = Datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.46028 -0.05879 0.00139 0.07062 1.02393
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.318e+02 5.411e+00 -24.36 <2e-16 ***
## Modelo 7.419e-02 2.686e-03 27.63 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2055 on 312 degrees of freedom
## Multiple R-squared: 0.7098, Adjusted R-squared: 0.7089
## F-statistic: 763.2 on 1 and 312 DF, p-value: < 2.2e-16
modelo_S2
##
## Call:
## lm(formula = log(Precio) ~ Modelo, data = Datos)
##
## Coefficients:
## (Intercept) Modelo
## -131.8304 0.0742
# Calcular la interpretación en términos porcentuales aplicando la exponencial
exp_coef <- exp(coef(modelo_S2)) - 1 # Resta 1 para expresar como porcentaje
# Crear un dataframe para facilitar la interpretación
interpretacion_coef <- data.frame(
Coeficiente = names(coef(modelo_S2)),
Estimacion = coef(modelo_S2),
Cambio_Porcentual = round(exp_coef * 100, 2)
)
# Mostrar la interpretación en términos de cambio porcentual
interpretacion_coef
## Coeficiente Estimacion Cambio_Porcentual
## (Intercept) (Intercept) -131.8303842 -100.0
## Modelo Modelo 0.0741954 7.7
Luego la regresion logaritmica nos indica que un cambio en el modelo del vehiculo aumenta su precio en aproximadamente un 7.7%, (conforme el modelo sea un año mas reciente al anterior)
#Evaluación de supuestos
par(mfrow = c(2, 2)) # Configurar para ver gráficos de diagnóstico
plot(modelo_S2)
Luego el grafico de los residuales Q-Q tiene una diferencia un poco mas notable y es que los datos en los extremos ya no se desvian demasiado de la linea central(a comparacion del modelo anterior), lo que es bueno y nos indica que efectivamente podria haberse corregido el problema de la No normalidad, comprobemos esto con el test shapiro
shapiro.test(modelo_S2$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_S2$residuals
## W = 0.56371, p-value < 2.2e-16
Sin embargo nuevamente la prueba Shapiro nos muestra que los residuos NO siguen una distribucion normal, esto desafortunadamente nos indica que hay alta probabilidad de que los resultados de nuestro modelo no sean confiables, incluso aunque le apliquemos una transformacion logaritmica, pues los valores atipicos en nuestro modelo son tan distantes de los valores generales, que distorsionan de manera significativa el nivel de prediccion aceptable de nuestro modelo lineal simple, afectando la validez de los intervalos de confianza y las pruebas de hipótesis. por ende se concluye que el modelo de regresiòn lineal no seria òptimo para modelar esos datos y no vale la pena hacer analisis de prediccion.
Precio <- Datos$precio
Ciudad <- Datos$ciudad
plot(Ciudad,Precio)
A continuacion podemos ver el grafico de cajas que se obtiene al comparar los precios de los vehiculos mazda dependiendo de las ciudades, veamos si hay una decente correlacion entre las mismas. Como en este caso estamos usando una variable categorica, el coeficiente de pearson estandar no servira, por ende usaremos la correlacion Eta Cuadrado que sale desde el analisis de varianza ANOVA
etaSquared(aov(Precio ~ Ciudad))
## eta.sq eta.sq.part
## Ciudad 0.1597558 0.1597558
Vemos en las pruebas que aproximadamente el 16% de la variabilidad de los precios esta siendo explicada por las categorias de “Ciudad”. Es un valor bastante bajo pero no podemos despreciarlo todavia, haremos analisis inicial al modelo lineal
Observemos un ggplot
g1 <- ggplot(data = Datos, aes(y = Precio, x = Ciudad)) +
geom_point() +
geom_smooth() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(g1)
Luego en este grafico propiamente podemos ver la distribucion de los precios ya propiamente en cada ciudad, aqui observamos que ciertas metropolis como Medellin y Cali tienen la mayor concentracion de los precios mas caros registrados en nuestra base de datos.
options(scipen = 999) # Desactiva la notación científica globalmente
modelo_S3 <- lm(Precio ~ Ciudad, data = Datos)
modelo_S3
##
## Call:
## lm(formula = Precio ~ Ciudad, data = Datos)
##
## Coefficients:
## (Intercept) CiudadAipe CiudadAnsermanuevo
## 34999999.999998316 1000000.000001483 20000000.000001699
## CiudadArmenia CiudadBarrancabermeja CiudadBarranquilla
## 4700000.000002002 11500000.000001695 7490000.615386339
## CiudadBello CiudadBogotá CiudadBucaramanga
## 6840000.000001634 12979215.666668272 20025000.000001606
## CiudadCali CiudadCartago CiudadChía
## 24595714.285715945 21500000.000001583 13600000.000001779
## CiudadCúcuta CiudadEnvigado CiudadFloridablanca
## 27460000.000001688 43200000.000001676 17437500.000001721
## CiudadFunza CiudadFusagasugá CiudadGirardot
## 24000000.000001553 12750000.000001686 27000000.000001766
## CiudadGirón CiudadIbagué CiudadItagüí
## 0.000001595 10350000.000001607 4250000.000001615
## CiudadLa Ceja CiudadManizales CiudadMedellín
## -4999999.999998330 12647619.047620760 15116363.636365250
## CiudadMontería CiudadNeiva CiudadPalestina
## 5000000.000001610 16025000.000001630 7000000.000001612
## CiudadPalmira CiudadPereira CiudadPiedecuesta
## 24000000.000001628 21230000.000001654 10000000.000001622
## CiudadPitalito CiudadPopayán CiudadRío de Oro
## 1500000.000001638 -3499999.999998359 47000000.000001654
## CiudadRionegro CiudadSabaneta CiudadSan Gil
## 30980000.000001639 14700000.000001671 18000000.000001624
## CiudadSanJuandePasto CiudadSantaMarta CiudadSincelejo
## 18433333.333334994 -3999999.999998352 -999999.999998347
## CiudadTuluá CiudadValledupar CiudadVillavicencio
## -749999.999998347 -2999999.999998329 4500000.000001645
## CiudadYarumal CiudadYopal CiudadYumbo
## 10000000.000001635 -4999999.999998343 -1999999.999998356
## CiudadZipaquirá
## 35000000.000001632
Algunas interpretaciones de los coeficientes de estos modelos nos dicen (al menos para los coeficientes positivos) son:
Estos serian los precios base de los vehiculos mazda, sin contar otros factores alternos en sus propias caracteristicas (como el modelo y el kilometraje)
summary(modelo_S3)
##
## Call:
## lm(formula = Precio ~ Ciudad, data = Datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -52795714 -12968788 -2915000 10403214 110204286
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 34999999.999998316 20348964.451364141 1.720 0.0866 .
## CiudadAipe 1000000.000001483 28777781.507367156 0.035 0.9723
## CiudadAnsermanuevo 20000000.000001699 28777781.507367205 0.695 0.4877
## CiudadArmenia 4700000.000002002 21253800.196915865 0.221 0.8252
## CiudadBarrancabermeja 11500000.000001695 24922289.849938091 0.461 0.6449
## CiudadBarranquilla 7490000.615386339 21117118.392068844 0.355 0.7231
## CiudadBello 6840000.000001634 21342173.967690449 0.320 0.7488
## CiudadBogotá 12979215.666668272 20547495.635115523 0.632 0.5281
## CiudadBucaramanga 20025000.000001606 21583336.130525336 0.928 0.3543
## CiudadCali 24595714.285715945 20555558.219547980 1.197 0.2325
## CiudadCartago 21500000.000001583 28777781.507367089 0.747 0.4557
## CiudadChía 13600000.000001779 23496960.207450595 0.579 0.5632
## CiudadCúcuta 27460000.000001688 22291173.703765780 1.232 0.2191
## CiudadEnvigado 43200000.000001676 22291173.703765813 1.938 0.0537 .
## CiudadFloridablanca 17437500.000001721 21583336.130525421 0.808 0.4199
## CiudadFunza 24000000.000001553 28777781.507367041 0.834 0.4050
## CiudadFusagasugá 12750000.000001686 24922289.849938020 0.512 0.6094
## CiudadGirardot 27000000.000001766 28777781.507367164 0.938 0.3490
## CiudadGirón 0.000001595 28777781.507367056 0.000 1.0000
## CiudadIbagué 10350000.000001607 21583336.130525324 0.480 0.6319
## CiudadItagüí 4250000.000001615 22750833.892488364 0.187 0.8520
## CiudadLa Ceja -4999999.999998330 28777781.507367108 -0.174 0.8622
## CiudadManizales 12647619.047620760 20827829.131949626 0.607 0.5442
## CiudadMedellín 15116363.636365250 20533121.729449376 0.736 0.4623
## CiudadMontería 5000000.000001610 28777781.507367127 0.174 0.8622
## CiudadNeiva 16025000.000001630 21583336.130525332 0.742 0.4585
## CiudadPalestina 7000000.000001612 28777781.507367078 0.243 0.8080
## CiudadPalmira 24000000.000001628 28777781.507367142 0.834 0.4050
## CiudadPereira 21230000.000001654 21342173.967690568 0.995 0.3208
## CiudadPiedecuesta 10000000.000001622 28777781.507367127 0.347 0.7285
## CiudadPitalito 1500000.000001638 28777781.507367127 0.052 0.9585
## CiudadPopayán -3499999.999998359 28777781.507367164 -0.122 0.9033
## CiudadRío de Oro 47000000.000001654 28777781.507367142 1.633 0.1036
## CiudadRionegro 30980000.000001639 22291173.703765735 1.390 0.1657
## CiudadSabaneta 14700000.000001671 24922289.849938009 0.590 0.5558
## CiudadSan Gil 18000000.000001624 28777781.507367149 0.625 0.5322
## CiudadSanJuandePasto 18433333.333334994 23496960.207450408 0.784 0.4334
## CiudadSantaMarta -3999999.999998352 28777781.507367134 -0.139 0.8896
## CiudadSincelejo -999999.999998347 28777781.507367134 -0.035 0.9723
## CiudadTuluá -749999.999998347 24922289.849937979 -0.030 0.9760
## CiudadValledupar -2999999.999998329 28777781.507367142 -0.104 0.9171
## CiudadVillavicencio 4500000.000001645 21979393.681735046 0.205 0.8379
## CiudadYarumal 10000000.000001635 28777781.507367145 0.347 0.7285
## CiudadYopal -4999999.999998343 28777781.507367142 -0.174 0.8622
## CiudadYumbo -1999999.999998356 28777781.507367134 -0.069 0.9446
## CiudadZipaquirá 35000000.000001632 28777781.507367142 1.216 0.2250
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 20350000 on 268 degrees of freedom
## Multiple R-squared: 0.1598, Adjusted R-squared: 0.01867
## F-statistic: 1.132 on 45 and 268 DF, p-value: 0.2721
Haciendo la prueba del valor P podemos determinar que NINGUNA CIUDAD (ni siquiera las metropolis mas significativas como Cali, Bogota y medellin) son significativas en la relacion que tienen con los Precios de los vehiculos. Y esto tiene sentido ya que la prueva ETA cuadrado denoto que la variabilidad de los precios que estas categorias explican es considerablemente baja.
Estas ultimas pruebas son suficientes para concluir que la variable categorica de las ciudades no es importante en el comportamiento de los Precios que buscamos predecir, por ende no continuamos con el analisis y directamente desechamos el modelo lineal simple planteado
En esta seccion escogeremos, de los tres modelos lineales simples, cual es el mejor. Ya hemos definido anteriormente que para un analisis serio de prediccion, ninguno de estos modelos seria factible dado que ninguno de sus residuos sigue una distribucion normal (la significancia de los datos atipicos y su gran diferencia frente a los datos generales perturba la capacidad de prediccion). Sin embargo, si tuvieramos que escoger el mejor de entre los tres modelos, comparariamos:
El ultimo modelo directamente se descarta ya que se concluyo que su variable independiente (las ciudades) no son significativas en el comportamiento de los precios (cosa que si pasa en el kilometraje y en el modelo).
El criterio a comparar entonces sera el RMSE (Raiz cuadrada del error cuadratico medio)
# División en conjunto de entrenamiento y prueba
set.seed(123) # Para reproducibilidad
trainIndex <- createDataPartition(Datos$precio, p = 0.7, list = FALSE)
trainData <- Datos[trainIndex, ]
testData <- Datos[-trainIndex, ]
Empecemos entonces con el modelo 1(Precio vs Kilometraje)
#Validación cruzada modelo multiple inicial sin transformaciones
# Modelo con el conjunto de entrenamiento
modelo_S1_VC <- lm(precio ~ kilometraje, data = trainData)
# Predicciones en el conjunto de prueba
predicciones <- predict(modelo_S1_VC, newdata = testData)
# Cálculo de MAE y RMSE
mae <- mean(abs(predicciones - testData$precio))
rmse <- sqrt(mean((predicciones - testData$precio)^2))
cat("MAE:", mae, "\nRMSE:", rmse)
## MAE: 9504432
## RMSE: 12687696
Continuemos ahora con el modelo 2(Precio vs Modelo)
#Validación cruzada modelo multiple inicial sin transformaciones
# Modelo con el conjunto de entrenamiento
modelo_S2_VC <- lm(precio ~ modelo, data = trainData) #LOS NOMBRES SON TAL CUAL LAS COLUMNAS DE LA BASE DE DATOS
# Predicciones en el conjunto de prueba
predicciones <- predict(modelo_S2_VC, newdata = testData)
# Cálculo de MAE y RMSE
mae <- mean(abs(predicciones - testData$precio))
rmse <- sqrt(mean((predicciones - testData$precio)^2))
cat("MAE:", mae, "\nRMSE:", rmse)
## MAE: 5694821
## RMSE: 10181715
Hay ciertas cosas a aclarar. Primero, los MAE y los RMSE son valores altos debido a que estamos trabajando con grandes cantidades en nuestros datos (valores en pesos que facilmente sobrepasan el millon), pero ademas, hay que aclarar que los modelos S1 y S2 a comparar tienen problemas de prediccion debido a la NO distribucion normal de sus residuos.
Finalmente y al ver los RMSE concluimos que entre los dos modelos, el mejor modelo es el 2do modelo de regresion, es decir Precio Vs modelo(de auto), de tal manera que el precio predicho por este modelo se desvia aproximadamente 5694821 pesos del valor original
Comenzamos planteando un modelo usando las unicas dos variables numericas que aportan datos a nuestra relacion pero ademas añadiendo una nueva variable categorica, esta es la transmision.
options(scipen = 999) # Desactiva la notación científica globalmente
modelo_M1 <- lm(precio ~ kilometraje + modelo + transmision, data = Datos)
modelo_M1
##
## Call:
## lm(formula = precio ~ kilometraje + modelo + transmision, data = Datos)
##
## Coefficients:
## (Intercept) kilometraje modelo
## -7048130077.23 -35.39 3525641.23
## transmisionMecánica
## -5506174.38
Interpretando los coeficientes tenemos:
summary(modelo_M1)
##
## Call:
## lm(formula = precio ~ kilometraje + modelo + transmision, data = Datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -67801596 -4005789 -967519 2918840 100935418
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7048130077.23 443934538.83 -15.877 < 0.0000000000000002
## kilometraje -35.39 20.39 -1.736 0.0836
## modelo 3525641.23 219734.18 16.045 < 0.0000000000000002
## transmisionMecánica -5506174.38 1294933.12 -4.252 0.0000281
##
## (Intercept) ***
## kilometraje .
## modelo ***
## transmisionMecánica ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11150000 on 310 degrees of freedom
## Multiple R-squared: 0.7083, Adjusted R-squared: 0.7055
## F-statistic: 250.9 on 3 and 310 DF, p-value: < 0.00000000000000022
Luego Aplicando la prueba del valor P, se justifica la inclusion de la variable categorica de Transmision, PERO no se justifica tanto la permanencia del Kilometraje, ya que se evidencia que esta no es significativa para nuestra relacion con los precios, por ende la eliminamos y volvemos a plantear el modelo
options(scipen = 999) # Desactiva la notación científica globalmente
modelo_M1 <- lm(precio ~ modelo + transmision, data = Datos)
modelo_M1
##
## Call:
## lm(formula = precio ~ modelo + transmision, data = Datos)
##
## Coefficients:
## (Intercept) modelo transmisionMecánica
## -7615373226 3805863 -5553860
summary(modelo_M1)
##
## Call:
## lm(formula = precio ~ modelo + transmision, data = Datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -67727884 -4326045 -940321 2898872 101135845
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7615373226 301394040 -25.267 < 0.0000000000000002 ***
## modelo 3805863 149524 25.453 < 0.0000000000000002 ***
## transmisionMecánica -5553860 1298823 -4.276 0.0000253 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11180000 on 311 degrees of freedom
## Multiple R-squared: 0.7055, Adjusted R-squared: 0.7036
## F-statistic: 372.4 on 2 and 311 DF, p-value: < 0.00000000000000022
Luego podemos observar el modelo explica la variabilidad de aproximadamente el 70% de los datos de los precios. No es un mal valor, pero definitivamente se podria mejorar.
Apliquemos ahora la validacion de supuestos
#Evaluación de supuestos
par(mfrow = c(2, 2)) # Configurar para ver gráficos de diagnóstico
plot(modelo_M1)
Viendo el grafico de los residuos vs valores ajustados observamos que la mayor parte de los puntos estan dispersos de manera aleatorio alrededor de la linea principal, esto indica homocedasticidad y el modelo estaria capturando correctamente la relacion entre las variables
Viendo el grafico de Q-Q, observamos que la mayor parte de los puntos siguen una linea recta, sin embargo, hay ciertas desviaciones en los extremos, lo que pone en duda si los residuos siguen o no una distribucion normal. Para asegurarnos de esto ultimo, complementenos con una prueba Shapiro
shapiro.test(modelo_M1$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_M1$residuals
## W = 0.59852, p-value < 0.00000000000000022
El valor P es menor a 0.05 luego esto indica que en efecto los residuos NO siguen una distribucion normal tal como la grafica lo sospechaba, esto evidencia que es necesario aplicar una transformacion al modelo antes de continuar con las predicciones. La transformacion usada sera la aplicacion del logaritmo en la variable dependiente (Los precios) y las variables independientes numericas
options(scipen = 999) # Desactiva la notación científica globalmente
modelo_M1 <- lm(log(precio) ~log(modelo) + transmision, data = Datos)
# Calcular la interpretación en términos porcentuales aplicando la exponencial
exp_coef <- exp(coef(modelo_M1)) - 1 # Resta 1 para expresar como porcentaje
# Crear un dataframe para facilitar la interpretación
interpretacion_coef <- data.frame(
Coeficiente = names(coef(modelo_M1)),
Estimacion = coef(modelo_M1),
Cambio_Porcentual = round(exp_coef * 100, 2)
)
# Mostrar la interpretación en términos de cambio porcentual
interpretacion_coef
## Coeficiente Estimacion
## (Intercept) (Intercept) -1088.74577867
## log(modelo) log(modelo) 145.42604553
## transmisionMecánica transmisionMecánica -0.08211974
## Cambio_Porcentual
## (Intercept) -100.00
## log(modelo) 143790136885483617986020226406264286288686862666400860404208886628.00
## transmisionMecánica -7.88
En los cambios porcentuales podemos ber un desajuste masivamente grande con respecto a la variable Modelo, luego esto indica que la variable numerica Modelo es incompatible con la escala de transformacion de Logaritmo, por ende volvemos a replantear el modelo sin que esta variable sufra tal transformacion
options(scipen = 999) # Desactiva la notación científica globalmente
modelo_M1 <- lm(log(precio) ~ modelo + transmision, data = Datos)
# Calcular la interpretación en términos porcentuales aplicando la exponencial
exp_coef <- exp(coef(modelo_M1)) - 1 # Resta 1 para expresar como porcentaje
# Crear un dataframe para facilitar la interpretación
interpretacion_coef <- data.frame(
Coeficiente = names(coef(modelo_M1)),
Estimacion = coef(modelo_M1),
Cambio_Porcentual = round(exp_coef * 100, 2)
)
# Mostrar la interpretación en términos de cambio porcentual
interpretacion_coef
## Coeficiente Estimacion Cambio_Porcentual
## (Intercept) (Intercept) -127.79554896 -100.00
## modelo modelo 0.07221101 7.49
## transmisionMecánica transmisionMecánica -0.08196408 -7.87
Luego ya vemos corregidos los cambios porcentuales, por ende ya podemos definir su correcta interpretacion:
un cambio en el modelo del vehiculo aumenta su precio en aproximadamente un 7.7%, (conforme el modelo sea un año mas reciente al anterior)
Los vehículos con transmisión mecánica tienen un precio promedio 7.87% menor en comparación con los vehículos con transmisión automática.
#Evaluación de supuestos
par(mfrow = c(2, 2)) # Configurar para ver gráficos de diagnóstico
plot(modelo_M1)
Luego el grafico de los residuales Q-Q tiene una diferencia un poco mas notable y es que los datos en los extremos ya no se desvian demasiado de la linea central(a comparacion del modelo anterior), lo que es bueno y nos indica que efectivamente podria haberse corregido el problema de la No normalidad, comprobemos esto con el test shapiro
shapiro.test(modelo_M1$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_M1$residuals
## W = 0.5638, p-value < 0.00000000000000022
Sin embargo, nuevamente El valor P es menor a 0.05 luego esto indica que en efecto los residuos no siguen una distribucion normal, indicando posibles problemas en sus predicciones debido a los valores atipicos
options(scipen = 999) # Desactiva la notación científica globalmente
modelo_M2 <- lm(precio ~ modelo + transmision + Dpto, data = Datos)
modelo_M2
##
## Call:
## lm(formula = precio ~ modelo + transmision + Dpto, data = Datos)
##
## Coefficients:
## (Intercept) modelo transmisionMecánica
## -7579142277 3788147 -5495605
## DptoAtlántico DptoBogotá DptoCaldas
## -4256521 -2186699 -1097237
## DptoCasanare DptoCauca DptoCesar
## 2543029 1962340 1131926
## DptoCórdoba DptoCundinamarca DptoHuila
## -10185853 7286400 -579141
## DptoMagdalena DptoMeta DptoNariño
## 3543029 -1938321 -3884071
## DptoNortedeSantander DptoQuindío DptoRisaralda
## -1437828 -823794 -1057233
## DptoSantander DptoSucre DptoTolima
## -1478698 -4821412 -2775001
## DptoValledelCauca
## 1311817
Algunas de las interpretaciones a los coeficientes del modelo son:
options(scipen = 999) # Desactiva la notación científica globalmente
summary(modelo_M2)
##
## Call:
## lm(formula = precio ~ modelo + transmision + Dpto, data = Datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -69507241 -4144417 -662853 2791231 99361594
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7579142277 321610749 -23.566 < 0.0000000000000002 ***
## modelo 3788147 159584 23.738 < 0.0000000000000002 ***
## transmisionMecánica -5495605 1412298 -3.891 0.000124 ***
## DptoAtlántico -4256521 3390117 -1.256 0.210276
## DptoBogotá -2186699 2035011 -1.075 0.283468
## DptoCaldas -1097237 2748701 -0.399 0.690049
## DptoCasanare 2543029 11485007 0.221 0.824919
## DptoCauca 1962340 11468331 0.171 0.864256
## DptoCesar 1131927 8132950 0.139 0.889406
## DptoCórdoba -10185853 11427734 -0.891 0.373487
## DptoCundinamarca 7286400 4223392 1.725 0.085541 .
## DptoHuila -579141 3890613 -0.149 0.881770
## DptoMagdalena 3543029 11485007 0.308 0.757928
## DptoMeta -1938321 4484450 -0.432 0.665892
## DptoNariño -3884071 6768048 -0.574 0.566488
## DptoNortedeSantander -1437828 5261434 -0.273 0.784834
## DptoQuindío -823794 3710487 -0.222 0.824455
## DptoRisaralda -1057233 3825928 -0.276 0.782487
## DptoSantander -1478698 2805161 -0.527 0.598500
## DptoSucre -4821412 11446398 -0.421 0.673907
## DptoTolima -2775001 4203310 -0.660 0.509650
## DptoValledelCauca 1311817 1993254 0.658 0.510974
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11350000 on 292 degrees of freedom
## Multiple R-squared: 0.7152, Adjusted R-squared: 0.6947
## F-statistic: 34.92 on 21 and 292 DF, p-value: < 0.00000000000000022
Luego vemos aqui que lamentablemente la variable categorica(Al igual que las ciudades en el analisis de los modelos lineales simples) de los departamentos, por prueba del valor P, no es significante en la variacion que tienen los Precios de los vehiculos, ademas su nivel de explicacion es aproximadamente el mismo que el modelo lineal multiple anterior (70%) por ende se concluye que no se justifica la eleccion de esta variable y se descarta el modelo.
Habiamos definidos dos modelos lineales multiples, pero solo uno paso la prueva del valor P para la significancia, por ende el mejor modelo de los dos es claramente el modelo de Precio Vs modelo + transmision, se calcula entonces su valor predictivo
# División en conjunto de entrenamiento y prueba
set.seed(123) # Para reproducibilidad
trainIndex <- createDataPartition(Datos$precio, p = 0.7, list = FALSE)
trainData <- Datos[trainIndex, ]
testData <- Datos[-trainIndex, ]
#Validación cruzada modelo multiple inicial sin transformaciones
# Modelo con el conjunto de entrenamiento
modelo_M1_VC <- lm(precio ~ modelo + transmision, data = trainData)
# Predicciones en el conjunto de prueba
predicciones <- predict(modelo_M1_VC, newdata = testData)
# Cálculo de MAE y RMSE
mae <- mean(abs(predicciones - testData$precio))
rmse <- sqrt(mean((predicciones - testData$precio)^2))
cat("MAE:", mae, "\nRMSE:", rmse)
## MAE: 5996833
## RMSE: 10285759
Como comentarios finales, este es el mejor modelo de todos (tanto el simple como el multiple) debido a que es el que explica la mayor parte en la variabilidad de los datos (un 70%). Sin embargo, este, al igual que todos los otros modelos, sufre el problema de los residuos que NO siguen una distribucion normal. Esto ocurre porque hay datos atipicos que difieren demasiado de los datos originales (posiblemente explicado con ciertos precios inconclusos o ilogicos frente a las ventas originales). Un sector automotriz que use este modelo y use estos datos como validacion, debe asegurarse entonces de eliminar o ajustar estos valores atipicos para EVITAR entonces posibles errores en el nivel de prediccion.