Predecicción de los precios de vehículos usados

Introducción

\(\text{El problema}\)

Los precios de los vehículos nuevos en la industria los fija el fabricante con algunos costos adicionales incurridos por el Gobierno en forma de impuestos. Por lo tanto, los clientes que compran un automóvil nuevo pueden estar seguros de que el dinero que invierten es el ‘justo’. Pero que sucede con las personas que no se pueden permitir un auto de concesionario, y tienen que recurrir a la compra de un auto usado. Existe la necesidad de un sistema de predicción de precios de automóviles usados para determinar de manera efectiva el valor del automóvil en base a las características más importantes a la hora de evaluar un automóvil. Es importante conocer su valor de mercado real tanto al comprar como al vender.

Los datos utilizados en este proyecto se descargaron de Kaggle. Fue subido a [Kaggle] (https://www.kaggle.com/austinreese/craigslist-carstrucks-data), por Austin Reese usuario de Kaggle.com. Austin Reese extrajo estos datos de craigslist con un propósito sin fines de lucro. Contiene la mayor parte de la información relevante que Craigslist proporciona sobre las ventas de automóviles, incluidas variables como odometer, price, year, manufacturer, y otras 22 categorías.

Lectura y tratamiento de los datos

Librerías que serán usadas en éste trabajo.

library(dplyr)
library(tidyverse)
library(data.table)
library(knitr)
library(kableExtra)
library(DataExplorer)
library(FNN)
library(PCAmixdata)
library(caret)

Procedemos a la lectura de los datos:

datos_DT <- setDT(read.csv(file = "vehicles.csv", header = TRUE))

length(datos_DT$id[duplicated(datos_DT$id)])

## [1] 0

plot_missing(datos_DT, title = "Porcentaje de valores faltantes")

datos_DT <- datos_DT[,-c(2, 3, 4, 15, 19, 20, 21, 22, 23, 24, 25, 26)]

kable(head(datos_DT, 27), align = 'c' )

datos_DT <- datos_DT[-c(1:27),]

datos_DT[,id := ifelse(id == '', NA, id)]
datos_DT[,price := ifelse(price == '', NA, price)]
datos_DT[,year := ifelse(year == '', NA, year)]
datos_DT[,manufacturer := ifelse(manufacturer == '', NA, manufacturer)]
datos_DT[,model := ifelse(model == '', NA, model)]
datos_DT[,condition := ifelse(condition == '', NA, condition)]
datos_DT[,cylinders := ifelse(cylinders == '', NA, cylinders)]
datos_DT[,fuel := ifelse(fuel == '', NA, fuel)]
datos_DT[,odometer := ifelse(odometer == '', NA, odometer)]
datos_DT[,title_status := ifelse(title_status == '', NA, title_status)]
datos_DT[,transmission := ifelse(transmission == '', NA, transmission)]
datos_DT[,drive := ifelse(drive == '', NA, drive)]
datos_DT[,size := ifelse(size == '', NA, size)]
datos_DT[,type := ifelse(type == '', NA, type)]

plot_missing(datos_DT, title = "Porcentaje datos faltantes")

datos_DT <- datos_DT[,-13]

tabla <- table(as.character(datos_DT$cylinders), as.character(datos_DT$type), dnn = c("cilindraje", "Tipo"))
kable(tabla, caption = "Tabla de contingencia del número de obs. de cilindraje por tipo") 

chisq.test(x = tabla)

## 
##  Pearson's Chi-squared test
## 
## data:  tabla
## X-squared = 92327, df = 84, p-value < 2.2e-16

#verificamos la moda en la variable cylinder
datos_DT %>% count(cylinders)

##       cylinders      n
## 1: 10 cylinders   1455
## 2: 12 cylinders    209
## 3:  3 cylinders    655
## 4:  4 cylinders  77642
## 5:  5 cylinders   1712
## 6:  6 cylinders  94169
## 7:  8 cylinders  72062
## 8:        other   1298
## 9:         <NA> 177651

datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "bus", names(which.max(tabla[,1])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "convertible", names(which.max(tabla[,2])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "coupe", names(which.max(tabla[,3])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "hatchback", names(which.max(tabla[,4])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "mini-van", names(which.max(tabla[,5])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "offroad", names(which.max(tabla[,6])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "other", names(which.max(tabla[,7])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "pickup", names(which.max(tabla[,8])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "sedan", names(which.max(tabla[,9])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "SUV", names(which.max(tabla[,10])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "truck", names(which.max(tabla[,11])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "van", names(which.max(tabla[,12])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & type == "wagon", names(which.max(tabla[,13])), cylinders)]
datos_DT[, cylinders := ifelse(is.na(cylinders) & is.na(type), "6 cylinders", cylinders)]

library(mice)
md.pattern(datos_DT[, c(6, 13, 12)], rotate.names = TRUE)

##         type  drive condition       
## 173385     1      1         1      0
## 90902      1      1         0      1
## 46616      1      0         1      1
## 23119      1      0         0      2
## 18471      0      1         1      1
## 13555      0      1         0      2
## 14304      0      0         1      2
## 46501      0      0         0      3
##        92831 130540    174077 397448

nas <- which(is.na(datos_DT$condition) & is.na(datos_DT$drive) & is.na(datos_DT$type))
datos_DT <- datos_DT[-nas,]
rm(nas)

anios <- min(datos_DT$year, na.rm = TRUE):max(datos_DT$year, na.rm = TRUE) #rango de años de los vehiculos, 
datos_DT[, condition := ifelse(is.na(condition) & year >= as.numeric(quantile(anios, probs = c(0))) & year < as.numeric(quantile(anios, probs = c(1/6))), "salvage", condition)]

datos_DT[, condition := ifelse(is.na(condition) & year >= as.numeric(quantile(anios, probs = c(1/6))) & year < as.numeric(quantile(anios, probs = c(2/6))), "fair", condition)]

datos_DT[, condition := ifelse(is.na(condition) & year >= as.numeric(quantile(anios, probs = c(2/6))) & year < as.numeric(quantile(anios, probs = c(3/6))), "good", condition)]

datos_DT[, condition := ifelse(is.na(condition) & year >= as.numeric(quantile(anios, probs = c(3/6))) & year < as.numeric(quantile(anios, probs = c(4/6))), "like new", condition)]

datos_DT[, condition := ifelse(is.na(condition) & year >= as.numeric(quantile(anios, probs = c(4/6))) & year < as.numeric(quantile(anios, probs = c(5/6))), "new", condition)]

datos_DT[, condition := ifelse(is.na(condition) & year >= as.numeric(quantile(anios, probs = c(5/6))) & year < as.numeric(quantile(anios, probs = c(1))), "excellent", condition)]

datos_DT[, condition := ifelse(is.na(condition) & is.na(year), "good", condition)]

rm(anios)

md.pattern(datos_DT[, c(12, 13)], rotate.names = TRUE)

##         type drive       
## 264287     1     1      0
## 69735      1     0      1
## 32026      0     1      1
## 14304      0     0      2
##        46330 84039 130369

datos_DT <- datos_DT[-which(is.na(datos_DT$drive) & is.na(datos_DT$type)),]

table(datos_DT$drive)

## 
##    4wd    fwd    rwd 
## 131904 105517  58892

datos_DT[, drive := ifelse(is.na(drive), "4wd", drive)]

table(datos_DT$type)

## 
##         bus convertible       coupe   hatchback    mini-van     offroad 
##         517        7731       19204       16598        4825         609 
##       other      pickup       sedan         SUV       truck         van 
##       22110       43510       87056       77284       35279        8548 
##       wagon 
##       10751

op <- par(mar = c(5,5,2,1) )
barplot(sort(table(datos_DT$type)), col = rainbow(13), las = 1, horiz = TRUE, main = "Número de vehículos por tipo")

par(op) ## reset
rm(op)

datos_DT <- datos_DT[-which(is.na(datos_DT$type)),]

datos_DT[, manufacturer := ifelse(is.na(manufacturer), "ford", manufacturer)]

datos_DT[, title_status := ifelse(is.na(title_status), "clean", title_status)]

media <- mean(datos_DT$odometer[!is.na(datos_DT$odometer)])
datos_DT[, odometer := ifelse(is.na(odometer), media, odometer)]
rm(media)

datos_DT <- datos_DT[,-5]

library(modeest)
datos_DT[, fuel := ifelse(is.na(fuel), mfv(fuel), fuel)]

datos_DT[, transmission := ifelse(is.na(transmission), mfv(transmission), transmission)]

moda_year <- mfv(datos_DT$year[!is.na(datos_DT$year)])
datos_DT[, year := ifelse(is.na(year), moda_year, year)]
rm(moda_year)

moda_condition <- mfv(datos_DT$condition[!is.na(datos_DT$condition)])
datos_DT[, condition := ifelse(is.na(condition), moda_condition, condition)]

rm(moda_condition)

plot_missing(datos_DT, title = "Porcentaje de valores perdidos")

#minimo:
cat("El precio mínimo en el dataset es:", min(datos_DT$price))

## El precio mínimo en el dataset es: 0

#maximo
cat("El precio máximo en el dataset es:",max(datos_DT$price))

## El precio máximo en el dataset es: 3736928711

library(ggplot2)
ggplot(datos_DT, ) + aes(x=price, fill=condition) + geom_boxplot() + facet_wrap(~transmission) +
  labs(title = "Gráfico de cajas por transmisión y por condición")

cat("numero de obs. de precio mayor a 100k: ",length(which(datos_DT$price > 100000)))

## numero de obs. de precio mayor a 100k:  482

cat("numero de obs. de precio menor a 750: ",length(which(datos_DT$price < 750)))

## numero de obs. de precio menor a 750:  33811

datos_DT <- datos_DT[-which(datos_DT$price > 100000),]
datos_DT <- datos_DT[-which(datos_DT$price < 750),]

data.cut <- splitmix(datos_DT)
data.quanti<-as.data.frame(data.cut$X.quanti[-1])
data.quali<-as.data.frame(data.cut$X.quali)

data.out <- get.knn(data.quanti,k=5)
kable(head(data.out$nn.dist,10))

score <- rowMeans(data.out$nn.dist)
cota <- quantile(score,c(0.975))
index <- which(score>cota)
Out <- score[index]
cat("El total de datos atípicos en el dataset es:", length(Out))

## El total de datos atípicos en el dataset es: 7494

valores <- as.factor(ifelse(score>cota,"Eliminar","No eliminar"))
obs <- c(1:length(score))
pd <- data.frame(score,valores,obs) 
ggplot(pd, aes(x=obs,y=score, col=valores)) + geom_point() + labs(title = "Gráfico de las anomalías") +
  xlab("Observaciones")

rm(data.cut, data.out, cota, score, Out, pd, obs, valores)

datos_DT <- datos_DT[-index,]
rm(index)

#Como la variable año está como tipo factor la cambiamos a tipo *Date*, para una mejor manipulación de los datos:


datos_DT[,3] <- format(as.Date(as.character(datos_DT$year), format = "%Y"), format = "%Y")


cat("numero de obs. cuyo odometer es mayor a 300k millas es:",length(which(datos_DT$odometer > 300000)))

## numero de obs. cuyo odometer es mayor a 300k millas es: 244

cat("numero de obs. cuyo odometer es menor a 10 millas es:",length(which(datos_DT$odometer < 10)))

## numero de obs. cuyo odometer es menor a 10 millas es: 1902

cat("el numero de vehículos anteriores al año 1985 son: ", length(which(datos_DT$year < "1985")))

## el numero de vehículos anteriores al año 1985 son:  4967

datos_DT <- datos_DT[-which(datos_DT$odometer > 300000),]
datos_DT <- datos_DT[-which(datos_DT$odometer < 10),]
datos_DT <- datos_DT[-which(datos_DT$year < "1985"),]
datos_DT <- as.data.table(datos_DT)
rm(data.quali, data.quanti)

Análisis de datos exploratorios (EDA)

Gráfico de barras de la condición de los vehículos.

ggplot(datos_DT, aes(x = condition, fill = condition)) + geom_bar() + geom_text(aes(label = scales::percent(((..count..)/sum(..count..))), y= ((..count..)/sum(..count..))), stat= "count", vjust = -.5) +
  labs(title = "Gráfico de barras de la condición de los vehículos") + ylab("Número de vehículos")

Podemos observar que la mayoría de vehículos se encuentra en una excelente condición con un 55.63%, seguido de vehículos en buena condición con un 36.96%.

Gráfico de barras de la condición de los vehículos por tipo,

ggplot(datos_DT) + geom_bar( aes(x = condition, fill = condition)) + facet_wrap(~type, scales = 'free') +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank()) +#esto es para quitar el etiquetado en el eje x porque queda feo
  labs(title = "Condición de los vehículos por tipo", ylab = "Numero de vehículos")

Notemos que inclusive por tipo de vehículos, se sigue la misma tendencia en la condición de los mismos.

Graficamos el numero de vehículos por condición dentro de un rango de años especificado (2000:2020), y por tipo de conducción ‘drive’:

datos_DT %>% filter(year %in% c(2000:2020)) %>% 
  ggplot() +
  aes(x = condition, fill = condition, y = ((..count..)/1)) +
  geom_bar() +
  facet_wrap(~drive) +
  geom_text(aes( label = paste0(round(((..count..)/sum(..count..))*100,1),"%"), y =                                         ((..count..)/sum(..count..))), stat= "count", vjust = 1.5, size = 2.5) +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank()) +#esto es para quitar el etiquetado en el eje x porque queda feo
  labs(x = "Condition", y = "Numero de vehículos", fill = "Condition", title = "Condición de los vehículos por tipo de conducción")

al evaluar un automóvil, es importante comprender qué afecta su condición. La figura anterior muestra que los coches con tracción 4x4 son más duraderos y fiables. Se puede ver que los autos 4x4 son los más populares en términos de números. A largo plazo, pueden mantener su capacidad de funcionar mejor en comparación con el tren de transmisión rwd y fwd . 4wd tiene los números más altos de autos en ‘excelente’, ‘como nuevo’ y ‘buen’ estado. Por otro lado, debemos tener en cuenta que, en comparación con el número total, es difícil decir que los autos 4x4 tienen una tasa más alta de autos “excelentes” y “como nuevos”.

Histograma de los precios de los vehículos con detalle de la condición:

ggplot(data = datos_DT) + aes(x = price, fill = condition) + geom_histogram(bins = 50, color = 'black') + 
  theme_minimal() + labs(title = "Histograma del precio de vehículos detalle de la condición", y = "Número de observaciones")

Notemos que los precios están acumulados entre los 5000 y 20000 dólares.

Densidad de los precios de los vehículos por condición:

ggplot(data = datos_DT) + 
  aes(x = price, fill = condition) + 
  geom_density(position = 'stack') + 
  facet_grid(condition~., scales = 'free') + 
  theme(legend.position="none") + 
  labs(title = "Densidad de la variable precio por condición")

Se puede observar que para las condiciones ‘fair’ y ‘salvage’ los precios son muy bajos y con poca variabilidad, lo cual hace mucho sentido. Por otro lado para la condición ‘good’ se tiene una gran variabilidad en los precios.

En el gráfico de violín se representa, en el eje vertical, la distribución de los datos como si se tratara de un gráfico de densidad, y se traza la imagen especular en el eje a fin de obtener el resultado en forma de ‘violín’ como se observa en la gráfica. Si sobre este gráfico superponemos el boxplot:

ggplot(data = datos_DT) + aes(x = condition, y = price) + 
  geom_jitter(size = 1, color = 'gray', alpha = 0.5) +
  geom_violin(aes(fill = condition), color = 'black', alpha = 0.8) +
  geom_boxplot(color = 'black', alpha = 0.7) +
  labs(title = "Gráfico de violín por condición")

Podemos entender mejor la relación entre la distribución de los datos y el gráfico de cajas asociados a estos.

Gráfico de dispersión entre las variables odometro y precio:

ggplot(datos_DT, aes(x=odometer, y=price)) + 
  geom_point() + 
  geom_density2d() + 
  labs(title = "Gráfico de dispersión entre odometer y price") 

Podemos notar que a medida que el aumenta el odometro (kilometraje), el precio disminuye.

Gráfico de distribución de los fabricantes, solo de los principales fabricantes:

tabla1 <- sort(table(datos_DT$manufacturer), decreasing = TRUE)
DF <- data.frame(tabla1)
ggplot(DF[1:20,], ) + aes(x = Var1, y = Freq) + 
  geom_bar(stat ="identity", width = 0.5, fill = rainbow(20), colour = "black") +
  theme(axis.text.x = element_text(angle = 60, margin = margin(b = -0.5, unit = "cm"), vjust = 0.7)) +
  labs(title = "Distribución de vehículos por fabricantes", x = "Fabricante", y = "Frecuencia")

El fabricante de un automóvil es otra variable importante en el mercado de automóviles usados. Ford y Chevrolet son los fabricantes dominantes en Norteamérica. Toyota, Honda y Nissan siguen el orden como grandes fabricantes. Se puede concluir que los automóviles japoneses tienen una participación considerable en el mercado de automóviles usados.

Promedios de precios por tipo de vehículos:

kable(datos_DT %>% group_by(type) %>% summarise(promedio = round(mean(price), 2)) %>% arrange(desc(promedio)), caption = "Tabla promedios de precios por tipo de coche")

Modelamiento

Para trabajar con modelos es mejor hacerlo con la estructura data.frame por tanto procedemos a transformar el dataset:

datos_DF <- as.data.frame(datos_DT)
rm(datos_DT)

Procedemos a transformar las variable de tipo character a tipo factor para tener una mayor eficiencia:

## 'data.frame':    285424 obs. of  12 variables:
##  $ id          : num  7.32e+09 7.32e+09 7.32e+09 7.32e+09 7.32e+09 ...
##  $ price       : num  33590 22590 39590 30990 15000 ...
##  $ year        : Factor w/ 38 levels "1985","1986",..: 30 26 36 33 29 28 32 35 32 27 ...
##  $ manufacturer: Factor w/ 40 levels "acura","alfa-romeo",..: 14 8 8 38 13 14 8 38 8 8 ...
##  $ condition   : Factor w/ 6 levels "excellent","fair",..: 3 3 3 3 1 3 3 1 3 3 ...
##  $ cylinders   : Factor w/ 8 levels "10 cylinders",..: 7 7 7 7 6 7 6 6 6 7 ...
##  $ fuel        : Factor w/ 5 levels "diesel","electric",..: 3 3 3 3 3 3 3 3 3 3 ...
##  $ odometer    : num  57923 71229 19160 41124 128000 ...
##  $ title_status: Factor w/ 6 levels "clean","lien",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ transmission: Factor w/ 3 levels "automatic","manual",..: 3 3 3 3 1 3 3 1 3 3 ...
##  $ drive       : Factor w/ 3 levels "4wd","fwd","rwd": 1 1 1 1 3 1 1 1 1 3 ...
##  $ type        : Factor w/ 13 levels "bus","convertible",..: 8 8 8 8 11 8 8 11 8 7 ...

antes de realizar el modelo es importante particionar la data en un conjunto de entrenamiento y otro de test:

set.seed(111)
particion = createDataPartition(y=datos_DF$price,p=0.7, list = F, times = 1)

#Verificamos los tamaños del TRAIN y el TEST
train = datos_DF[particion,]
cat("número de observaciones en el conjunto de entrenamiento: ", dim(train)[1])

## número de observaciones en el conjunto de entrenamiento:  199798

test = datos_DF[-particion,]
cat("número de observaciones en el conjunto de test: ", dim(test)[1])

## número de observaciones en el conjunto de test:  85626

model <- lm(price~., data = train[,-1])
summary(model)

## 
## Call:
## lm(formula = price ~ ., data = train[, -1])
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -90948  -3871   -508   3106  69837 
## 
## Coefficients:
##                               Estimate Std. Error  t value Pr(>|t|)    
## (Intercept)                  2.749e+04  7.174e+02   38.328  < 2e-16 ***
## year1986                    -2.208e+02  7.079e+02   -0.312 0.755059    
## year1987                     3.866e+03  7.007e+02    5.517 3.45e-08 ***
## year1988                     6.057e+00  6.926e+02    0.009 0.993022    
## year1989                    -1.100e+02  6.781e+02   -0.162 0.871154    
## year1990                    -2.470e+01  6.710e+02   -0.037 0.970633    
## year1991                     1.714e+03  6.632e+02    2.584 0.009766 ** 
## year1992                     2.699e+03  6.534e+02    4.130 3.63e-05 ***
## year1993                     1.345e+03  6.456e+02    2.083 0.037220 *  
## year1994                     1.010e+02  6.162e+02    0.164 0.869796    
## year1995                     1.267e+03  5.898e+02    2.148 0.031721 *  
## year1996                     9.127e+02  5.846e+02    1.561 0.118457    
## year1997                     1.678e+03  5.670e+02    2.960 0.003079 ** 
## year1998                     2.102e+03  5.578e+02    3.768 0.000165 ***
## year1999                     1.120e+03  5.376e+02    2.083 0.037261 *  
## year2000                     2.009e+03  5.353e+02    3.753 0.000175 ***
## year2001                     2.499e+03  5.269e+02    4.743 2.11e-06 ***
## year2002                     2.940e+03  5.225e+02    5.627 1.83e-08 ***
## year2003                     3.538e+03  5.176e+02    6.835 8.25e-12 ***
## year2004                     3.423e+03  5.147e+02    6.650 2.95e-11 ***
## year2005                     4.389e+03  5.128e+02    8.560  < 2e-16 ***
## year2006                     4.608e+03  5.114e+02    9.010  < 2e-16 ***
## year2007                     5.726e+03  5.102e+02   11.223  < 2e-16 ***
## year2008                     6.015e+03  5.093e+02   11.810  < 2e-16 ***
## year2009                     7.018e+03  5.115e+02   13.721  < 2e-16 ***
## year2010                     8.051e+03  5.096e+02   15.798  < 2e-16 ***
## year2011                     9.186e+03  5.084e+02   18.069  < 2e-16 ***
## year2012                     1.011e+04  5.075e+02   19.920  < 2e-16 ***
## year2013                     1.139e+04  5.066e+02   22.490  < 2e-16 ***
## year2014                     1.313e+04  5.069e+02   25.905  < 2e-16 ***
## year2015                     1.551e+04  5.069e+02   30.601  < 2e-16 ***
## year2016                     1.675e+04  5.070e+02   33.034  < 2e-16 ***
## year2017                     1.892e+04  5.068e+02   37.324  < 2e-16 ***
## year2018                     2.118e+04  5.071e+02   41.764  < 2e-16 ***
## year2019                     2.287e+04  5.085e+02   44.971  < 2e-16 ***
## year2020                     2.592e+04  5.098e+02   50.842  < 2e-16 ***
## year2021                     2.910e+04  5.885e+02   49.443  < 2e-16 ***
## year2022                     6.041e+03  3.120e+03    1.936 0.052845 .  
## manufactureralfa-romeo       2.109e+03  3.178e+02    6.635 3.26e-11 ***
## manufactureraston-martin     1.472e+03  2.355e+03    0.625 0.531893    
## manufactureraudi             2.487e+03  1.595e+02   15.597  < 2e-16 ***
## manufacturerbmw              1.515e+02  1.441e+02    1.051 0.293402    
## manufacturerbuick           -3.322e+03  1.771e+02  -18.764  < 2e-16 ***
## manufacturercadillac         7.242e+02  1.680e+02    4.311 1.63e-05 ***
## manufacturerchevrolet       -1.691e+03  1.292e+02  -13.091  < 2e-16 ***
## manufacturerchrysler        -3.940e+03  1.776e+02  -22.179  < 2e-16 ***
## manufacturerdodge           -3.147e+03  1.505e+02  -20.910  < 2e-16 ***
## manufacturerferrari          5.577e+04  1.629e+03   34.236  < 2e-16 ***
## manufacturerfiat            -7.861e+03  3.546e+02  -22.167  < 2e-16 ***
## manufacturerford            -2.124e+03  1.267e+02  -16.770  < 2e-16 ***
## manufacturergmc             -4.051e+02  1.458e+02   -2.778 0.005468 ** 
## manufacturerharley-davidson -8.766e+03  8.981e+02   -9.760  < 2e-16 ***
## manufacturerhonda           -1.016e+03  1.377e+02   -7.380 1.58e-13 ***
## manufacturerhyundai         -4.900e+03  1.538e+02  -31.871  < 2e-16 ***
## manufacturerinfiniti        -8.723e+02  1.778e+02   -4.907 9.27e-07 ***
## manufacturerjaguar           1.065e+03  2.383e+02    4.468 7.89e-06 ***
## manufacturerjeep            -5.375e+02  1.407e+02   -3.821 0.000133 ***
## manufacturerkia             -5.847e+03  1.624e+02  -36.014  < 2e-16 ***
## manufacturerland rover      -4.296e+03  3.080e+03   -1.395 0.163108    
## manufacturerlexus            3.461e+03  1.577e+02   21.943  < 2e-16 ***
## manufacturerlincoln         -5.481e+01  1.882e+02   -0.291 0.770903    
## manufacturermazda           -3.634e+03  1.769e+02  -20.537  < 2e-16 ***
## manufacturermercedes-benz    1.750e+03  1.522e+02   11.496  < 2e-16 ***
## manufacturermercury         -3.493e+03  3.378e+02  -10.341  < 2e-16 ***
## manufacturermini            -2.250e+03  2.277e+02   -9.880  < 2e-16 ***
## manufacturermitsubishi      -7.264e+03  2.062e+02  -35.231  < 2e-16 ***
## manufacturernissan          -4.432e+03  1.396e+02  -31.746  < 2e-16 ***
## manufacturerpontiac         -6.573e+02  2.682e+02   -2.451 0.014234 *  
## manufacturerporsche          9.675e+03  3.081e+02   31.403  < 2e-16 ***
## manufacturerram             -1.526e+03  1.487e+02  -10.261  < 2e-16 ***
## manufacturerrover            3.927e+03  2.443e+02   16.074  < 2e-16 ***
## manufacturersaturn          -1.600e+03  3.337e+02   -4.796 1.62e-06 ***
## manufacturersubaru          -2.287e+03  1.609e+02  -14.214  < 2e-16 ***
## manufacturertesla            1.511e+04  3.980e+02   37.959  < 2e-16 ***
## manufacturertoyota           6.390e+02  1.314e+02    4.864 1.15e-06 ***
## manufacturervolkswagen      -4.080e+03  1.575e+02  -25.903  < 2e-16 ***
## manufacturervolvo            9.449e+02  2.067e+02    4.571 4.87e-06 ***
## conditionfair               -2.775e+03  1.385e+02  -20.040  < 2e-16 ***
## conditiongood               -8.253e+02  4.240e+01  -19.465  < 2e-16 ***
## conditionlike new           -8.092e+02  7.245e+01  -11.169  < 2e-16 ***
## conditionnew                 1.450e+03  1.746e+02    8.304  < 2e-16 ***
## conditionsalvage            -2.085e+03  4.688e+02   -4.448 8.69e-06 ***
## cylinders12 cylinders        6.914e+03  8.350e+02    8.280  < 2e-16 ***
## cylinders3 cylinders        -1.341e+04  4.774e+02  -28.079  < 2e-16 ***
## cylinders4 cylinders        -9.681e+03  3.005e+02  -32.218  < 2e-16 ***
## cylinders5 cylinders        -7.957e+03  3.767e+02  -21.120  < 2e-16 ***
## cylinders6 cylinders        -5.984e+03  2.978e+02  -20.097  < 2e-16 ***
## cylinders8 cylinders        -2.094e+03  2.968e+02   -7.056 1.72e-12 ***
## cylindersother              -7.263e+03  4.328e+02  -16.783  < 2e-16 ***
## fuelelectric                -1.427e+04  2.888e+02  -49.413  < 2e-16 ***
## fuelgas                     -1.277e+04  7.768e+01 -164.454  < 2e-16 ***
## fuelhybrid                  -1.277e+04  1.584e+02  -80.640  < 2e-16 ***
## fuelother                   -1.067e+04  9.537e+01 -111.827  < 2e-16 ***
## odometer                    -5.977e-02  4.179e-04 -143.024  < 2e-16 ***
## title_statuslien            -1.094e+03  2.600e+02   -4.207 2.59e-05 ***
## title_statusmissing         -3.683e+03  6.810e+02   -5.408 6.37e-08 ***
## title_statusparts only      -5.113e+03  1.269e+03   -4.030 5.57e-05 ***
## title_statusrebuilt         -4.641e+03  1.180e+02  -39.319  < 2e-16 ***
## title_statussalvage         -4.940e+03  1.734e+02  -28.494  < 2e-16 ***
## transmissionmanual           2.280e+03  7.819e+01   29.155  < 2e-16 ***
## transmissionother           -4.510e+02  5.733e+01   -7.867 3.66e-15 ***
## drivefwd                    -2.937e+03  4.487e+01  -65.455  < 2e-16 ***
## driverwd                    -3.544e+02  5.141e+01   -6.895 5.41e-12 ***
## typeconvertible              6.620e+03  4.411e+02   15.007  < 2e-16 ***
## typecoupe                    5.554e+03  4.330e+02   12.827  < 2e-16 ***
## typehatchback                2.954e+03  4.360e+02    6.774 1.26e-11 ***
## typemini-van                 4.140e+03  4.485e+02    9.231  < 2e-16 ***
## typeoffroad                  8.440e+03  5.755e+02   14.666  < 2e-16 ***
## typeother                    6.711e+03  4.331e+02   15.497  < 2e-16 ***
## typepickup                   7.707e+03  4.297e+02   17.936  < 2e-16 ***
## typesedan                    3.449e+03  4.308e+02    8.005 1.20e-15 ***
## typeSUV                      4.417e+03  4.301e+02   10.269  < 2e-16 ***
## typetruck                    9.142e+03  4.292e+02   21.298  < 2e-16 ***
## typevan                      4.949e+03  4.382e+02   11.294  < 2e-16 ***
## typewagon                    4.850e+03  4.387e+02   11.056  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6878 on 199683 degrees of freedom
## Multiple R-squared:  0.7464, Adjusted R-squared:  0.7463 
## F-statistic:  5157 on 114 and 199683 DF,  p-value: < 2.2e-16

probs <- predict(model, newdata = test[,-1])

Notemos que se alcanza un R-cuadrado del 74.63% y un valor de RMSE de:

rmse <- sqrt(sum((test$price-probs)^2)/length(probs))
rmse

## [1] 6876.217

cuyo valor se entiende que sea bastante elevado dado que se tratan de 85626 observaciones. Sin embargo, si se revisa los p valores de cada una de las variables y sus distintos niveles se podría mejorar éste modelo si se omiten dichas variables o sus niveles no significativos, es decir, aquellas variables con un p-valor mayor al 5%.

serie1 <- data.frame("price" = test$price[1:100], "type" = rep("original", 100))
serie2 <- data.frame("price" = probs[1:100], "type" = rep("predict", 100))
serie1 <- rbind(serie1, serie2)
serie3 <- data.frame("price" = test$price[85527:85626], "type" = rep("original", 100))
serie4 <- data.frame("price" = probs[85527:85626], "type" = rep("predict", 100))
serie2 <- rbind(serie3, serie4)

ggplot(data = serie1,
       mapping = aes(x = rep(1:100,2),
                     y = price,
                     color = type)) +
  geom_line() +
  labs(title = "Comparación de las primeras 100 observaciones", x = "Observaciones", y = "Precio")

ggplot(data = serie2,
       mapping = aes(x = rep(1:100,2),
                     y = price,
                     color = type)) +
  geom_line() +
  labs(title = "Comparación de las últimas 100 observaciones", x = "Observaciones", y = "Precio")

#primeras 1000 obervaciones:

qplot(x=test$price[1:1000], y=probs[1:1000], geom=c("point","smooth"), method="lm", 
      main="Real Vs Prediccion de 1000 observaciones", ylab = "Predicción", xlab = "Real")

rm(serie1, serie2, serie3, serie4)