El siguiente informe tiene cómo objetivo ofrecer una visión general clara y sintetizada del análisis realizado. En él se describen los datos utilizados, la metodología y los resultados obtenidos, destacando los aspectos más relevantes para la comprensión del estudio. A partir del dataset “Used Cars Prices in Spain” (kaggle) se definen los objetivos, tareas de preprocesado y un análisis exploratorio que permite entender relaciones entre variables clave.
El estudio busca predecir el precio de oferta de un coche usado, clasificación binaria para identificar vehículos con baja deprecación, agrupar coches con características similares y sintetizar variables correlacionadas para mejorar la eficiencia del modelado.
Para todo ello, se hace una limpieza del dataset que incluye eliminación de columnas irrelevantes, tratamiento de valores nulos, filtrado de outliers, eliminación de duplicados e ingeniería de caracterísitcas basada en los conceptos de negocio.
Finalmente, se identifican patrones esenciales relacionados con la deprecación, precio y características técnicas del vehículo.
Nuestro primer paso, así como se expresa en el “Caso de estudio” que se nos presenta como ejemplo de ejercicio, debe ser es de establecer un objetivo analítico. Debemos plantear el problema o pregunta que trataremos de resolver con el proyecto.
En este caso, nuestro estudio se centrará en cuantificar y modelar los factores que determinan el precio de venta de un coche usado en España. El contexto de negocio se centra en crear herramientas predictivas de valoración que permitan a concesionarios o plataformas de venta determinar el valor justo de mercado de un vehículo usado, así como identificar vehículos subvalorados o sobrevalorados
El problema analítico que abordaremos será el de cuantificar
y modelar la deprecación del vehículo y los factores que determinan el
precio de venta de un coche usado en España. Buscamos
identificar que características tienen un mayor impacto en el precio
final de oferta: brand, year, KM o CV, entre otros.
Nuestro problema analítico es de naturaleza mixta ya que requiere abordar varios objetivos:
El primer objetivo es la
Regresión (Modelo Supervisado), siendo el objetivo
principal del proyecto el de predecir el precio de oferta del vehículo,
una variable numérica continua.
El segundo objetivo es la
Reducción de Dimensionalidad (Pre-Modelado), debemos
sintetizar algunas variables técnicas altamente correlacionadas en unos
pocos factores de valoración técnica clave, con esto haremos que el
modelado sea robusto y eficiente.
El tercer objetivo es la
Segmentación (Modelado No Supervisado), buscando agrupar
los vehículos en segmentos de mercado homogéneos basándonos en sus
caracterísitcas y precios (Deportivo, Familiar, etc.).
El cuarto objetivo es la
Clasificación Binaria (Modelo Supervisado), donde el
objetivo secundario es clasificar un vehículo segín sus características
como “Baja deprecación” o “Alta deprecación”, a partir de una variable
binaria derivada.
De modo que se trata de un problema de Regresión,
Clasificación y Segmentación seguido de una
etapa crucial de Reducción de Dimensionalidad. Hemos
establecido un conjunto de métricas para evaluar el rendimiento de los
modelos diferenciando entre los objetivos de regresión y los de
clasificación.
Para el objetivo de Regresión, predicción del precio de
oferta del vehículo, utilizaremos el Error Cuadrático Medio de la Raíz.
Nuestro objetivo de cumplimiento será minimizar la desviación promedio
entre el precio predicho y el precio real de la transacción.
Para el objetivo de Clasificación Binaria, determinar si
un vehículo es de “Baja Deprecación”, utilizaremos una métrica
fundamental F1-score, la cuál nos indicará la proporción de predicciones
correctas sobre el total de casos clasificados, el objetivo de
cumplimiento se establecerá en alcanzar un valor superior al 85% para la
identificación de vehículos de baja deprecación.
El dataset elegido es “Used Cars Prices in Spain” (kaggle), que se alinea con el problema de “cuantificar y modelar la deprecación del vehículo y los factores que determinan el precio de venta de un coche usado en España”.
Este juego de datos contiene 5980 observaciones, tenemos 24 variables, 19 de ellas numéricas, 3 categóricas y 1 binaria. Los requisitos eran >= 5 numéricas, >= 2 categóricas y >= 1 binaria.
La estructura del juego de datos permite abordar la
regresión sobre Price, la
clasificación sobre una variable binaria y la
segmentación.
Empezaremos por leer el juego de datos y responder a las preguntas clave de ¿El juego de datos contiene errores?, ¿Hay cosas extrañas entre los datos? o ¿Voy a tener que corregir o eliminar parte de los datos?
path <- "used_cars.csv"
# Cargamos el archivo
carsData <- read.csv(path, row.names = NULL)El siguiente paso es visualizar el juego de datos para identificar errores y anomalías siendo muy importante que los gestionemos antes de iniciar el estudio analítico.
Visualizamos en la siguiente tabla, las primeras seis filas y sus
respectivas columnas y observamos que
Brand, Model, Price, KM y Year son las claves y sus nombres
siendo lo suficientemente descriptivos para saber que hace cada una de
ellas:
# mostramos las primeras 10 filas
head(carsData, 10)## X Brand Name Sticker Year KM Fuel CV
## 1 0 Opel Opel Corsa C 2022 47707 Diésel 102
## 2 1 Peugeot Peugeot Rifter C 2019 57194 Diésel 130
## 3 2 Renault Renault Kadjar C 2017 66428 Diésel 110
## 4 3 Dacia Dacia Sandero C 2016 48430 Gasolina 75
## 5 4 Nissan Nissan QASHQAI C 2020 72209 Gasolina 160
## 6 5 BMW BMW X2 C 2018 123979 Diésel 150
## 7 6 KIA KIA Stonic C 2018 125737 Diésel 110
## 8 7 KIA KIA Stonic C 2019 130012 Gasolina 100
## 9 8 Volkswagen Volkswagen T-Cross C 2020 27769 Gasolina 150
## 10 9 Land Rover Land Rover Range Rover Evoque ECO 2019 75212 Híbrido 200
## Transmission One_owner Location Length Width Height Weight Trunk Tank Vmax
## 1 MANUAL True Almería 4.06 1.77 1.43 1165 NA - 188
## 2 AUTO True Almería 4.40 1.85 1.82 1430 1355 - 179
## 3 MANUAL False Barcelona 4.45 1.84 1.61 1380 1478 - 182
## 4 MANUAL True Madrid 4.06 1.73 1.52 941 1200 - 162
## 5 AUTO False Málaga 4.39 1.81 1.59 1315 1598 - 198
## 6 AUTO False Barcelona 4.36 1.82 1.53 1575 1355 - 207
## 7 MANUAL False Murcia 4.14 1.76 1.52 1255 1155 - 175
## 8 MANUAL True Zaragoza 4.14 1.76 1.52 1180 1155 - 179
## 9 AUTO False Madrid 4.11 1.76 1.58 1330 1281 - 200
## 10 AUTO False Barcelona 4.37 1.90 1.65 1845 1156 - 216
## X0to100 Consumption Emissions Keys_num Extras_num Price
## 1 10.2 4.1 107 1 5 15700
## 2 4.3 114.0 NA 2 5 24900
## 3 11.9 3.8 99 2 5 17800
## 4 14.5 5.8 130 2 3 9300
## 5 9.9 6.9 156 2 5 21500
## 6 9.3 4.5 119 2 5 20900
## 7 11.3 4.2 109 2 5 15690
## 8 10.8 6.1 139 2 5 13500
## 9 8.5 6.6 119 1 5 23800
## 10 8.5 7.7 176 2 5 37900Con la función skim podemos observar que hay varios
valores que tienen NA’s.
# vemos valores con NA
skim(carsData)| Name | carsData |
| Number of rows | 5980 |
| Number of columns | 24 |
| _______________________ | |
| Column type frequency: | |
| character | 8 |
| numeric | 16 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| Brand | 0 | 1 | 0 | 10 | 7 | 45 | 0 |
| Name | 0 | 1 | 0 | 29 | 7 | 269 | 0 |
| Sticker | 0 | 1 | 0 | 11 | 32 | 5 | 0 |
| Fuel | 0 | 1 | 0 | 18 | 7 | 8 | 0 |
| Transmission | 0 | 1 | 0 | 6 | 7 | 3 | 0 |
| One_owner | 0 | 1 | 0 | 5 | 7 | 3 | 0 |
| Location | 0 | 1 | 0 | 10 | 1139 | 29 | 0 |
| Tank | 0 | 1 | 0 | 1 | 7 | 2 | 0 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| X | 0 | 1.00 | 2989.50 | 1726.42 | 0.0 | 1494.75 | 2989.50 | 4484.25 | 5979.00 | ▇▇▇▇▇ |
| Year | 7 | 1.00 | 2018.01 | 3.67 | 2000.0 | 2016.00 | 2019.00 | 2021.00 | 2024.00 | ▁▁▂▇▆ |
| KM | 7 | 1.00 | 81691.98 | 57054.50 | 5.0 | 46201.00 | 74836.00 | 108827.00 | 1116416.00 | ▇▁▁▁▁ |
| CV | 7 | 1.00 | 133.58 | 48.99 | 20.0 | 102.00 | 125.00 | 150.00 | 498.00 | ▆▇▁▁▁ |
| Length | 7 | 1.00 | 4.35 | 0.40 | 0.0 | 4.14 | 4.36 | 4.52 | 6.84 | ▁▁▂▇▁ |
| Width | 16 | 1.00 | 1.80 | 0.11 | 0.0 | 1.77 | 1.80 | 1.84 | 2.08 | ▁▁▁▁▇ |
| Height | 11 | 1.00 | 1.57 | 0.18 | 0.0 | 1.45 | 1.52 | 1.65 | 3.08 | ▁▁▇▁▁ |
| Weight | 27 | 1.00 | 1387.06 | 240.58 | 790.0 | 1210.00 | 1361.00 | 1513.00 | 2425.00 | ▂▇▅▁▁ |
| Trunk | 1367 | 0.77 | 1334.00 | 375.61 | 406.0 | 1143.00 | 1251.00 | 1503.00 | 3500.00 | ▂▇▁▁▁ |
| Vmax | 165 | 0.97 | 191.22 | 20.54 | 5.0 | 178.00 | 190.00 | 202.00 | 270.00 | ▁▁▁▇▁ |
| X0to100 | 33 | 0.99 | 13.91 | 26.30 | 3.9 | 8.80 | 10.30 | 11.50 | 352.00 | ▇▁▁▁▁ |
| Consumption | 189 | 0.97 | 19.75 | 48.85 | 1.0 | 4.50 | 5.30 | 6.20 | 602.00 | ▇▁▁▁▁ |
| Emissions | 886 | 0.85 | 125.05 | 26.24 | 31.0 | 110.00 | 120.00 | 138.00 | 271.00 | ▁▇▅▁▁ |
| Keys_num | 7 | 1.00 | 1.77 | 0.42 | 1.0 | 2.00 | 2.00 | 2.00 | 2.00 | ▂▁▁▁▇ |
| Extras_num | 7 | 1.00 | 4.90 | 0.50 | 1.0 | 5.00 | 5.00 | 5.00 | 5.00 | ▁▁▁▁▇ |
| Price | 7 | 1.00 | 17720.13 | 8087.51 | 1300.0 | 12490.00 | 16390.00 | 21490.00 | 61990.00 | ▅▇▁▁▁ |
Este tipo de estadísticas nos son útiles para observar la utilidad de
las columnas, especialmente observar la presencia de NA's y
la distribución.
Al examinar los estadísticos de los cuartiles y extremos, detectamos
lo siguiente en la variable CV:
Asimetría superior: Tenemos que el valor en
p75 es 150cv y el valor en p100
es 498cv, lo cuál indica un incremento de un
232% en el último tramo. Esta gran diferencia no
significa necesariamente que tengamos un outlier erroneo,
sino que probablemente se trata de vehículos muy potentes, coches de
lujo o deportivos.
Asimetría inferior: Tenemos que el valor de
p0 es 20cv, lo cuál podría indicar que se
están incluyendo vehículos de muy baja potencia o
ciclomotores/cuadriciclos. Estos valores deberían filtrarse ya que
podrían sesgar el modelo de coches estándar.
Se decide eliminar las columnas
Trunk, Vmax, Weight, X0to100, Emissions, Consumption, Tank, One_owner
dado que, desde una perspectiva de negocio
Weight, Trunk y Width son variables correlacionadas y
mantenerlas habría distorsionado el PCA.
Vmax, Consumption, Tank y X0to100 son variables que no
suelen determinar de forma directa el precio dentro del mercado de
segunda mano, donde factores como
antiguedad, CV, KM y Brand tienen mucho más peso.
# eliminación de columnas intranscendentes
carsData <- subset(carsData, select=-c(
Trunk,
Vmax,
Weight,
X0to100,
Emissions,
Consumption,
Tank,
One_owner))
# mostramos las columnas de nuevo
head(carsData, 10)## X Brand Name Sticker Year KM Fuel CV
## 1 0 Opel Opel Corsa C 2022 47707 Diésel 102
## 2 1 Peugeot Peugeot Rifter C 2019 57194 Diésel 130
## 3 2 Renault Renault Kadjar C 2017 66428 Diésel 110
## 4 3 Dacia Dacia Sandero C 2016 48430 Gasolina 75
## 5 4 Nissan Nissan QASHQAI C 2020 72209 Gasolina 160
## 6 5 BMW BMW X2 C 2018 123979 Diésel 150
## 7 6 KIA KIA Stonic C 2018 125737 Diésel 110
## 8 7 KIA KIA Stonic C 2019 130012 Gasolina 100
## 9 8 Volkswagen Volkswagen T-Cross C 2020 27769 Gasolina 150
## 10 9 Land Rover Land Rover Range Rover Evoque ECO 2019 75212 Híbrido 200
## Transmission Location Length Width Height Keys_num Extras_num Price
## 1 MANUAL Almería 4.06 1.77 1.43 1 5 15700
## 2 AUTO Almería 4.40 1.85 1.82 2 5 24900
## 3 MANUAL Barcelona 4.45 1.84 1.61 2 5 17800
## 4 MANUAL Madrid 4.06 1.73 1.52 2 3 9300
## 5 AUTO Málaga 4.39 1.81 1.59 2 5 21500
## 6 AUTO Barcelona 4.36 1.82 1.53 2 5 20900
## 7 MANUAL Murcia 4.14 1.76 1.52 2 5 15690
## 8 MANUAL Zaragoza 4.14 1.76 1.52 2 5 13500
## 9 AUTO Madrid 4.11 1.76 1.58 1 5 23800
## 10 AUTO Barcelona 4.37 1.90 1.65 2 5 37900Para gestionar los valores nulos (NA), optamos por la eliminación de las filas que contienen algún valor nulo en las columnas restantes. Elegimos esta estrategia en lugar de la imputación para no introducir sesgos sintéticos en variables clave en la primera iteración.
Otras opciones habrían sido:
Crear una media/mediana para variables numéricas como
KM, Price, antiguedad, etc.
Moda para variables categóricas como
Fuel o Brand.
Los valores faltantes no son aleatorios sino que corresponden a anuncios incompletos e imputarlos podría introducir un sesgo sintético, como hemos dicho anteriormente. En porcentaje de NA eliminados es bajo comparado con el tamaño inicial del dataset y para PCA, la imputación simple podría distorsionar la estructura de las variables.
# omitimos los valores que tengan NA y lo guardamos el dataset
carsData <- na.omit(carsData)Una vez limpiado el dataset, podemos confirmar con
skimr que, efectivamente, ya no queda ningun dato con
NA:
# asegurarnos de que no quedan valores con NA
skim(carsData)| Name | carsData |
| Number of rows | 5960 |
| Number of columns | 16 |
| _______________________ | |
| Column type frequency: | |
| character | 6 |
| numeric | 10 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| Brand | 0 | 1 | 2 | 10 | 0 | 44 | 0 |
| Name | 0 | 1 | 5 | 29 | 0 | 267 | 0 |
| Sticker | 0 | 1 | 0 | 11 | 25 | 5 | 0 |
| Fuel | 0 | 1 | 3 | 18 | 0 | 7 | 0 |
| Transmission | 0 | 1 | 4 | 6 | 0 | 2 | 0 |
| Location | 0 | 1 | 0 | 10 | 1132 | 29 | 0 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| X | 0 | 1 | 2986.77 | 1724.30 | 0 | 1493.75 | 2986.50 | 4480.25 | 5972.00 | ▇▇▇▇▇ |
| Year | 0 | 1 | 2018.00 | 3.67 | 2000 | 2016.00 | 2019.00 | 2021.00 | 2024.00 | ▁▁▂▇▆ |
| KM | 0 | 1 | 81684.60 | 57079.56 | 5 | 46178.50 | 74871.50 | 108827.00 | 1116416.00 | ▇▁▁▁▁ |
| CV | 0 | 1 | 133.57 | 49.04 | 20 | 102.00 | 125.00 | 150.00 | 498.00 | ▆▇▁▁▁ |
| Length | 0 | 1 | 4.35 | 0.40 | 0 | 4.14 | 4.36 | 4.52 | 6.84 | ▁▁▂▇▁ |
| Width | 0 | 1 | 1.80 | 0.11 | 0 | 1.77 | 1.80 | 1.84 | 2.08 | ▁▁▁▁▇ |
| Height | 0 | 1 | 1.57 | 0.18 | 0 | 1.45 | 1.52 | 1.65 | 3.08 | ▁▁▇▁▁ |
| Keys_num | 0 | 1 | 1.77 | 0.42 | 1 | 2.00 | 2.00 | 2.00 | 2.00 | ▂▁▁▁▇ |
| Extras_num | 0 | 1 | 4.90 | 0.49 | 1 | 5.00 | 5.00 | 5.00 | 5.00 | ▁▁▁▁▇ |
| Price | 0 | 1 | 17713.18 | 8094.88 | 1300 | 12450.00 | 16390.00 | 21490.00 | 61990.00 | ▅▇▁▁▁ |
La eliminación de los NAs reduce el número total de observaciones, pero nos deja un dataset limpio y sin datos faltantes.
Por último, dado el problema detectado en el punto anterior de
posibles ciclomotores en el dataset que podrían sesgar el
modelo de coches estándar, hemos decidido seleccionar los
40cv como potencia mínima aceptable para un coche estándar
y eliminar todas esas filas que estén por debajo de los
40cv.
# eliminar los coches con menos de 40cv y guardarlos en el mismo dataset
carsData <- carsData[carsData$CV > 40, ]Al aplicar este filtro evitamos que los valores extremos de baja
potencia introduzcan ruido o arrastren la media de la variable
CV y otras variables correlacionadas (como
Price o Engine Size), lo que hubiera
modificado el comportamiento del modelo de clasificación y
regresión.
Debemos eliminar cualquier registro que represente la misma observación repetida, ya que duplica artificialmente la importancia de ciertas configuraciones de vehículos y sesgan los estadísticos de varianza.
Vamos a comprobar si tenemos datos duplicados en columnas clave
usando la librería dplyr y su comando
duplicated:
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# guardar columnas clave en una lista
columnasClave <- c("Brand", "Name", "Year", "KM", "Price","Location","CV","Transmission")
# contar duplicados en columnas clave
conteoDuplicadosClave <- carsData %>%
select(all_of(columnasClave)) %>%
duplicated() %>%
sum()
#mostramos cuantos duplicados hay en columnas clave
print(paste("Duplicados basados solo en columnas clave:", conteoDuplicadosClave))## [1] "Duplicados basados solo en columnas clave: 4797"Podemos observar que las filas/observaciones duplicadas son muy elevadas, un 80% del dataset son copias exactas o casi exactas de otros vehículos.
Para poder continuar, debemos eliminar dichas observaciones y quedarnos únicamente con aquellas que nos sirvan.
# si la cuenta es mayor que 0
if (conteoDuplicadosClave > 0) {
# mantener unicamente las que sean TRUE
carsData <- carsData %>%
distinct(across(all_of(columnasClave)), .keep_all = TRUE)
print("Redundancias eliminadas.")
# si no hay duplicados
} else {
# no se hace nada
print("No se encontró redundancia en las columnas clave.")
}## [1] "Redundancias eliminadas."Al ser un dataset creado a partir de un scraper de Python, puede haber varias razones por las que hay tanta redundancia. Una de ellas podría ser que el scraper ha cogido varias publicaciones del mismo vendedor en múltiples plataformas de venta de coches. Otra posibilidad para que haya tantas duplicaciones es que los scrapers suelen hacer barridos repetitivos y frecuentes, lo que podría haber propiciado a recoger un mismo anuncio varias veces registrándolo como anuncios distintos.
Otra opción es que la redundancia es muy alta en coches nuevos/seminuevos por lo que al ser características similares se pueden llegar a posicionar como idénticos sin ser el mismo coche.
A pesar que el dataset original ya cumplía con los mínimos de variables, debemos crear métricas que reflejen conceptos de negocio y asegurar el requisito de la variable binaria.
Lo primero que haremos es crear una métrica que refleja el valor por unidad de kilometraje, un indicador clave pasa saber el estado de conservación. Un valor alto sugiere que el vehículo ha mantenido su precio de forma excepcional, posiblemente porque se debe a una marca de lujo o está en un excelente estado de conservación.
# crear ratio de precio / km
carsData$ratioPrecioKm <- carsData$Price / carsData$KMLo siguiente que haremos es, a partir del año 2024, crear una
variable de antiguedad que capture el valor de la
deprecación:
# crear antiguedad a partir del año 2024 - año del vehiculo
carsData$antiguedad <- 2024 - carsData$YearCon la variable antiguedad podemos calcular una variable
para el objetivo secundario, un ratio en el que calculemos la
BajaDeprecación de los vehículos de marcas premium:
# marcas premium
marcasPremium <- c("Audi", "BMW", "Porsche", "Mercedes-Benz", "Land Rover", "Jaguar", "Lamborghini", "Buggatti")
# si la marca de coches está en la lista de marcas premium y tiene una antiguedad de 3 o menos marcar con 1, sino 0
carsData$BajaDeprecacion <- ifelse(
carsData$Brand %in% marcasPremium & carsData$antiguedad <= 3,
1,
0
)Las variables categoricas deben transformarse en numéricas para PCA,
utilizaremos el One-Hot Encoding para las variables de baja
y media cardinalildad.
library(caret)
# convertir variables clave a factor
carsData$Brand <- as.factor(carsData$Brand)
carsData$Fuel <- as.factor(carsData$Fuel)
carsData$Transmission <- as.factor(carsData$Transmission)
carsData$Location <- as.factor(carsData$Location)
carsData$Sticker <- as.factor(carsData$Sticker)
# seleccionar las variables categoricas a codificar
vars_categoricas <- carsData %>% select(Brand, Fuel, Transmission, Location, Sticker)
# aplicar One-Hot Encoding
dmy <- dummyVars("~ .", data = vars_categoricas, fullRank = TRUE)
encoded_vars <- data.frame(predict(dmy, newdata = vars_categoricas))
# eliminar las variables categoricas originales del dataframe principal
carsData_num <- carsData %>% select(-Brand, -Name, -Fuel, -Transmission, -Location, -Sticker)
# unir el dataframe principal con las variables codificadas
carsData_final <- bind_cols(carsData_num, encoded_vars)El resultado del proceso de One-Hot Encoding ha
resultado en una expansión de la matriz de datos en la que cada
categoría única se ha convertido en una nueva columna binaria (por
ejemplo, Brand.Audi = 0 o Brand.Seat = 1, etc.) lo cual
convierte el dataset en una matriz de datos completamente
numérica.
Identificamos todas las variables predictoras.
# la matriz carsData_final contiene las variables originales numéricas, las derivadas y las dummies codificadas.
vars_predictores_final <- carsData_final %>%
select(-Price, -BajaDeprecacion, -ratioPrecioKm, -X) %>%
names()El escalado es obligatorio antes del PCA porque las variables tienen diferentes magnitudes. Se aplica Z-Score para que la varianza de cada variable contribuya equitativamente al análisis.
El objetivo del grafico de codo es determinar el numero de componentes que retienen la mayor parte de la información del dataset.
library(ggplot2)
str(carsData_final)## 'data.frame': 1154 obs. of 94 variables:
## $ X : int 0 1 2 3 4 5 6 7 8 9 ...
## $ Year : int 2022 2019 2017 2016 2020 2018 2018 2019 2020 2019 ...
## $ KM : int 47707 57194 66428 48430 72209 123979 125737 130012 27769 75212 ...
## $ CV : int 102 130 110 75 160 150 110 100 150 200 ...
## $ Length : num 4.06 4.4 4.45 4.06 4.39 4.36 4.14 4.14 4.11 4.37 ...
## $ Width : num 1.77 1.85 1.84 1.73 1.81 1.82 1.76 1.76 1.76 1.9 ...
## $ Height : num 1.43 1.82 1.61 1.52 1.59 1.53 1.52 1.52 1.58 1.65 ...
## $ Keys_num : int 1 2 2 2 2 2 2 2 1 2 ...
## $ Extras_num : int 5 5 5 3 5 5 5 5 5 5 ...
## $ Price : int 15700 24900 17800 9300 21500 20900 15690 13500 23800 37900 ...
## $ ratioPrecioKm : num 0.329 0.435 0.268 0.192 0.298 ...
## $ antiguedad : num 2 5 7 8 4 6 6 5 4 5 ...
## $ BajaDeprecacion : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Alfa.Romeo : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Audi : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.BMW : num 0 0 0 0 0 1 0 0 0 0 ...
## $ Brand.BYD : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Chevrolet : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Citroën : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Cupra : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Dacia : num 0 0 0 1 0 0 0 0 0 0 ...
## $ Brand.DFSK : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.DS : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Fiat : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Ford : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Honda : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Hyundai : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Infiniti : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Iveco : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Jaguar : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Jeep : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.KIA : num 0 0 0 0 0 0 1 1 0 0 ...
## $ Brand.Land.Rover : num 0 0 0 0 0 0 0 0 0 1 ...
## $ Brand.Lexus : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Mazda : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Mercedes : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.MG : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Mini : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Mitsubishi : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Nissan : num 0 0 0 0 1 0 0 0 0 0 ...
## $ Brand.Opel : num 1 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Peugeot : num 0 1 0 0 0 0 0 0 0 0 ...
## $ Brand.Porsche : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Renault : num 0 0 1 0 0 0 0 0 0 0 ...
## $ Brand.RIMOR : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Seat : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Skoda : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Smart : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.SsangYong : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Subaru : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Suzuki : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Tesla : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Toyota : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Brand.Volkswagen : num 0 0 0 0 0 0 0 0 1 0 ...
## $ Brand.Volvo : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Fuel.Eléctrico : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Fuel.Gasolina : num 0 0 0 1 1 0 0 1 1 0 ...
## $ Fuel.GLP : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Fuel.GNC : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Fuel.Híbrido : num 0 0 0 0 0 0 0 0 0 1 ...
## $ Fuel.Híbrido.Enchufable: num 0 0 0 0 0 0 0 0 0 0 ...
## $ Transmission.MANUAL : num 1 0 1 1 0 0 1 1 0 0 ...
## $ Location.Albacete : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Alicante : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Almería : num 1 1 0 0 0 0 0 0 0 0 ...
## $ Location.Badajoz : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Barcelona : num 0 0 1 0 0 1 0 0 0 1 ...
## $ Location.Cáceres : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Cádiz : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Castellón : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Ciudad : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Córdoba : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Gipuzkoa : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Girona : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Granada : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Huelva : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Jaén : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.La : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Madrid : num 0 0 0 1 0 0 0 0 1 0 ...
## $ Location.Málaga : num 0 0 0 0 1 0 0 0 0 0 ...
## $ Location.Murcia : num 0 0 0 0 0 0 1 0 0 0 ...
## $ Location.Navarra : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Oviedo : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Pontevedra : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Santander : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Sevilla : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Toledo : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Valencia : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Vizcaya : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Location.Zaragoza : num 0 0 0 0 0 0 0 1 0 0 ...
## $ Sticker.0_EMISIONES : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Sticker.B : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Sticker.C : num 1 1 1 1 1 1 1 1 1 0 ...
## $ Sticker.ECO : num 0 0 0 0 0 0 0 0 0 1 ...
## - attr(*, "na.action")= 'omit' Named int [1:20] 277 417 557 717 1874 2253 2632 3091 3467 4023 ...
## ..- attr(*, "names")= chr [1:20] "277" "417" "557" "717" ...pca_result <- prcomp(carsData_final %>% select(all_of(vars_predictores_final)),
center = TRUE,
scale. = TRUE)
# calcular la varianza explicada y la varianza acumulada
variancia_explicada <- (pca_result$sdev^2) / sum(pca_result$sdev^2)
variancia_acumulada <- cumsum(variancia_explicada)
# visualizar el Scree Plot
qplot(c(1:length(variancia_explicada)), variancia_explicada) +
geom_line() +
labs(title = "Gráfico de Codo para PCA",
x = "Componente Principal",
y = "Varianza Explicada") +
theme_minimal()## Warning: `qplot()` was deprecated in ggplot2 3.4.0.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Podemos ver, en el grafico de codo, que tenemos una caida rapida y pronunciada de la varianza explicada en los primeros 5 a 10 componentes. A partir de ese punto, la curva se aplana donde cada componente explica solo una cantidad muy pequeña de la varianza. Acabaremos la aplicación del PCA en el punto 5.
En la fase de análisis exploratorio es en la que comenzamos a profundizar en los datos. Ya tenemos en dataset limpio y acondicionado para obtener insights, validar hipótesis de negocio y justificar la necesidad de la reducción de la dimensionalidad.
Vamos a validar las distribuciones para entender la población de
coches y confirmar si se requieren transformaciones. Comenzaremos por la
distribución del precio, Price.
Queremos confirmar que existe una asimetría positiva del precio ya que justifica la necesidad de una transformación logarítmica si se utiliza un modelo de regresión sensible a la distribución para acercar dichos datos a una distribución normal.
library(ggplot2)
# mostramos grafico de precio x frecuencia
ggplot(carsData_final, aes(x = Price)) +
geom_histogram(binwidth = 5000, fill = "darkblue", color = "white")+
labs(title = "Distribución del precio",
x = "Precio (€)",
y = "Frecuencia") +
theme_minimal()
Podemos observar que hay una leve asimetría a la derecha, pero es mucho más simétrica de lo que se esperaba para datos de precio de mercado.
La mayor frecuencia (pico) se encuentra en los 15/20.000€.
Probablemente, la limpieza de redundancia masiva ha eliminado muchos de
los registros de precios altos, el dataset resultante muestra
una distribución cercana a la normal lo cual reduce la necesidad de
transformar la variable Price mediante logaritmos y
simplifica la interpretación de los modelos de regresión lineal.
Ahora, queremos confirmar un fuerte desequilibrio de clases, muchos ceros y pocos unos.
# grafico de barras distribucion de la variable binaria
ggplot(carsData_final, aes(x = factor(BajaDeprecacion))) +
geom_bar(fill = "darkred") +
geom_text(stat='count', aes(label=after_stat(count)), vjust=-0.5) +
labs(title = "Distribución de Baja Depreciación (0=Alta, 1=Baja)",
x = "Baja Depreciación",
y = "Conteo de Vehículos") +
theme_minimal()
Este desequilibrio valida la elección del F1-Score como
métrica de clasificación principal ya que la precisión simple nos
engañaría en los resultados.
Ahora vamos a utilizar un HeatMap para buscar la
multicolinealidad al observar la correlación entre las variables
predictoras. La existencia de correlaciones fuertes (valores cercanos a
∓1) justifica la aplicación de PCA para reducir la
redundancia y obtener variables ortogonales.
library(dplyr)
library(corrplot)## corrplot 0.95 loaded# seleccionar las variables numericas a correlacionar
vars_num_corr <- carsData_final %>%
select(Price, KM, antiguedad, CV, ratioPrecioKm) %>%
names()
# calcular la matriz de correlacion
matriz_cor <- cor(carsData_final %>% select(all_of(vars_num_corr)))
# visualizar la matriz como un Heatmap
corrplot(matriz_cor,
method = "color",
type = "upper",
addCoef.col = "black",
srt = 45,
tl.col = "black")
Podemos observar que CV muestra la correlación junto con
Price con un (0.69), esto confirma que un motor más potente
está directamente asociado a un precio mayor (coches de lujo/potentes).
La antiguedad muestra una correlación negativa fuerte con
Price con un (-0.53) que, valida el concepto de la
deprecación, a mayor antigüedad, menor es el precio. El KM
muestra una correlación negativa moderada con Price con un
(-0.30), lo cual indica que no es tan relevante para el precio que la
potencia o la edad del vehículo.
La asociación entre KM y antiguedad muestra
una correlación positiva moderada con un (0.48) pero simplemente indica
redundancia ya que los coches antiguos suelen tener más kilómetros que
los nuevos. El resto de las correlaciones indicadas son muy bajas y es
interesante porque sugiere que la potencia es una variable relativamente
independiente que aporta información sobre el precio y no va ligada a la
edad o el uso.
Para finalizar, utilizaremos Boxplots para visualizar la
dispersión del Price según las categorías clave esto
validará si la hipótesis de negocio es correcta (por ejemplo, si las
marcas de lujo tienen una mediana de precio mayor), lo cual apoya los
criterios usados para definir BajaDeprecacion.
# seleccionar las 10 marcas mas frecuentes para un grafico mas limpio
top_marcas <- carsData %>%
count(Brand) %>%
arrange(desc(n)) %>%
head(10) %>%
pull(Brand)
# generar boxplots: precio vs marca
carsData %>%
filter(Brand %in% top_marcas) %>%
ggplot(aes(x = reorder(Brand, Price, FUN = median), y = Price, fill = Brand)) +
geom_boxplot() +
scale_y_continuous(labels = scales::comma) +
labs(title = "Dispersión del Precio por Marca (Top 10)",
x = "Marca",
y = "Precio (€)") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "none")
La línea horizontal que divide cada caja representa la mediana. Para medianas bajas tenemos Opel, Ford, Seat y Renault, todas por debajo de los 20.000€ lo cual indica que representan el segmento más economico. Para medianas altas tenemos BMW que destaca claramente y se situa alrededor de los 20.000€ de mediana con la linea superior y confirma que las marcas premium mantienen un valor superior.
Marcas como Volkswagen o BMW tienen unas cajas mucho más largas, lo cual significa que tienen un rango de precios muy amplio y sugiere una gran cantidad de modelos o una mayor variabilidad de la deprecación. En cambio, marcas como Opel o Ford tienen cajas más cortas indicando que sus precios son más consistentes y se centran en un rango más estrecho.
Tenemos unos valores extremos, que son los puntos negros que se observan, estos extremos representan vehículos con precios muy altos para dicha marca. En el caso de Renault tenemos un valor extremo que se coloca por encima de los 60.000€ lo cual puede deberse a modelos deportivos específicos.
Para concluir con este apartado, podemos extraer que las marcas son un predictor fundamental del Precio y que la dispersón y el valor residual varían significativamente entre segmentos.
Al finalizar el preprocesado y la codificación One-Hot, hemos obtenido una matriz de 94 variables. Para garantizar que los modelos sean robustos y no sufran desajustes por exceso de dimensiones aplicamos PCA.
Calcularemos cuantos componentes debemos retener para tener una varianza acumulada del 90%, asegurando que la pérdida de información sea minima mientras simplificamos el modelo.
# encontrar el numero de componentes para retener el 90%
componentes_k <- min(which(variancia_acumulada >= 0.90))
print(paste("Se necesitan", componentes_k, "componentes para explicar el 90% de la varianza."))## [1] "Se necesitan 67 componentes para explicar el 90% de la varianza."Para tomar la decisión analitica de cuantos componentes retener, se utiliza el criterio de la varianza acumulada, en la que se seleccionan los componentes suficientes para explicar el alto porcentaje de la varianza total. O bien, el criterio de Kaiser, en el que se retienen solo los componentes cuyo valor propio es superior a 1 y, precisamente, en el grafico la mayoría de componentes es inferior al 2%, por lo que es probable que muchos componentes cumplan ese criterio.
Asumiendo que el Scree Plot representa una matriz de 94 dimensiones, para explicar el 90% de la varianza se necesitarán, como se explica en la respuesta, 67 componentes para conseguir el 90% de la varianza total.
Con la aplicación del PCA, se ha completado la fase de preparación de datos aplicando CRISP-DM. Las principales conclusiones han sido:
Limpieza robusta, eliminando 4797 registros duplicados, filtrado de coches de baja potencia potencialmente ciclomotores, eliminación de registros NA, tratamiento de Outliers, eliminación de columnas sin carácter predictivo, etc.
Se han creado métricas de negocio clave como
antiguedad o BajaDeprecacion.
Se ha validado que la distribución de Price es
cercana a la normal lo que simplifica la regresión. El mapa de calor de
correlación confirma que la potencia es el factor más relevante para el
precio.
Se ha aplicado el PCA y ha logrado reducir la alta dimensionalidad de 94 variables a solo 67 variables conservando el 90% de la varianza del dataset.
Este dataset acondicionado es el que utilizaremos a continuación par alos algoritmos de segmentación no supervisada y los modelos de predicción supervisada.
Tras haber limpiado y preparado los datos en la fase anterior nuestro objetivo pasa a ser doble, primero segmentar el mercado de forma automática para entender los perfiles de vehículos existentes y el segundo construir modelos predictivos que nos permitan tasar un coche nuevo.
Para la segmentación, seleccionamos las variables numéricas clave de
Price, KM, antiguedad y
CV. Para ello usamos el algoritmo K-Means, este
agrupa los datos calculando la distancia entre dos puntos y el centro de
cada grupo. Aqui queremos hacer una comparativa para demostrar la
importancia del escalado de datos.
Compararemos el algoritmo usando datos en “bruto” contra los datos “normalizados”.
library(cluster)
library(factoextra)## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa# selección de variables y escalado
vars_cluster <- carsData_final %>% select(Price, KM, antiguedad, CV)
vars_cluster_scaled <- scale(vars_cluster)
# K-means sobre datos originales
set.seed(123)
km_orig <- kmeans(vars_cluster, centers = 3, nstart = 25)
# K-means sobre datos normalizados
km_norm <- kmeans(vars_cluster_scaled, centers = 3, nstart = 25)Hemos seleccionado las variables y el escalado y hemos sacado dos algoritmos K-Means, el “bruto” y el “normalizado”. Ahora, utilizamos el método de la silueta para encontrar el número de clústeres donde los coches están más cerca de los suyos y más lejos de los otros grupos.
# K óptimo con datos normalizados
fviz_nbclust(vars_cluster_scaled, kmeans, method = "silhouette") +
labs(title = "K óptimo según Silueta")
sil_norm <- silhouette(km_norm$cluster, dist(vars_cluster_scaled))
fviz_silhouette(sil_norm)## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## cluster size ave.sil.width
## 1 1 137 0.18
## 2 2 725 0.43
## 3 3 292 0.21
Una vez obtenidos los resultados, usamos el grafico de la Silueta donde un valor cercano a 1 indica que el coche está bien clasificado y un valor cercano a 0 está en la frontera entre ambos grupos.
Con un tamaño de 725 coches, el clúster 2 tiene la silueta más alta (0.43), este grupo representa un modelo exitoso. Cuando la silueta es cercana a 0.5 indica que los objetos están bien clasificados y aquí es donde se encuentran los vehículos con una relación precio-antigüedad-potencia más estandarizada.
Con 292 vehículos, el clúster 3 tiene una silueta de 0.21, lo cual sugiere que, aunque comparten rasgos, hay solapamiento entre grupos y podrían ser coches que están sufriendo una deprecación acelerada o vehículos con kilometrajes elevados para su edad.
Por último, con 137 vehículos tenemos el clúsuter 1 con una silueta de 0.18. En mineria de datos, suele indicar que el algoritmo sufre para agrupar estos datos porque son muy heterogeneos. Podrian encontrarse aqui coches deportivos, de lujo o electricos ya que sus características extremas pueden no encajar bien con una media.
La baja silueta del clúster 1 justifica el uso del algorimto PAM , que al seleccionar un coche real como centro, deberia mejorar la representación de ese segmento de 137 vehículos que ahora está fragmentado.
Tras los resultados de K-Means, observamos que aunque es efectivo para el segmento estándar, presenta difultades para agrupar vehículos del clúster 1.
En este apartado aplicamos el algoritmo PAM. Mientras K-Means utiliza un centroide (media aritmetica imaginaria), PAM utiliza un medoide (un registro real del dataset que representa el centro del grupo). Es mucho más robusto frente a valores extremos/outliers, como coches de gran potencia o precios elevados.
Utilizamos el mismo número de clústeres y los datos normalizados para asegurar una comparativa directa y justa con el ejercicio anterior.
library(cluster)
# PAM con k=3 sobre los datos normalizados
set.seed(123)
pam_res <- pam(vars_cluster_scaled, k = 3)
# identificacion de los medoides
print(pam_res$medoids)## Price KM antiguedad CV
## 297 -0.2535208 -0.3794199 -0.3275892 -0.3700941
## 812 0.7653299 -0.5661447 -0.5945652 0.5903750
## 955 -0.7715453 0.5928952 0.7403146 -0.3700941# medida de calidad del agrupamiento
sil_pam <- silhouette(pam_res$cluster, dist(vars_cluster_scaled))
fviz_silhouette(sil_pam)## cluster size ave.sil.width
## 1 1 456 0.45
## 2 2 348 0.06
## 3 3 350 0.10
Al analizar las métricas obtenidas con PAM, observamos que el clúster 1, tiene 456 vehículos, tiene una silueta de 0.45, lo cual indica que este grupo se mantiene como el más estable y coherente. Al usar el mdioide como centro, hemos logrado agrupar casi la mitad de la muestra en un segmento estándar definido.
Por el otro lado, los clústeres 2 y 3, con 348 y 350 vehículos
respectivamente, tienen una silueta de 0.06 y 0.1, unas puntuaciones tan
bajas que indican que hay un gran solapamiento en estos segmentos.
Sugieren que en el mercado estándar, las combinaciones de
CV, KM y Price son tan variadas
que los coches no forman grupos compactos.
Tanto en K-Means como en PAM, hemos utilizado por defecto la
distancia euclidiana. Sin embargo, en nuestro
dataset de coches, tenemos variables como KM o
Precio que presentan distribuciones con colas largas o
asimetrías.
En este ejercicio usaremos la distancia Manhattan, la cual aporta distintas cosas a la distancai euclediana:
A diferencia de la euclediana, la Manhattan no eleva las diferencias al cuadrado, por lo que no penaliza de forma tan extrema a los coches con valores muy altos en una sola variable.
En mercados de segunda mano, los factores de valor suelen sumarse de forma lineal. Manhattan mide la distancia como la suma de las diferencias absolutas de sus coordenadas, lo que puede ajustarse mejor a la realidad de como un comprador percine las diferencias entre vehículos.
Para poder cambiar la familia de distancias, utilizaremos la librería
flexclust, la cual nos permite definir tipos de centroides
basados en medianas y distancias. En concreto usaremos
kmedians con distancia L1, de esta forma creamos un modelo
más resistente a los valores extremos de precio que los modelos basados
en medias cuadráticas.
if (!require('flexclust')) install.packages('flexclust')## Loading required package: flexclustlibrary(flexclust)
# aplicamos K-means usando la familia 'kmedians'
set.seed(123)
km_manhattan <- kcca(vars_cluster_scaled, k = 3, family = kccaFamily("kmedians"))
summary(km_manhattan)## kcca object of family 'kmedians'
##
## call:
## kcca(x = vars_cluster_scaled, k = 3, family = kccaFamily("kmedians"))
##
## cluster info:
## size av_dist max_dist separation
## 1 395 2.272474 11.18468 1.268590
## 2 293 2.198153 17.05633 1.586498
## 3 466 1.440581 15.80682 1.359565
##
## convergence after 11 iterations
## sum of within cluster distances: 2212.997# comparamos la distribución
table(km_norm$cluster, clusters(km_manhattan))##
## 1 2 3
## 1 137 0 0
## 2 255 17 453
## 3 3 276 13Tras aplicar el algoritmo con la métrica
Manhattan, los estadisticos de los clústeres nos
ofrecen una visión detallada de la cohesión interna.
Con 466 vehículos, el clúster 3, es el grupo más compacto. Su distancia media es de 1.44 lo cual indica que la métrica Manhattan ha logrado agrupar de forma muy eficiente al segmento estándar. Sin embargo, su distancia máxima de 15.8 revela que incluso en este grupo bueno hay coches que se desvian mucho del centro.
El segundo grupo, con 293 vehículos, tiene una distancia media de 2.19 con una maxima de 17.05. Esto confirma que hay vehículos con características tan únicas que la distancia los tolera dentro del grupo pero están muy alejados. Lo positivo es que su separación es la más alta, con un 1.59, lo cuál significa que este grupo de coches raros está bien diferenciado de los coches normales.
El clúster 1, con 395 vehículos, representa un gripo con un tamaño considerable. Su distancai media es de 2.27, la más alta de los tres grupos, lo cuál nos indica que los coches de este clúster son los más diferentes entre si. Tiene la separación más baja y signfica que está tocandose con los limites de otros grupos.
Hasta ahora, hemos utilizado algoritmos que fuerzan cada coche a pertenecer a un grupo. Sin embargo, las distancais máximas de hasta 17.05 detectadas en el ejercicio anterior sugieren que hay vehículos que están aislados.
Aplicamos Density-Based Spatial Clustering of Applications with
Noise o (DBSCAN) para gestionar, como su nombre
indica, el ruido de los outliers y los marca como registros que
no pertenecen a ningunn grupo. Además, puede encontrar clústeres con
formas arbitrarias.
eps y minPtsPara DBSCAN, necesitamos definir dos parámetros
críticos:
minPts: El número mínimo de coches para formar un
grupo, para el cuál usaremos 5 por ser un estándar para estos
casos.
eps: El radio de vecinidad, el cuál determinaremos
visualmente con un K-dist plot.
library(dbscan)##
## Attaching package: 'dbscan'## The following object is masked from 'package:stats':
##
## as.dendrogram# determinación de epsilon
kNNdistplot(vars_cluster_scaled, k = 5)
abline(h = 0.7, col = "red", lty = 2) 
# aplicación de DBSCAN
set.seed(123)
db_res <- dbscan(vars_cluster_scaled, eps = 0.7, minPts = 5)
# visualización de resultados
print(db_res)## DBSCAN clustering for 1154 objects.
## Parameters: eps = 0.7, minPts = 5
## Using euclidean distances and borderpoints = TRUE
## The clustering contains 3 cluster(s) and 74 noise points.
##
## 0 1 2 3
## 74 1070 5 5
##
## Available fields: cluster, eps, minPts, metric, borderPointsSe han detectado 74 coches que no tienen vecinos similares en un radio de 0.7. Estos son los responsables de las distancias máximas de 17.05 que hemos visto antes. Al aislarlo como “ruido”, dejamos de formzar su inclusión en grupos donde solo generaban distorsión y bajaban la silueta.
El clúster mayoritario, con 1070 vehículos, nos revela que el mercado
de coches usados en España no está tan fragmentado como sugeria
K-Means, existe una densidad continua que abarca la gran
mayoria de los coches estándar. Por lo que K-Means estaba
dividiendo en tres partes artificiales, DBSCAN lo ve como
un cuerpo unico.
Hemos encontrado dos grupos minusculos de solo 5 coches cada uno que indican la existencia de configuraciones técnicas extremadamente especificas que son los suficientemente similares entre si como para formar una isla de densidad.
Como DBSCAN es muy sensible al valor de
eps, utilizamos OPTICS, que es una extensión
que permite visualizar la estructura de densidad sin fijar un radio
estricto, ideal para entender clústeres de diferentes densidades.
# aplicación de OPTICS
opt_res <- optics(vars_cluster_scaled, minPts = 5)
# visualización del diagrama de alcanzabilidad
plot(opt_res)
La transición de los modelos de centros a los de densidad han mostrado que el mercado español de vehículos usados no está fragmentado en grupos de un mismo tamaño, sino que tiene un nucleo masivo y denso de 1070 vehículos y una serie de casos atopicos aislados. Esta estructura sugiere que los modelos supervisados de predicción de precio funcionarán muy bien para la mayoría de los casos, pero tendran dificultades con los vehículos identificados como ruido.
Para validar la capacidad predictiva de nuestros modelos, dividimos el dataset en dos subconjuntos independientes. Un 80% para entrenamiento y un 20% para los tests.
set.seed(123)
# creamos el índice de participación basado en la variable Price
trainIndex <- createDataPartition(carsData_final$Price, p = 0.8, list = FALSE)
train_set <- carsData_final[trainIndex, ]
test_set <- carsData_final[-trainIndex, ]La elección del 80/20 se fundamenta en el volumen de datos disponible. Contar con un 80% permite que los algoritmos de árboles de decisión tengan suficientes ejemplos para aprender la variabilidad de las marcas y potencias, mientras que el 20% restante es un tamaño muestral estadísticamente sólido para evaluar el error de predicción sin caer en el sobreajuste.
Entrenamos un árbol de decisión para predecir la variable continua
Price. Elárbol busca particiones que maximicen la
homogeneidad del precio en los nodos resultantes.
library(rpart)
library(rpart.plot)
# usamos todas las variables predictoras procesadas
fit_full <- rpart(Price ~ ., data = train_set %>% select(-BajaDeprecacion, -ratioPrecioKm), method = "anova", control = rpart.control(cp = 0, minsplit = 20))
# identificamos el valor de CP
plotcp(fit_full)
best_cp <- fit_full$cptable[which.min(fit_full$cptable[,"xerror"]), "CP"]
# aplicamos la poda
fit_pruned <- prune(fit_full, cp = best_cp)
# visualización del modelo final optimizado
rpart.plot(fit_pruned, type = 2, extra = 1, under = TRUE, faclen = 0, cex = 0.8, main = "Árbol de Regresión: Predicción de Precio")
El modelo genera reglas lógicas. Para evaluar la capacidad predictiva en una variable cuantitativa, calculamos MAE (Error Medio Absoluto) y el RMSE (Error Cuadrático Medio de la Raíz).
# predicción sobre el conjunto de test
preds <- predict(fit_pruned, test_set)
# métricas de error
mae <- mean(abs(test_set$Price - preds))
rmse <- sqrt(mean((test_set$Price - preds)^2))Tras aplicar el modelo sobre el conjunto de test obtenemos las métricas de error:
print(paste("MAE:", round(mae, 2), "€"))## [1] "MAE: 2998.46 €"print(paste("RMSE:", round(rmse, 2), "€"))## [1] "RMSE: 4659.09 €"MAE: El error medio absoluto nos indica que, de media, nuestras predicciones se desvian unos 3000€ del precio real de oferta. Considerando que el rango de precios en nuestro dataset es amplio, una desviación tal como esta indica que el modelo captura correctamente la jerarquia de valor del mercado.
RMSE: Es significativamente mayor que el MAE. Cuando pasa esto, significa que el modelo comete errores grandes en unos pocos casos especificos. Los 74 coches identificados como outliers son los que disparan el RMSE ya que el árbol no tiene suficientes ejemplos para tasarlos correctamente.
Para un concesionario es un modelo perfecto para un cribado inicial. Permite automatizar el 90% del stock con un error controlado, dejando la revision manual a aquellos vahiculos donde el modelo muestra incertidumbre.
Dado que el árbol de decisión simple es sensible a los cambios en los
datos y se ve afectado por los valores extremos, aplicamos
Random Forest. Al promediar las predicciones de 200 árboles
diferentes, esperamos reducir ese RMSE de 4659€.
library(randomForest)## randomForest 4.7-1.2## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:dplyr':
##
## combine## The following object is masked from 'package:ggplot2':
##
## marginset.seed(123)
# entrenamos el bosque
rf_model <- randomForest(Price ~ .,
data = train_set %>% select(-BajaDeprecacion, -ratioPrecioKm),
ntree = 200,
importance = TRUE)
# evaluación en Test
pred_rf <- predict(rf_model, test_set)
rmse_rf <- sqrt(mean((test_set$Price - pred_rf)^2))
print(paste("RMSE Random Forest:", round(rmse_rf, 2), "€"))## [1] "RMSE Random Forest: 3411.07 €"Una de las mayores ventajas de este modelo es que nos permite ver que factores pesan más en la formación del precio, incluyendo los nuevos combustibles.
varImpPlot(rf_model, main = "Importancia de las Variables en la Tasación")
El gráfico obtenido mediante varImpPlot nos permite
jerarquizar los factores que realmente mueven el mercado. A diferencia
del árbol de decisión, el Random Forest evalúa la
importancia de forma global:
Las variables dominantes son CV,
antiguedad y Year aparecen en la parte
superior del gráfico. Esto confirma la hipotesis de deprecación
temporal. También podemos observar que la
Trasmission.MANUAL aparece en el Top 5 de importancia, lo
que indica que el tipo de caja de cambios es diferenciador de precio
crítico.
La gasolina y el hibrido son los
combustibles que más aportan a la precisión del modelo. Las etiquetas
ambientales Sticker.B y Sticker.ECO aparecen
con una importancia muy superior a muchas marcas, lo que refleja que en
2026, la capacidad de circular por zonas de bajas emisiones es un factor
de valor directo.
Mercedes y Porsche son las marcas que
más mueven la aguja del precio, situandose en la parte alta de la tabla,
lo que confirma su estatus de activos con dinámicas de precio
diferenciadas del resto de marcas generalistas como Seat u
Opel.
Para finalizar la evaluación del Random Forest,
realizamos una validación visual comparando valores reales del conjunto
de test frente a las predicciones del algoritmo.
library(ggplot2)
# dataframe con los valores reales y las predicciones del Random Forest
resultados_val <- data.frame(
Real = test_set$Price,
Predicho = predict(rf_model, test_set)
)
# generamos la grafica de comparacion
ggplot(resultados_val, aes(x = Real, y = Predicho)) +
geom_point(alpha = 0.5, color = "darkblue") + # Puntos semi-transparentes para ver densidad
geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed", size = 1) + # Línea ideal
labs(title = "Validación del modelo: Precio Real vs. Predicho",
subtitle = "La línea roja representa la predicción perfecta",
x = "Precio Real (€)",
y = "Precio Predicho (€)") +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
En la gráfica de dispersión se observa que la mayoría de los vehículos se agrupan estrechamente a lo largo de la diagonal roja, lo que confirma la alta precisión del Random Forest para el segmento de mercado estándar (entre 10.000€ y 30.000€).
Sin embargo, a medida que el precio aumenta hacia el segmento de lujo
(>35.000€), la dispersión es mayor. Esto ratifica nuestras
conclusiones previas del análisis no supervisado: la presencia de los
puntos de ruido identificados por DBSCAN y la menor
densidad de datos en modelos de alta gama dificultan una predicción
exacta en los extremos del mercado, donde factores de exclusividad pesan
más que las variables técnicas estandarizadas.
En este estudio hemos modelado con éxito la estructura de precios de mercado de vehículos de ocasión en España. Tras la aplicación de técnicas de minería de datos supervisadas y no supervisadas.
A pesar de la robustez metodológica, el modelo enfrenta limitaciones como:
Omisión de variables cualitativas: no se toman en cuenta factores como el estado de la carrocería, desgaste interior, historial de revisiones, etc. Esto introduce un riesgo de error en la tasación que los algoritmos no son capaces de comprender.
Riesgo de sobreajuste en nichos: el uso de estos modelos para tasar vehículos de lujo conlleva un riesgo de infravaloración ya que estos activos no se rigen por el mercado masivo.
Sesgo de ofertas: existe el riesgo de que el precio real de cierre sea inferior tras la negociación en la venta del vehiculo.
La investigación confirma que la potencia (CV) es el
factor con mayor peso en la formación del precio, seguido de la
antiguedad.
Hemos descubierto que el mercado no es tan caotico como parece y existe un grupo de más de 1000 vehículos estándar altamente predecible. La aplicación de Manhattan y DBSCAN ha sido clave para el entendimiento de que los modelos de centros fragmentan la realidad de forma artificial al hacer una división sesgada de clústeres.
El Random Forest se consolida como la herramienta de
producción ideal, logrando reducir el RMSE frente al
árbol de decisión simple. Esto demuestra que la interacción entre
factores como el tipo de etiqueta que tienen y la transmisión requiere
de modelos de ensamble para capturar matices que un modelo lineal o un
árbol simple ignoran.
En conclusión, el modelo es altamente fiable para automatizar el 90% de las tasaciones de un concesionario generalista, permitiendo optimizar recursos y centrar la revisión humana experta únicamente en los casos identificados como ruido o incertidumbre.
Para la realización de la PR2, se ha utilizado la IA generativa para estas categorías de apoyo:
Estrategia metodológica: consultas para la transición lógica entre algoritmos de clustering y la selección de métricas de calidad.
Soporte de programación: sintaxis de librerías como
flexclust, dbscan y
randomForest.
Ayuda en el diagnóstico de errores (MAE/RMSE).