El caso estima el precio que pide un vendedor por un Mazda 2 usado en OLX. La base 1 reúne los anuncios, con el precio en pesos colombianos, y la pregunta es cuánto de las diferencias de precio se explica con características del carro que cualquier comprador ve en el anuncio. La respuesta es el precio anunciado.
Ese precio es el que pide el vendedor, no el que paga el comprador. Las conclusiones valen, por tanto, para precios de anuncio y no para precios de venta.
library(readxl)
library(ggplot2)
library(plotly)
library(lmtest)
library(car)
datos = read_excel("base1_mazdacol.xlsx")
dim(datos)## [1] 314 11names(datos)## [1] "precio" "kilometraje" "transmision"
## [4] "modelo" "color" "ciudad"
## [7] "departamento" "web-scraper-order" "web-scraper-start-url"
## [10] "link" "link-href"La base trae 314 anuncios y 11 columnas. Siete describen el carro (precio, kilometraje, transmisión, modelo, color, ciudad y departamento). Las otras cuatro son rastro de la descarga automática, con el orden de descarga, los enlaces y el texto del anuncio, y no entran al análisis.
Se trabaja con la base completa, sin excluir registros, y con las características del carro expresadas en unidades legibles.
datos$precio_mill = datos$precio / 1000000 # precio en millones de pesos
datos$antiguedad = 2022 - datos$modelo # años de uso (anuncios descargados en septiembre de 2022)
datos$km_mil = datos$kilometraje / 1000 # kilometraje en miles de km
datos$transmision = factor(datos$transmision, levels = c("Automática", "Mecánica"))
# Región: los tres mercados más grandes y el resto del país
datos$region = ifelse(datos$departamento %in% c("Bogotá", "Antioquia", "ValledelCauca"), datos$departamento, "Resto")
datos$region = factor(datos$region, levels = c("Bogotá", "Antioquia", "ValledelCauca", "Resto"),
labels = c("Bogotá", "Antioquia", "Valle del Cauca", "Resto del país"))
# Color: los tres más comunes y el resto agrupado
datos$color_g = ifelse(datos$color %in% c("Gris", "Blanco", "Rojo"), datos$color, "Otro")
datos$color_g = factor(datos$color_g, levels = c("Gris", "Blanco", "Rojo", "Otro"))
# Texto que aparece al pasar el cursor sobre cada anuncio en los gráficos
datos$anuncio = paste0("Modelo ", datos$modelo, ", ", datos$transmision, ", ", datos$ciudad)| Variable | Tipo | Qué mide |
|---|---|---|
| precio_mill | Cuantitativa (respuesta) | Precio anunciado, en millones de pesos |
| antiguedad | Cuantitativa | Años del carro: 2022 menos el año del modelo |
| km_mil | Cuantitativa | Kilómetros recorridos, en miles |
| transmision | Categórica binaria | Automática o mecánica |
| region | Categórica | Bogotá, Antioquia, Valle del Cauca o resto del país |
| color_g | Categórica | Gris, blanco, rojo u otro |
La antigüedad sustituye al año del modelo porque se interpreta mejor. Se mide contra 2022, ya que la marca de tiempo de la columna de orden de descarga indica que los anuncios se bajaron el 12 de septiembre de ese año, de modo que un modelo 2018 tiene 4 años. La región y el color se agrupan porque la base trae 20 departamentos y 14 colores, varios con uno o dos anuncios, y con tan pocos casos no se puede estimar nada estable para cada uno.
Faltantes y duplicados
colSums(is.na(datos[, c("precio", "kilometraje", "transmision", "modelo", "color", "departamento")]))## precio kilometraje transmision modelo color departamento
## 0 0 0 0 0 0sum(duplicated(datos)) # filas exactamente iguales## [1] 0caracteristicas = c("precio", "kilometraje", "modelo", "transmision", "color", "ciudad")
sum(duplicated(datos[, caracteristicas])) # anuncios con las mismas características del carro## [1] 1No hay datos faltantes ni filas idénticas. Solo 1 par de anuncios comparte todas las características del carro, aunque con títulos y fechas de publicación distintos. Podrían ser el mismo carro publicado dos veces; la base no lo confirma y se conservan ambos.
Valores atípicos
Se aplica la regla de la caja, que marca como atípico el valor que supera el tercer cuartil en más de 1,5 veces el rango intercuartílico.
ggplotly(
ggplot(datos, aes(x = "", y = precio_mill)) +
geom_boxplot(fill = "lightblue") +
labs(title = "Figura 1. Boxplot del precio anunciado", x = "", y = "Precio (millones de pesos)") +
theme_minimal()
)ggplotly(
ggplot(datos, aes(x = "", y = km_mil)) +
geom_boxplot(fill = "moccasin") +
labs(title = "Figura 2. Boxplot del kilometraje", x = "", y = "Kilometraje (miles de km)") +
theme_minimal()
)# Límite superior de la regla de la caja: Q3 + 1,5 x rango intercuartílico
lim_precio = quantile(datos$precio_mill, 0.75) + 1.5 * IQR(datos$precio_mill)
lim_km = quantile(datos$km_mil, 0.75) + 1.5 * IQR(datos$km_mil)
datos[datos$precio_mill > lim_precio, c("precio_mill", "modelo", "kilometraje", "transmision")]| precio_mill | modelo | kilometraje | transmision |
|---|---|---|---|
| 119.9 | 2021 | 29000 | Automática |
| 159.9 | 2022 | 0 | Automática |
| 169.8 | 2019 | 36026 | Automática |
| 107.5 | 2021 | 17909 | Automática |
datos[datos$km_mil > lim_km, c("precio_mill", "modelo", "kilometraje")]| precio_mill | modelo | kilometraje |
|---|---|---|
| 29.9 | 1995 | 280000 |
Hay 4 precios atípicos, todos de modelos 2019 a 2022 anunciados por encima de 105 millones, y 1 kilometraje atípico: un modelo 1995 con 280.000 km. La regla no marca otros valores que también llaman la atención, como un carro de 2022 a 6,8 millones y 9 carros de más de diez años con menos de 1.000 km. Pueden ser errores de digitación o carros casi sin uso, y la base no permite distinguirlos.
Se conservan todos los anuncios. Son lo que se publicó, y los datos no ofrecen un criterio para separar errores de casos reales; descartar los extremos sería una decisión sin respaldo. La consecuencia es que estos anuncios pueden inflar el error de los modelos, y eso se tiene presente al leer los resultados.
Variables cuantitativas
cuantitativas = c("precio_mill", "antiguedad", "km_mil")
summary(datos[, cuantitativas])## precio_mill antiguedad km_mil
## Min. : 6.80 Min. : 0.000 Min. : 0.00
## 1st Qu.: 35.00 1st Qu.: 4.000 1st Qu.: 39.12
## Median : 42.00 Median : 7.000 Median : 79.00
## Mean : 50.47 Mean : 7.131 Mean : 75.00
## 3rd Qu.: 63.00 3rd Qu.:11.000 3rd Qu.:107.38
## Max. :169.80 Max. :27.000 Max. :280.00sapply(datos[, cuantitativas], sd) # desviación estándar## precio_mill antiguedad km_mil
## 20.541624 4.324552 46.232983El anuncio típico es un Mazda 2 de 7 años y 79 mil kilómetros, publicado en 42,0 millones (medianas). El promedio, 50,5 millones, queda por encima porque unos pocos anuncios muy caros lo arrastran, y por eso la mediana es la medida más fiel de lo típico.
# Líneas verticales de la mediana y el promedio
lineas = data.frame(medida = c("Mediana", "Promedio"),
valor = c(median(datos$precio_mill), mean(datos$precio_mill)))
ggplotly(
ggplot(datos, aes(x = precio_mill)) +
geom_histogram(binwidth = 5, boundary = 0, fill = "steelblue", color = "white") +
geom_vline(data = lineas, aes(xintercept = valor, color = medida), linewidth = 1) +
scale_color_manual(values = c("Mediana" = "red", "Promedio" = "darkgreen")) +
labs(title = "Figura 3. ¿Cuánto piden por un Mazda 2?", x = "Precio anunciado (millones de pesos)",
y = "Número de anuncios", color = "") +
theme_minimal()
)El 49 % de los anuncios cuesta entre 30 y 45 millones. A la derecha hay una cola larga: el 16 % supera los 70 millones y 4 pasan de 100.
Entre 45 y 50 millones hay solo 2 anuncios, así que el histograma muestra dos masas separadas. La Figura 6 muestra de dónde sale ese hueco: los carros de hasta 6 años tienen una mediana de 66 millones y los de 7 años o más, de 36.
ggplotly(
ggplot(datos, aes(x = antiguedad)) +
geom_histogram(binwidth = 1, fill = "lightseagreen", color = "white") +
labs(title = "Figura 4. Antigüedad de los carros", x = "Antigüedad (años)", y = "Número de anuncios") +
theme_minimal()
)ggplotly(
ggplot(datos, aes(x = km_mil)) +
geom_histogram(binwidth = 10, boundary = 0, fill = "darkorange", color = "white") +
labs(title = "Figura 5. Kilometraje de los carros", x = "Kilometraje (miles de km)", y = "Número de anuncios") +
theme_minimal()
)Casi todos los carros tienen entre 0 y 15 años, y solo 1 pasa de ahí (el modelo 1995). El kilometraje está más repartido: la mitad de los anuncios queda entre 39 mil y 107 mil km, y la barra pegada a cero reúne carros publicados con casi ningún recorrido.
Variables categóricas
lapply(datos[, c("transmision", "region", "color_g")], table) # número de anuncios por categoría## $transmision
##
## Automática Mecánica
## 174 140
##
## $region
##
## Bogotá Antioquia Valle del Cauca Resto del país
## 51 83 55 125
##
## $color_g
##
## Gris Blanco Rojo Otro
## 105 76 44 89La transmisión se reparte casi por mitades, con 174 automáticos y 140 mecánicos. Bogotá, Antioquia y el Valle del Cauca reúnen el 60 % de los anuncios, y el gris, con 105, es el color más frecuente.
Variables cuantitativas: dispersión y correlación
cor(datos[, cuantitativas])## precio_mill antiguedad km_mil
## precio_mill 1.0000000 -0.8295419 -0.6543672
## antiguedad -0.8295419 1.0000000 0.7436836
## km_mil -0.6543672 0.7436836 1.0000000ggplotly(
ggplot(datos, aes(x = antiguedad, y = precio_mill, text = anuncio)) +
geom_point(color = "steelblue", alpha = 0.7, size = 2) +
labs(title = paste("Figura 6. Precio y antigüedad. Correlación:", fmt(cor(datos$precio_mill, datos$antiguedad), 2)),
x = "Antigüedad (años)", y = "Precio (millones de pesos)") +
theme_minimal()
)ggplotly(
ggplot(datos, aes(x = km_mil, y = precio_mill, text = anuncio)) +
geom_point(color = "darkorange", alpha = 0.7, size = 2) +
labs(title = paste("Figura 7. Precio y kilometraje. Correlación:", fmt(cor(datos$precio_mill, datos$km_mil), 2)),
x = "Kilometraje (miles de km)", y = "Precio (millones de pesos)") +
theme_minimal()
)El precio baja a medida que el carro es más viejo y más recorrido. Con la antigüedad la correlación es de -0,83 y la nube forma una franja estrecha de pendiente negativa. Con el kilometraje es de -0,65 y los puntos se dispersan más. Los cuatro anuncios de más de 100 millones, todos modelos 2019 a 2022, quedan por encima de la franja, y el modelo 1995 queda aislado a la derecha en ambos gráficos.
La Figura 6 también explica el hueco del histograma de precios. A partir de los 7 años casi ningún anuncio pasa de 47,5 millones, y hasta los 6 casi ninguno baja de ahí: solo 5 de los 314 anuncios son excepciones.
La antigüedad y el kilometraje también están muy relacionados entre sí (0,74), como cabía esperar: un carro más viejo ha tenido más tiempo para recorrer kilómetros. Es probable que cada una repita en parte la información de la otra.
Variables categóricas: comparación entre grupos
ggplotly(
ggplot(datos, aes(x = transmision, y = precio_mill)) +
geom_boxplot(fill = "lightblue") +
labs(title = "Figura 8. Precio según la transmisión", x = "", y = "Precio (millones de pesos)") +
theme_minimal()
)ggplotly(
ggplot(datos, aes(x = region, y = precio_mill)) +
geom_boxplot(fill = "lightyellow") +
labs(title = "Figura 9. Precio según la región", x = "", y = "Precio (millones de pesos)") +
theme_minimal()
)ggplotly(
ggplot(datos, aes(x = color_g, y = precio_mill)) +
geom_boxplot(fill = "mistyrose") +
labs(title = "Figura 10. Precio según el color", x = "", y = "Precio (millones de pesos)") +
theme_minimal()
)# Mediana del precio y de la antigüedad en cada grupo
por_trans = aggregate(cbind(precio_mill, antiguedad) ~ transmision, data = datos, FUN = median)
por_region = aggregate(cbind(precio_mill, antiguedad) ~ region, data = datos, FUN = median)
por_color = aggregate(cbind(precio_mill, antiguedad) ~ color_g, data = datos, FUN = median)
por_trans| transmision | precio_mill | antiguedad |
|---|---|---|
| Automática | 56.95 | 6 |
| Mecánica | 38.50 | 9 |
por_region| region | precio_mill | antiguedad |
|---|---|---|
| Bogotá | 40.0 | 8 |
| Antioquia | 42.0 | 8 |
| Valle del Cauca | 56.5 | 5 |
| Resto del país | 41.5 | 8 |
por_color| color_g | precio_mill | antiguedad |
|---|---|---|
| Gris | 42.0 | 8 |
| Blanco | 50.0 | 6 |
| Rojo | 57.4 | 5 |
| Otro | 37.5 | 9 |
En las tres comparaciones los grupos que se anuncian más caros son también los más nuevos, como muestra la antigüedad mediana de cada tabla.
La antigüedad aparece detrás de casi todas las diferencias entre grupos. Eso la convierte en la primera candidata a predictor y obliga a leer con cautela cualquier diferencia entre categorías, porque puede ser la edad con otro nombre.
Se proponen tres modelos con un solo predictor cada uno, estimados
por mínimos cuadrados con lm:
simple_edad = lm(precio_mill ~ antiguedad, data = datos)
simple_km = lm(precio_mill ~ km_mil, data = datos)
simple_trans = lm(precio_mill ~ transmision, data = datos)
summary(simple_edad)##
## Call:
## lm(formula = precio_mill ~ antiguedad, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -71.764 -4.601 -0.772 3.182 103.057
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 78.5643 1.2518 62.76 <2e-16 ***
## antiguedad -3.9403 0.1502 -26.24 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11.49 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-16summary(simple_km)##
## Call:
## lm(formula = precio_mill ~ km_mil, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -60.471 -6.915 -0.489 6.727 108.002
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 72.27177 1.67502 43.15 <2e-16 ***
## km_mil -0.29074 0.01902 -15.29 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 15.56 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-16summary(simple_trans)##
## Call:
## lm(formula = precio_mill ~ transmision, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -36.737 -14.044 -3.787 13.263 113.756
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 56.044 1.486 37.705 < 2e-16 ***
## transmisionMecánica -12.506 2.226 -5.618 4.28e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 19.61 on 312 degrees of freedom
## Multiple R-squared: 0.09187, Adjusted R-squared: 0.08896
## F-statistic: 31.56 on 1 and 312 DF, p-value: 4.276e-08ggplotly(
ggplot(datos, aes(x = antiguedad, y = precio_mill)) +
geom_point(color = "grey60", alpha = 0.7, size = 2) +
geom_line(aes(y = predict(simple_edad)), color = "red", linewidth = 1) +
labs(title = "Figura 11. Modelo 1: precio según la antigüedad", x = "Antigüedad (años)",
y = "Precio (millones de pesos)") +
theme_minimal()
)ggplotly(
ggplot(datos, aes(x = km_mil, y = precio_mill)) +
geom_point(color = "grey60", alpha = 0.7, size = 2) +
geom_line(aes(y = predict(simple_km)), color = "red", linewidth = 1) +
labs(title = "Figura 12. Modelo 2: precio según el kilometraje", x = "Kilometraje (miles de km)",
y = "Precio (millones de pesos)") +
theme_minimal()
)# Predicción del modelo para cada tipo de transmisión
pred_trans = data.frame(transmision = c("Automática", "Mecánica"))
pred_trans$precio_mill = predict(simple_trans, pred_trans)
ggplotly(
ggplot(datos, aes(x = transmision, y = precio_mill)) +
geom_boxplot(fill = "lightblue") +
geom_point(data = pred_trans, color = "red", shape = 18, size = 5) +
labs(title = "Figura 13. Modelo 3: precio según la transmisión", x = "", y = "Precio (millones de pesos)") +
theme_minimal()
)En la Figura 13 los rombos rojos son las predicciones del modelo y coinciden con el promedio de cada grupo: con un predictor binario, la regresión reproduce las dos medias.
modelos = list("1. Antigüedad" = simple_edad, "2. Kilometraje" = simple_km, "3. Transmisión" = simple_trans)
# De cada modelo se extraen el intercepto, la pendiente, el R² y el valor p de la pendiente
resumen = data.frame(
Intercepto = sapply(modelos, function(m) coef(m)[[1]]),
Pendiente = sapply(modelos, function(m) coef(m)[[2]]),
R2 = sapply(modelos, function(m) summary(m)$r.squared),
Valor_p = sapply(modelos, function(m) summary(m)$coefficients[2, 4]))
data.frame(round(resumen[, 1:3], 3), Valor_p = format.pval(resumen$Valor_p, eps = 0.001))| Intercepto | Pendiente | R2 | Valor_p | |
|---|---|---|---|---|
| 1. Antigüedad | 78.564 | -3.940 | 0.688 | < 0.001 |
| 2. Kilometraje | 72.272 | -0.291 | 0.428 | < 0.001 |
| 3. Transmisión | 56.044 | -12.506 | 0.092 | < 0.001 |
Modelo 1, antigüedad. Un carro de 0 años se anuncia en promedio en 78,6 millones, y cada año de antigüedad resta 3,94 millones. El R² es 0,688: la antigüedad explica el 68,8 % de la variación del precio entre anuncios.
Modelo 2, kilometraje. Un carro con 0 km se anuncia en promedio en 72,3 millones, y cada 10.000 km adicionales restan unos 2,9 millones. El R² es 0,428, bastante menor que el de la antigüedad.
Modelo 3, transmisión. El intercepto es el promedio de la categoría de referencia, la transmisión automática: 56,0 millones. La pendiente es la diferencia con los mecánicos, que se anuncian 12,5 millones por debajo en promedio. El R² es 0,092: la transmisión sola dice poco del precio.
Significancia estadística. En los tres modelos el valor p de la pendiente es menor que 0,001, de modo que se rechaza que la pendiente sea cero con 314 anuncios. Que una relación sea significativa no la hace útil: la transmisión supera ese umbral y explica menos del 10 % de la variación.
Asociación y causalidad. Los coeficientes describen asociaciones, no efectos. La transmisión lo ilustra. El modelo asigna 12,5 millones menos a un mecánico, pero cambiar la caja de un carro no tiene por qué mover su precio en esa cantidad, porque los mecánicos de la base son además 3 años más viejos y al menos una parte de la diferencia es edad. El kilometraje se confunde de la misma forma con los años. Una lectura causal exigiría comparar carros iguales salvo en la característica de interés, y unos anuncios no permiten hacerlo.
El R² mide el ajuste sobre los datos con que se estimó el modelo.
Para juzgar la predicción sobre carros nuevos se usa validación cruzada
con 5 partes: los 314 anuncios se asignan al azar a 5 grupos y, en cada
vuelta, los tres modelos se reestiman con lm en 4 grupos y
se evalúan en el quinto. Todos los modelos comparten las mismas
particiones. La métrica es el MAE, el error absoluto medio en millones
de pesos, y la referencia es predecir siempre la mediana del precio de
entrenamiento. Un modelo que no mejora esa referencia no aporta.
set.seed(2026)
parte = sample(rep(1:5, length.out = nrow(datos))) # a qué parte queda asignado cada anuncio
table(parte)## parte
## 1 2 3 4 5
## 63 63 63 63 62# Aquí se guardan las predicciones de cada anuncio: una columna por modelo
pred = matrix(NA, nrow = nrow(datos), ncol = 4, dimnames = list(NULL, c("mediana", "edad", "km", "trans")))
for (k in 1:5) {
entrena = datos[parte != k, ] # 4 partes para estimar
prueba = datos[parte == k, ] # 1 parte para evaluar
pred[parte == k, "mediana"] = median(entrena$precio_mill)
pred[parte == k, "edad"] = predict(lm(precio_mill ~ antiguedad, data = entrena), prueba)
pred[parte == k, "km"] = predict(lm(precio_mill ~ km_mil, data = entrena), prueba)
pred[parte == k, "trans"] = predict(lm(precio_mill ~ transmision, data = entrena), prueba)
}
# MAE de cada columna: promedio del error en valor absoluto, en millones de pesos
mae = colMeans(abs(datos$precio_mill - pred))
comparacion = data.frame(MAE_millones = round(mae, 2), R2 = round(c(NA, resumen$R2), 3),
row.names = c("Mediana (referencia)", rownames(resumen)))
comparacion| MAE_millones | R2 | |
|---|---|---|
| Mediana (referencia) | 15.87 | NA |
| 1. Antigüedad | 5.81 | 0.688 |
| 2. Kilometraje | 10.06 | 0.428 |
| 3. Transmisión | 15.47 | 0.092 |
grafico_mae = data.frame(Modelo = factor(rownames(comparacion), levels = rev(rownames(comparacion))),
MAE = comparacion$MAE_millones)
ggplotly(
ggplot(grafico_mae, aes(x = Modelo, y = MAE)) +
geom_col(fill = c("grey80", "steelblue", "grey60", "grey60")) +
coord_flip() +
labs(title = "Figura 14. Error promedio en anuncios que el modelo no vio", x = "",
y = "MAE (millones de pesos)") +
theme_minimal()
)Predecir siempre la mediana da un MAE de 15,87 millones. El modelo de antigüedad lo reduce a 5,81, el 37 % del error de la referencia; el de kilometraje lo deja en 10,06 y el de transmisión en 15,47, casi sin mejora.
error_edad = abs(datos$precio_mill - pred[, "edad"])
mean(error_edad < 5) # proporción de anuncios con error menor a 5 millones## [1] 0.6273885median(error_edad) # la mitad de los errores es menor que esta cifra## [1] 3.713019Con el modelo de antigüedad, el 63 % de los anuncios tiene un error menor a 5 millones y la mitad, menor a 3,7. El MAE queda por encima de esa mediana porque unos pocos anuncios atípicos tienen errores muy grandes.
Se elige el modelo de antigüedad por tres razones.
El modelo tiene un límite. La recta se ajustó con carros de 0 a 15 años, que son casi toda la base. Extrapolada al modelo 1995, de 27 años, predice -27,8 millones (Figura 11), un precio imposible. Debe usarse dentro del rango observado, y su forma recta es una simplificación que el Punto 2 retoma con más variables.
El Punto 1 dejó dos pistas: la antigüedad explica la mayor parte del precio y las demás variables se confunden con ella. Un modelo múltiple mide cada característica con las otras fijas, es decir, compara carros de la misma edad que solo difieren en el kilometraje o en la caja de cambios.
Múltiple 1. Antigüedad, kilometraje y transmisión. Son las tres características que describen el desgaste y el equipamiento del carro, las que un comprador revisa primero, y las mismas de los modelos simples, ahora juntas.
Múltiple 2. Las tres anteriores más la región y el color. Prueba si el lugar donde se publica el anuncio o el color del carro cambian el precio una vez se conoce su edad.
Las categorías de referencia son la transmisión automática, Bogotá y el color gris. El coeficiente de cada categoría es la diferencia de precio frente a su referencia, con las demás variables fijas.
multiple_1 = lm(precio_mill ~ antiguedad + km_mil + transmision, data = datos)
multiple_2 = lm(precio_mill ~ antiguedad + km_mil + transmision + region + color_g, data = datos)
summary(multiple_1)##
## Call:
## lm(formula = precio_mill ~ antiguedad + km_mil + transmision,
## data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -67.802 -4.006 -0.968 2.919 100.935
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 80.71649 1.31688 61.294 < 2e-16 ***
## antiguedad -3.52564 0.21973 -16.045 < 2e-16 ***
## km_mil -0.03539 0.02039 -1.736 0.0836 .
## transmisionMecánica -5.50617 1.29493 -4.252 2.81e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11.15 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: < 2.2e-16summary(multiple_2)##
## Call:
## lm(formula = precio_mill ~ antiguedad + km_mil + transmision +
## region + color_g, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -70.133 -4.012 -0.955 3.265 98.212
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 79.45344 2.14925 36.968 < 2e-16 ***
## antiguedad -3.52531 0.22995 -15.331 < 2e-16 ***
## km_mil -0.03510 0.02075 -1.692 0.091675 .
## transmisionMecánica -5.04899 1.33103 -3.793 0.000179 ***
## regionAntioquia 2.38767 2.04147 1.170 0.243085
## regionValle del Cauca 3.97497 2.20293 1.804 0.072158 .
## regionResto del país 1.58662 1.87632 0.846 0.398439
## color_gBlanco -1.96050 1.72131 -1.139 0.255617
## color_gRojo -1.50128 2.05959 -0.729 0.466610
## color_gOtro -0.84297 1.67489 -0.503 0.615120
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11.17 on 304 degrees of freedom
## Multiple R-squared: 0.7129, Adjusted R-squared: 0.7044
## F-statistic: 83.88 on 9 and 304 DF, p-value: < 2.2e-16data.frame(R2_ajustado = round(c(summary(multiple_1)$adj.r.squared, summary(multiple_2)$adj.r.squared), 4),
AIC = round(c(AIC(multiple_1), AIC(multiple_2)), 1),
row.names = c("Múltiple 1", "Múltiple 2"))| R2_ajustado | AIC | |
|---|---|---|
| Múltiple 1 | 0.7055 | 2411.3 |
| Múltiple 2 | 0.7044 | 2418.3 |
anova(multiple_1, multiple_2) # ¿aportan algo, juntas, la región y el color?| Res.Df | RSS | Df | Sum of Sq | F | Pr(>F) |
|---|---|---|---|---|---|
| 310 | 38526.83 | NA | NA | NA | NA |
| 304 | 37916.89 | 6 | 609.9421 | 0.8150388 | 0.5588889 |
En el Múltiple 1, cada año de antigüedad resta 3,53 millones al precio anunciado de un carro con el mismo kilometraje y la misma transmisión. Un mecánico se anuncia 5,51 millones por debajo de un automático de igual edad y recorrido, menos de la mitad de los 12,5 millones del modelo simple. Al fijar la edad desaparece la parte de la diferencia que venía de que los mecánicos son más viejos.
El kilometraje pierde fuerza. Cada 10.000 km restan 0,35 millones, con un valor p de 0,084, por encima de 0,05. Una vez se conoce la edad del carro, el recorrido agrega poca información, como anticipaba la correlación de 0,74 entre ambas variables.
El R² ajustado del Múltiple 1 es 0,705. Frente al 0,688 de la antigüedad sola, las otras dos variables suman poco.
En el Múltiple 2 ninguna región y ningún color tienen un coeficiente significativo al 5 %. El más grande es el del Valle del Cauca, 3,97 millones más que Bogotá, con un valor p de 0,072. El R² ajustado baja a 0,704, y la prueba F que compara los dos modelos da un valor p de 0,56: las seis variables nuevas, juntas, no mejoran el ajuste. La diferencia del Valle que se veía en la Figura 9 era, en su mayor parte, edad.
La selección paso a paso con AIC parte del Múltiple 2 y busca en las dos direcciones: en cada paso puede quitar una variable o devolver una que ya había quitado.
paso_a_paso = step(multiple_2, direction = "both")## Start: AIC=1525.24
## precio_mill ~ antiguedad + km_mil + transmision + region + color_g
##
## Df Sum of Sq RSS AIC
## - color_g 3 175.5 38092 1520.7
## - region 3 434.1 38351 1522.8
## <none> 37917 1525.2
## - km_mil 1 357.1 38274 1526.2
## - transmision 1 1794.7 39712 1537.8
## - antiguedad 1 29314.0 67231 1703.1
##
## Step: AIC=1520.69
## precio_mill ~ antiguedad + km_mil + transmision + region
##
## Df Sum of Sq RSS AIC
## - region 3 434.4 38527 1518.2
## <none> 38092 1520.7
## - km_mil 1 416.9 38509 1522.1
## + color_g 3 175.5 37917 1525.2
## - transmision 1 1932.0 40024 1534.2
## - antiguedad 1 30791.3 68884 1704.7
##
## Step: AIC=1518.25
## precio_mill ~ antiguedad + km_mil + transmision
##
## Df Sum of Sq RSS AIC
## <none> 38527 1518.2
## - km_mil 1 374 38901 1519.3
## + region 3 434 38092 1520.7
## + color_g 3 176 38351 1522.8
## - transmision 1 2247 40774 1534.0
## - antiguedad 1 31995 70522 1706.1formula(paso_a_paso)## precio_mill ~ antiguedad + km_mil + transmisionAIC(multiple_1, multiple_2, paso_a_paso)| df | AIC | |
|---|---|---|
| multiple_1 | 5 | 2411.345 |
| multiple_2 | 11 | 2418.334 |
| paso_a_paso | 5 | 2411.345 |
El procedimiento quita primero el color, después la región, y termina en el Múltiple 1. Lo que cambia es la complejidad: el modelo pierde seis coeficientes y su AIC baja de 2.418,3 a 2.411,3. El kilometraje se queda, aunque no sea significativo al 5 %, porque quitarlo sube el AIC.
Se evalúan sobre el Múltiple 1, el modelo que eligió el paso a paso.
diag1 = data.frame(ajustado = fitted(multiple_1), residuo = residuals(multiple_1),
cook = cooks.distance(multiple_1), anuncio = datos$anuncio, orden = 1:nrow(datos))
ggplotly(
ggplot(diag1, aes(x = ajustado, y = residuo, text = anuncio)) +
geom_point(color = "steelblue", alpha = 0.7, size = 2) +
geom_hline(yintercept = 0, color = "red") +
labs(title = "Figura 15. Residuos frente a valores ajustados (Múltiple 1)",
x = "Precio ajustado (millones de pesos)", y = "Residuo (millones de pesos)") +
theme_minimal()
)# Residuo promedio según la antigüedad: si la recta sirve, debería estar cerca de cero en todas las edades
res_edad = tapply(residuals(multiple_1), datos$antiguedad, mean)
round(res_edad, 1)## 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
## 4.4 4.1 -0.6 1.8 -0.1 0.9 1.0 -6.5 -4.6 -3.6 -3.3 -0.8 2.1 3.1 1.5 15.8
## 27
## 59.8# Cuantiles teóricos de una normal; la línea roja pasa por el primer y el tercer cuartil (como qqline)
qq = data.frame(teorico = qqnorm(diag1$residuo, plot.it = FALSE)$x, residuo = diag1$residuo, anuncio = diag1$anuncio)
pendiente = diff(quantile(qq$residuo, c(0.25, 0.75))) / diff(qnorm(c(0.25, 0.75)))
intercepto = quantile(qq$residuo, 0.25) - pendiente * qnorm(0.25)
ggplotly(
ggplot(qq, aes(x = teorico, y = residuo, text = anuncio)) +
geom_point(color = "steelblue", size = 2) +
geom_abline(intercept = intercepto, slope = pendiente, color = "red") +
labs(title = "Figura 16. Gráfico cuantil-cuantil de los residuos", x = "Cuantiles teóricos de una normal",
y = "Residuos (millones de pesos)") +
theme_minimal()
)ggplotly(
ggplot(diag1, aes(x = orden, y = cook, text = anuncio)) +
geom_point(color = "steelblue", size = 2) +
geom_hline(yintercept = 4 / nrow(datos), color = "red", linetype = "dashed") +
labs(title = "Figura 17. Distancia de Cook de cada anuncio", x = "Anuncio (orden en la base)",
y = "Distancia de Cook") +
theme_minimal()
)bptest(multiple_1) # varianza constante (Breusch-Pagan)##
## studentized Breusch-Pagan test
##
## data: multiple_1
## BP = 2.1372, df = 3, p-value = 0.5444shapiro.test(residuals(multiple_1)) # normalidad de los errores (Shapiro-Wilk)##
## Shapiro-Wilk normality test
##
## data: residuals(multiple_1)
## W = 0.59398, p-value < 2.2e-16vif(multiple_1) # multicolinealidad## antiguedad km_mil transmision
## 2.274156 2.238471 1.046745dwtest(multiple_1) # independencia (Durbin-Watson)##
## Durbin-Watson test
##
## data: multiple_1
## DW = 1.9823, p-value = 0.4352
## alternative hypothesis: true autocorrelation is greater than 0influyentes = cooks.distance(multiple_1) > 4 / nrow(datos)
sum(influyentes)## [1] 10datos[influyentes, c("precio_mill", "modelo", "kilometraje", "transmision")]| precio_mill | modelo | kilometraje | transmision |
|---|---|---|---|
| 119.9 | 2021 | 29000 | Automática |
| 22.0 | 2008 | 136 | Automática |
| 22.0 | 2008 | 136 | Automática |
| 28.9 | 2017 | 12345 | Mecánica |
| 29.9 | 1995 | 280000 | Mecánica |
| 159.9 | 2022 | 0 | Automática |
| 169.8 | 2019 | 36026 | Automática |
| 6.8 | 2022 | 17200 | Mecánica |
| 25.8 | 2019 | 129000 | Automática |
| 107.5 | 2021 | 17909 | Automática |
sin_influyentes = lm(precio_mill ~ antiguedad + km_mil + transmision, data = datos[!influyentes, ])
round(cbind(Todos = coef(multiple_1), Sin_influyentes = coef(sin_influyentes)), 3)## Todos Sin_influyentes
## (Intercept) 80.716 80.257
## antiguedad -3.526 -3.606
## km_mil -0.035 -0.038
## transmisionMecánica -5.506 -3.887Linealidad. Los residuos no se reparten al azar alrededor de cero. El modelo subestima a los carros de 0 y 1 año (residuos medios de 4,4 y 4,1 millones) y sobreestima a los de 7 a 10 años, con residuos medios entre -6,5 y -3,3. La recta no sigue dos rasgos de los datos: el carro pierde más valor en sus primeros años y hay un salto entre los 6 y los 7 años. Ese salto coincide con la llegada de la nueva generación del Mazda 2, el modelo 2016, que se presentó en Colombia en marzo de 2015 (Autocosmos, 2015). Es una hipótesis, porque la base no registra la generación del carro. La consecuencia es un error sistemático: para ciertas edades el modelo se equivoca siempre hacia el mismo lado.
Varianza constante. La prueba de Breusch-Pagan da un valor p de 0,54, así que no hay evidencia de heterocedasticidad. La Figura 15 lo matiza: los residuos más grandes están entre los carros de precio ajustado más alto, los más nuevos, pero son unos pocos anuncios atípicos; el grueso de la nube tiene un ancho parecido en todo el rango. El punto aislado a la izquierda es el modelo 1995.
Normalidad de los errores. Shapiro-Wilk rechaza la normalidad (valor p menor que 0,001) y la Figura 16 muestra por qué: las dos colas se separan de la línea, arrastradas por los anuncios atípicos. Con 314 observaciones, los valores p de los coeficientes siguen siendo una aproximación razonable; los intervalos de predicción, que suponen errores normales, son menos confiables para un carro en particular.
Multicolinealidad. Los VIF de la antigüedad y el kilometraje son de 2,27, por debajo del umbral habitual de 5. El traslape entre las dos variables infla el error estándar del kilometraje y ayuda a explicar que no sea significativo, sin invalidar el modelo.
Independencia. Cada anuncio corresponde a un carro distinto, salvo el probable duplicado del Punto 1. La prueba de Durbin-Watson, en el orden de la base, da 1,98 con un valor p de 0,44: no hay señal de errores correlacionados.
Observaciones influyentes. 10 anuncios superan el umbral de Cook de 4/n (0,0127), entre ellos los cuatro carros de más de 100 millones, el 2022 anunciado en 6,8 millones, el modelo 1995 y el par de 2008 con 136 km. Sin ellos, el coeficiente de la antigüedad apenas cambia (de -3,53 a -3,61), pero el descuento por transmisión mecánica baja de 5,51 a 3,89 millones. El efecto de la edad es sólido; el tamaño del descuento por la caja depende de pocos anuncios. Se conservan, por la decisión tomada en el Punto 1.
El Múltiple 1 predice para el carro de 1995 un precio de -29,9 millones. Un carro no pierde una cantidad fija de pesos cada año: pierde una proporción de su valor, más pesos cuando es nuevo y caro y menos cuando ya es barato, que es la curvatura que mostraron los residuos. El precio, además, tiene una cola larga a la derecha (Figura 3). El logaritmo del precio responde a las tres cosas, porque convierte la depreciación en un porcentaje anual y nunca produce precios negativos. Se transforma el Múltiple 1, el modelo elegido en el paso anterior.
modelo_log = lm(log(precio_mill) ~ antiguedad + km_mil + transmision, data = datos)
summary(modelo_log)##
## Call:
## lm(formula = log(precio_mill) ~ antiguedad + km_mil + transmision,
## data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.40126 -0.05946 0.00066 0.07333 1.04225
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.4043142 0.0238659 184.544 < 2e-16 ***
## antiguedad -0.0701307 0.0039822 -17.611 < 2e-16 ***
## km_mil -0.0002627 0.0003696 -0.711 0.477655
## transmisionMecánica -0.0816101 0.0234681 -3.477 0.000578 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.202 on 310 degrees of freedom
## Multiple R-squared: 0.7213, Adjusted R-squared: 0.7186
## F-statistic: 267.4 on 3 and 310 DF, p-value: < 2.2e-16round((exp(coef(modelo_log)[-1]) - 1) * 100, 2) # efecto de cada variable, en % del precio## antiguedad km_mil transmisionMecánica
## -6.77 -0.03 -7.84bptest(modelo_log)##
## studentized Breusch-Pagan test
##
## data: modelo_log
## BP = 2.8893, df = 3, p-value = 0.409shapiro.test(residuals(modelo_log))##
## Shapiro-Wilk normality test
##
## data: residuals(modelo_log)
## W = 0.56148, p-value < 2.2e-16round(tapply(residuals(modelo_log), datos$antiguedad, mean), 3)## 0 1 2 3 4 5 6 7 8 9 10
## -0.042 0.050 0.016 0.027 0.055 0.072 0.085 -0.071 -0.055 -0.046 -0.058
## 11 12 13 14 15 27
## -0.030 0.012 0.016 -0.042 0.274 1.042Con el logaritmo, cada año de antigüedad reduce el precio en 6,8 %, con kilometraje y transmisión fijos, y un mecánico se anuncia 7,8 % por debajo de un automático comparable. El kilometraje sigue sin ser significativo (valor p de 0,48). Breusch-Pagan da 0,41 y Shapiro-Wilk sigue rechazando la normalidad, porque los atípicos no desaparecen con el cambio de escala. Tampoco desaparece el salto de generación: los residuos siguen siendo positivos de 4 a 6 años y negativos de 7 a 10.
# Precio que predice cada modelo para un automático con el kilometraje mediano, de 0 a 27 años
curva = data.frame(antiguedad = 0:27, km_mil = median(datos$km_mil), transmision = "Automática")
curva$recta = predict(multiple_1, curva)
curva$curva_log = exp(predict(modelo_log, curva))
ggplotly(
ggplot(datos, aes(x = antiguedad, y = precio_mill)) +
geom_point(color = "grey60", alpha = 0.7, size = 2) +
geom_line(data = curva, aes(y = recta, color = "Múltiple 1 (precio)"), linewidth = 1) +
geom_line(data = curva, aes(y = curva_log, color = "Múltiple 1 (logaritmo del precio)"), linewidth = 1) +
scale_color_manual(values = c("Múltiple 1 (precio)" = "red", "Múltiple 1 (logaritmo del precio)" = "steelblue")) +
labs(title = "Figura 18. La recta y la curva del logaritmo", x = "Antigüedad (años)",
y = "Precio (millones de pesos)", color = "") +
theme_minimal()
)La Figura 18 muestra la diferencia para un automático con el kilometraje mediano: la recta cruza el cero después de los 20 años; la curva baja cada vez más despacio y se queda en precios positivos.
Para comparar el MAE de los modelos múltiples y del logaritmo se repite la validación cruzada con las mismas 5 partes del Punto 1. El paso a paso se hace dentro de cada partición, con los datos de entrenamiento, como pide el caso. Las predicciones del modelo en logaritmo se devuelven a millones de pesos con la exponencial, que estima la mediana del precio, coherente con un error absoluto.
pred2 = matrix(NA, nrow = nrow(datos), ncol = 4, dimnames = list(NULL, c("m1", "m2", "paso", "log")))
vars_paso = list() # variables que conserva el paso a paso en cada partición
for (k in 1:5) {
entrena = datos[parte != k, ]
prueba = datos[parte == k, ]
pred2[parte == k, "m1"] = predict(lm(precio_mill ~ antiguedad + km_mil + transmision, data = entrena), prueba)
completo = lm(precio_mill ~ antiguedad + km_mil + transmision + region + color_g, data = entrena)
pred2[parte == k, "m2"] = predict(completo, prueba)
elegido = step(completo, direction = "both", trace = 0)
vars_paso[[k]] = attr(terms(elegido), "term.labels")
pred2[parte == k, "paso"] = predict(elegido, prueba)
pred2[parte == k, "log"] = exp(predict(lm(log(precio_mill) ~ antiguedad + km_mil + transmision, data = entrena), prueba))
}
mae2 = colMeans(abs(datos$precio_mill - pred2))
round(mae2, 2)## m1 m2 paso log
## 5.63 5.93 5.82 4.96vars_paso## [[1]]
## [1] "antiguedad" "km_mil" "transmision"
##
## [[2]]
## [1] "antiguedad" "transmision"
##
## [[3]]
## [1] "antiguedad" "km_mil" "transmision"
##
## [[4]]
## [1] "antiguedad" "km_mil" "transmision" "color_g"
##
## [[5]]
## [1] "antiguedad" "km_mil" "transmision" "region"En millones de pesos, el modelo en logaritmo se equivoca en promedio por 4,96 millones y el Múltiple 1 original por 5,63: la transformación reduce el error en 0,67 millones, un 12 %. Como recomienda el caso, no se comparan el R² ni el AIC del modelo en logaritmo con los del original, porque la respuesta está en otra escala.
comparacion_total = data.frame(
MAE_millones = round(c(mae, mae2), 2),
row.names = c("Mediana (referencia)", "Simple: antigüedad", "Simple: kilometraje", "Simple: transmisión",
"Múltiple 1", "Múltiple 2", "Paso a paso (AIC)", "Múltiple 1 con logaritmo"))
comparacion_total| MAE_millones | |
|---|---|
| Mediana (referencia) | 15.87 |
| Simple: antigüedad | 5.81 |
| Simple: kilometraje | 10.06 |
| Simple: transmisión | 15.47 |
| Múltiple 1 | 5.63 |
| Múltiple 2 | 5.93 |
| Paso a paso (AIC) | 5.82 |
| Múltiple 1 con logaritmo | 4.96 |
grafico_total = data.frame(Modelo = factor(rownames(comparacion_total), levels = rev(rownames(comparacion_total))),
MAE = comparacion_total$MAE_millones)
ggplotly(
ggplot(grafico_total, aes(x = Modelo, y = MAE)) +
geom_col(fill = ifelse(grafico_total$MAE == min(grafico_total$MAE), "steelblue", "grey70")) +
coord_flip() +
labs(title = "Figura 19. Error promedio de los ocho modelos en validación cruzada", x = "",
y = "MAE (millones de pesos)") +
theme_minimal()
)Los modelos múltiples en pesos mejoran poco a la antigüedad sola: el Múltiple 1 baja el MAE de 5,81 a 5,63 millones y el Múltiple 2 lo sube a 5,93, porque estima seis coeficientes que no aportan. El paso a paso evaluado dentro de cada partición queda en 5,82. En 2 de las cinco particiones conservó la región o el color, y en 1 descartó el kilometraje: la selección cambia con la muestra, y ese vaivén cuesta precisión.
Se elige el Múltiple 1 con logaritmo del precio. Es el más preciso de los ocho, con un MAE de 4,96 millones. Es coherente con cómo se deprecia un carro, en porcentaje y sin precios negativos, y se explica en una frase: cada año resta cerca del 7 % del precio.
Para ilustrar su uso se construyen dos escenarios con valores típicos de la base. En el A, un vendedor va a publicar un Mazda 2 automático modelo 2018 (4 años) con 60.000 km. En el B, un comprador encuentra un Mazda 2 mecánico modelo 2012 (10 años) con 120.000 km anunciado en 45 millones.
escenarios = data.frame(antiguedad = c(4, 10), km_mil = c(60, 120), transmision = c("Automática", "Mecánica"),
row.names = c("A. Automático 2018, 60.000 km", "B. Mecánico 2012, 120.000 km"))
# Predicción e intervalo de predicción del 95 %, devueltos a millones de pesos
pred_esc = exp(predict(modelo_log, escenarios, interval = "prediction", level = 0.95))
round(pred_esc, 1)## fit lwr upr
## A. Automático 2018, 60.000 km 60.8 40.8 90.6
## B. Mecánico 2012, 120.000 km 36.2 24.3 54.0graf_esc = data.frame(Escenario = rownames(pred_esc), pred_esc)
ggplotly(
ggplot(graf_esc, aes(x = Escenario, y = fit, ymin = lwr, ymax = upr)) +
geom_segment(aes(xend = Escenario, y = lwr, yend = upr), color = "steelblue", linewidth = 4, alpha = 0.5) +
geom_point(color = "steelblue", size = 5) +
geom_point(data = data.frame(Escenario = rownames(pred_esc)[2], fit = 45, lwr = 45, upr = 45),
color = "red", shape = 4, size = 4, stroke = 2) +
labs(title = "Figura 20. Precio estimado e intervalo de predicción del 95 %", x = "",
y = "Precio (millones de pesos)") +
theme_minimal()
)Para el escenario A el modelo estima 60,8 millones, con un intervalo de predicción del 95 % entre 40,8 y 90,6. Para el B estima 36,2 millones, entre 24,3 y 54,0. El anuncio de 45 millones del escenario B (la equis roja de la Figura 20) está por encima de lo esperado, aunque dentro del intervalo: el comprador tiene argumentos para negociar, no para descartar el carro. Los intervalos son amplios, de 50 millones de ancho en el A, y eso dice algo honesto sobre el modelo: con tres variables ubica el precio en un rango, no en una cifra.
error_log = abs(datos$precio_mill - pred2[, "log"])
mean(error_log) / median(datos$precio_mill) # MAE frente al precio típico## [1] 0.1181712mean(error_log < 5) # proporción de anuncios con error menor a 5 millones## [1] 0.6910828median(error_log / datos$precio_mill) # error relativo mediano## [1] 0.06816731mean(pred2[, "log"] > datos$precio_mill) # proporción de anuncios sobreestimados## [1] 0.4968153# MAE según la antigüedad del carro
tapply(error_log, cut(datos$antiguedad, c(-1, 3, 7, 11, 30), labels = c("0 a 3", "4 a 7", "8 a 11", "12 o más")), mean)## 0 a 3 4 a 7 8 a 11 12 o más
## 9.414482 5.029698 2.461265 3.358361# Información que aparece en el texto del anuncio pero no es una variable de la base
texto = tolower(datos$link)
sum(grepl("touring", texto)) # versión Touring o Grand Touring## [1] 92sum(grepl("sed[aá]n", texto)) # carrocería sedán## [1] 31sum(grepl("salvamento", texto)) # carros de salvamento## [1] 2sum(grepl("recibo|permuto|permuta|vencambio", texto)) # permutas y compraventas## [1] 9¿Quién utilizaría el modelo y para qué decisión? El vendedor particular que decide en cuánto publicar su carro, el comprador que decide si un anuncio está caro y cuánto ofrecer, y los negocios de compraventa que reciben carros como parte de pago, una práctica visible en la base: 9 anuncios hablan de recibir otro vehículo, de permutas o de una compraventa. En los tres casos la decisión es el precio de publicación o la primera oferta, no el precio de cierre.
¿Qué significa el error en la práctica? El modelo se equivoca en promedio por 4,96 millones, el 12 % del precio típico de 42 millones. En el 69 % de los anuncios el error es menor a 5 millones, y la mitad de los errores no pasa del 7 % del precio del carro. El error no es parejo: en los carros de 0 a 3 años el MAE es de 9,4 millones y en los de 8 a 11 años, de 2,5. Como precio de referencia para publicar o para empezar a negociar nos parece aceptable. Para tasar un carro con fines de crédito, seguros o impuestos no lo es, porque allí un error de 5 millones se convierte directamente en dinero.
¿Qué consecuencias tendría sobreestimar o subestimar? Si el modelo sobreestima, el vendedor publica por encima de carros comparables, tarda más en vender y probablemente termina rebajando; el comprador, por su parte, acepta pagar de más. Si subestima, el vendedor vende rápido pero deja dinero sobre la mesa, y el comprador descarta anuncios que tenían un precio justo. Para el vendedor, subestimar parece más costoso, porque un precio alto se puede bajar y el dinero perdido no se recupera. En la validación cruzada el modelo sobreestima en el 49,7 % de los anuncios, así que no se inclina hacia ningún lado; los errores grandes se concentran en los carros nuevos y en los anuncios atípicos.
¿Cuáles son sus limitaciones y cuándo no debería usarse? La primera es de origen: la base registra lo que el vendedor pide, no lo que el comprador paga. Los anuncios son de septiembre de 2022, y los precios de los usados se mueven con la inflación y con la oferta de carros nuevos, así que habría que reestimar el modelo antes de usarlo hoy. Faltan variables que el comprador sí ve en el anuncio: la versión del carro (92 anuncios mencionan la versión Touring en el texto), la carrocería sedán o hatchback, el estado y el historial (2 anuncios aclaran que el carro es de salvamento). El modelo tampoco recoge el salto entre los 6 y los 7 años, y conserva los anuncios atípicos. No debería usarse para carros de más de 15 años (la base tiene uno), para modelos del año, cuyos precios en la base van de 6,8 a 159,9 millones, para otras marcas o modelos, ni para ninguna decisión que dependa del precio de venta.
¿Recomendamos aplicarlo? Sí, con condiciones: como un rango de referencia para Mazda 2 de 1 a 15 años, con el intervalo de predicción a la vista y no como una cifra única, y con más cautela en los carros de 0 a 3 años. Antes de usarlo en una decisión con dinero de por medio harían falta precios de venta reales, la versión y la carrocería como variables, el historial del carro, la fecha de publicación y datos actualizados. Una variable que distinga la generación del carro (modelo 2016 en adelante) probablemente reduciría el error de los carros de 4 a 10 años, que es donde el modelo se equivoca de forma sistemática.
Con tres características del anuncio, el Múltiple 1 con logaritmo del precio estima el precio anunciado de un Mazda 2 usado con un error promedio de 4,96 millones, cerca del 12 % del precio típico, y lo hace mejor que los otros siete modelos evaluados. La antigüedad hace casi todo el trabajo: cada año resta cerca del 7 % del precio. La región y el color no aportan, y la diferencia por transmisión se reduce a menos de la mitad cuando se comparan carros de la misma edad. El modelo sirve para orientar a quien publica o compra. No reemplaza la revisión del carro ni dice a qué precio se vende.
Autocosmos (27 de marzo de 2015). Mazda2 2016 llega a Colombia desde 43 millones de pesos. https://noticias.autocosmos.com.co/2015/03/27/mazda2-2016-llega-a-colombia-desde-43-millones-de-pesos