Series “Completando info en una lista de autos usados”

Parte 1: https://rpubs.com/ayalajoseluis/compdatos Parte 2: Esta

Librerías y cargamos el mismo dataframe.

library(tidyverse)
library(randomForest)
library(inTrees)
library(plotly)
library(knitr)

datosautos <- read.csv(file = "datosml.csv", stringsAsFactors = FALSE)

Para que el árbol funcione bien tenemos que limpiar y factorizar lo mejor posible todo el dataframe.

datosautosfac <- datosautos %>% mutate(
  combustible = case_when(
    FUEL_TYPE == "Diésel" ~ "Diesel",
    TRUE ~ "Nafta y/o GNC"),
  anio = as.character(VEHICLE_YEAR),
  puertas = as.character(DOORS)
  ) %>% filter(is.na(cilindrada)==FALSE) %>%
  select(puertas, combustible, MODEL, anio, cilindrada) %>% 
  mutate_if(is.character, as.factor) %>%
  mutate_if(is.numeric, as.factor)

¿Qué es un árbol? En principio lo mismo que OneR pero con la diferencia que podemos elegir múltiples niveles de profundidad y múltiples variables. En teoría un árbol de un nivel y una variable debería dar lo mismo que el de OneR… como máximo. El algoritmo de random forest es como su nombre lo indica aleatorio y va “buscando” el mejor valor. Entonces a falta de algo más divertido por hacer lo corremos 100 veces y vemos los resultados.

resultados <- list()
for(i in 1:100){
  modelo <- randomForest(cilindrada ~ ., data = datosautosfac, ntree = 1, mtry = 1, importance = TRUE)
  prediccion <- predict(modelo, datosautosfac, type = "class")
  precision <- mean(prediccion == datosautosfac$cilindrada)
  resultados[i] <- precision
}
max(unlist(resultados))
## [1] 0.8070274
mean(unlist(resultados))
## [1] 0.6159477
min(unlist(resultados))
## [1] 0.4346876

Podemos jugar con estas variables. Sabemos que tenemos 4 características para elegir (modelo, combustible, número de puertas y año del vehículo) y que no queremos extender mucho más el árbol tampoco. Entonces armamos una matriz con la precisión de los árboles para de 1 a 4 variables y de 1 a 8 niveles de profundidad. También vamos a extraer la lista de reglas para ver cuántas reglas se generan con cada combinación.

a <- data.frame()
b <- data.frame()

for(i in 1:8){
  for(n in 1:4){
    modelo <- randomForest(cilindrada ~ ., data = datosautosfac, ntree = i, mtry = n, importance = TRUE, verbose = FALSE)
    listaarboles <- RF2List(modelo)
    listareglas <- extractRules(listaarboles, datosautosfac)
    listareglas <- unique(listareglas)
    prediccion <- predict(modelo, datosautosfac, type = "class")
    precision <- mean(prediccion == datosautosfac$cilindrada)
    numreglas <- length(listareglas)
    a[i,n] <- precision
    b[i,n] <- numreglas
  }
}
## 20 rules (length<=6) were extracted from the first 1 trees.
## 55 rules (length<=6) were extracted from the first 1 trees.
## 57 rules (length<=6) were extracted from the first 1 trees.
## 54 rules (length<=6) were extracted from the first 1 trees.
## 47 rules (length<=6) were extracted from the first 2 trees.
## 98 rules (length<=6) were extracted from the first 2 trees.
## 101 rules (length<=6) were extracted from the first 2 trees.
## 96 rules (length<=6) were extracted from the first 2 trees.
## 74 rules (length<=6) were extracted from the first 3 trees.
## 156 rules (length<=6) were extracted from the first 3 trees.
## 160 rules (length<=6) were extracted from the first 3 trees.
## 140 rules (length<=6) were extracted from the first 3 trees.
## 151 rules (length<=6) were extracted from the first 4 trees.
## 205 rules (length<=6) were extracted from the first 4 trees.
## 201 rules (length<=6) were extracted from the first 4 trees.
## 188 rules (length<=6) were extracted from the first 4 trees.
## 139 rules (length<=6) were extracted from the first 5 trees.
## 237 rules (length<=6) were extracted from the first 5 trees.
## 279 rules (length<=6) were extracted from the first 5 trees.
## 249 rules (length<=6) were extracted from the first 5 trees.
## 168 rules (length<=6) were extracted from the first 6 trees.
## 295 rules (length<=6) were extracted from the first 6 trees.
## 309 rules (length<=6) were extracted from the first 6 trees.
## 303 rules (length<=6) were extracted from the first 6 trees.
## 188 rules (length<=6) were extracted from the first 7 trees.
## 322 rules (length<=6) were extracted from the first 7 trees.
## 368 rules (length<=6) were extracted from the first 7 trees.
## 351 rules (length<=6) were extracted from the first 7 trees.
## 229 rules (length<=6) were extracted from the first 8 trees.
## 392 rules (length<=6) were extracted from the first 8 trees.
## 418 rules (length<=6) were extracted from the first 8 trees.
## 408 rules (length<=6) were extracted from the first 8 trees.

Acá podría presentar una tabla pero mejor usemos plotly para un muy lindo surface plot. Uno para los aciertos y otro para la cantidad de reglas.

matrprec <- as.matrix(a)
p <- plot_ly(z = matrprec, x = list(1,2,3,4), y = list(1,2,3,4,5,6,7,8), showscale = FALSE, type = "surface")
p <- p %>% layout(
    title = "Precisión según variables y profundidad",
    scene = list(
      camera = list(eye = list(x = -1.25, y = -1.25, z = 1.25)),
      xaxis = list(title = "Variables", tickformat = "d"),
      yaxis = list(title = "Profundidad", tickformat = "d"),
      zaxis = list(title = "Precisión", tickformat = "%")
    ))
p
matreglas <- as.matrix(b)
p <- plot_ly(z = matreglas, x = list(1,2,3,4), y = list(1,2,3,4,5,6,7,8), showscale = FALSE, type = "surface")
p <- p %>% layout(
    title = "Número de reglas según variables y árboles",
    scene = list(
      camera = list(eye = list(x = -1.25, y = -1.25, z = 1.25)),
      xaxis = list(title = "Variables", tickformat = "d"),
      yaxis = list(title = "Profundidad", tickformat = "d"),
      zaxis = list(title = "Número de reglas creadas")
    ))
p

Podemos pasar por ambos gráficos y ver que para el valor de 2 variables con 2 niveles de profundidad estamos en un 85% de precisión con 102 reglas (esto puede variar ligeramente cada vez que se genere la matriz) y para el de 3 variables/3 niveles en un 90% con 148 reglas. ¿Valen esas 50 reglas extra un 5% adicional? Ahí ya es la decisión del analista de datos para lo que requiera la aplicación.

Volvemos a los datos de autos. No lo tuve en cuenta antes por que las características de OneR lo permiten pero hay que hablar de dividir los datos en sets de training y de validación. Con esto podemos ir testeando sobre algo conocido y evitamos lo que se llama “overfitting” es decir que me genere muchas reglas específicas cuando lo que quiero son reglas más generales.

¿Cómo se pueden organizar estos sets y cómo afecta a lo que estamos haciendo? El dataset original (datosautos) tiene una columna X que indica la fila correspondiente. Dado que la lista es secuencial podemos aproximar una división utilizando el último dígito del número de fila. Según la mayoría de los ejercicios es bueno que la proporción entre ambos sets sea 70/30 (70% training 30% validación). Vamos a probar proporciones desde 20/80 a 80/20 tanto con 2:2(variables/profundidad) como con 3:3.

Para no dar tantas vueltas dentro del for antes preparamos otro data frame con lo que necesitamos más el valor de la fila. Terminamos con dos data frames: datosautosfacna (dataframe factorizado que vamos a rellenar más tarde) y el datosautosfac (dataframe factorizado que vamos a usar más abajo)

datosautoscomp <- datosautos %>% mutate(
  combustible = case_when(
    FUEL_TYPE == "Diésel" ~ "Diesel",
    TRUE ~ "Nafta y/o GNC"),
  anio = as.character(VEHICLE_YEAR),
  puertas = as.character(DOORS),
  cilindrada = round(cilindrada,1)
  )

datosautosfacna <- datosautoscomp %>% select(puertas, combustible, MODEL, anio, cilindrada) %>% filter (is.na(cilindrada) == TRUE)%>% mutate_if(is.character, as.factor) %>% select(-c(cilindrada))
datosautosfac <- datosautoscomp %>% select(X, puertas, combustible, MODEL, anio, cilindrada) %>% filter (is.na(cilindrada) == FALSE)%>% mutate_if(is.character, as.factor)

Veamos primero el de 2:2

a <- data.frame()
for(i in 2:8){
  datosautostrain <- datosautosfac %>% filter(((X%%10) %in% (seq_along(1:i)))==TRUE) %>% select(-c(X)) %>% mutate_if(is.numeric, as.factor)
  datosautosvalid <- datosautosfac %>% filter(((X%%10) %in% (seq_along(1:i)))==FALSE) %>% select(-c(X))%>% mutate_if(is.numeric, as.factor)
  modelo <- randomForest(cilindrada ~ ., data = datosautostrain, ntree = 2, mtry = 2, importance = TRUE)
  predtrain <- predict(modelo, datosautostrain, type = "class")
  predvalid <- predict(modelo, datosautosvalid, type = "class")
  listaarboles <- RF2List(modelo)
  listareglas <- extractRules(listaarboles, datosautostrain)
  listareglas <- unique(listareglas)
  prectrain <- mean(predtrain == datosautostrain$cilindrada)
  precvalid <- mean(predvalid == datosautosvalid$cilindrada)
  numreglas <- length(listareglas)
  a[i,1] <- i*10
  a[i,2] <- numreglas
  a[i,3] <- round(prectrain*100,1)
  a[i,4] <- round(precvalid*100,1)
}
## 85 rules (length<=6) were extracted from the first 2 trees.
## 92 rules (length<=6) were extracted from the first 2 trees.
## 98 rules (length<=6) were extracted from the first 2 trees.
## 89 rules (length<=6) were extracted from the first 2 trees.
## 103 rules (length<=6) were extracted from the first 2 trees.
## 92 rules (length<=6) were extracted from the first 2 trees.
## 95 rules (length<=6) were extracted from the first 2 trees.
colnames(a) <- c("Proporción Train - Total (%)", "Reglas", "Aciertos Train (%)", "Aciertos Valid (%)")
kable(a %>% drop_na())
Proporción Train - Total (%) Reglas Aciertos Train (%) Aciertos Valid (%)
2 20 85 84.4 82.1
3 30 92 85.2 84.0
4 40 98 84.2 83.1
5 50 89 82.6 82.3
6 60 103 87.4 86.8
7 70 92 85.2 85.3
8 80 95 87.3 87.1

Y ahora el de 3:3

a <- data.frame()

for(i in 2:8){
  datosautostrain <- datosautosfac %>% filter(((X%%10) %in% (seq_along(1:i)))==TRUE) %>% select(-c(X)) %>% mutate_if(is.numeric, as.factor)
  datosautosvalid <- datosautosfac %>% filter(((X%%10) %in% (seq_along(1:i)))==FALSE) %>% select(-c(X))%>% mutate_if(is.numeric, as.factor)
  modelo <- randomForest(cilindrada ~ ., data = datosautostrain, ntree = 3, mtry = 3, importance = TRUE)
  predtrain <- predict(modelo, datosautostrain, type = "class")
  predvalid <- predict(modelo, datosautosvalid, type = "class")
  listaarboles <- RF2List(modelo)
  listareglas <- extractRules(listaarboles, datosautostrain)
  listareglas <- unique(listareglas)
  prectrain <- mean(predtrain == datosautostrain$cilindrada)
  precvalid <- mean(predvalid == datosautosvalid$cilindrada)
  numreglas <- length(listareglas)
  a[i,1] <- i*10
  a[i,2] <- numreglas
  a[i,3] <- round(prectrain*100,1)
  a[i,4] <- round(precvalid*100,1)
}
## 143 rules (length<=6) were extracted from the first 3 trees.
## 152 rules (length<=6) were extracted from the first 3 trees.
## 139 rules (length<=6) were extracted from the first 3 trees.
## 157 rules (length<=6) were extracted from the first 3 trees.
## 140 rules (length<=6) were extracted from the first 3 trees.
## 151 rules (length<=6) were extracted from the first 3 trees.
## 161 rules (length<=6) were extracted from the first 3 trees.
colnames(a) <- c("Proporción Train - Total (%)", "Reglas", "Aciertos Train (%)", "Aciertos Valid (%)")
kable(a %>% drop_na())
Proporción Train - Total (%) Reglas Aciertos Train (%) Aciertos Valid (%)
2 20 141 90.5 87.3
3 30 150 90.2 88.1
4 40 138 89.7 88.5
5 50 157 89.7 89.0
6 60 137 89.5 88.8
7 70 151 89.6 89.6
8 80 161 89.8 89.8

Vamos con el 70/30 en 3 variables y 3 niveles. Aprovechamos el código existente.

datosautostrain <- datosautosfac %>% filter(((X%%10) %in% (seq_along(1:7)))==TRUE) %>% select(-c(X)) %>% mutate_if(is.numeric, as.factor)
datosautosvalid <- datosautosfac %>% filter(((X%%10) %in% (seq_along(1:7)))==FALSE) %>% select(-c(X))%>% mutate_if(is.numeric, as.factor)
modelo <- randomForest(cilindrada ~ ., data = datosautostrain, ntree = 3, mtry = 3, importance = TRUE)

No había explicado mucho hasta acá el tema de las listas de reglas más allá del número. Para esto usamos la librería inTrees que tiene funciones que nos permiten extraer los sets de reglas de un determinado modelo. Primero transformamos el modelo en un árbol y después en un conjunto de reglas. Igual acá tenemos mejor forma de aplicarlas pero veamos un poco para entender que estamos haciendo (o al menos intentarlo).

listaarboles <- RF2List(modelo)
listareglas <- extractRules(listaarboles, datosautostrain)
## 138 rules (length<=6) were extracted from the first 3 trees.
listareglas <- unique(listareglas)
kable(head(listareglas))
condition
X[,2] %in% c(‘Diesel’) & X[,3] %in% c(‘207 Compact’)
X[,2] %in% c(‘Diesel’) & X[,3] %in% c(‘Classic’,‘Siena’)
X[,1] %in% c(‘3’) & X[,2] %in% c(‘Diesel’) & X[,3] %in% c(‘Partner’)
X[,1] %in% c(‘2’,‘4’,‘5’,‘6’) & X[,2] %in% c(‘Diesel’) & X[,3] %in% c(‘Partner’)
X[,2] %in% c(‘Nafta y/o GNC’) & X[,3] %in% c(‘Partner’,‘Siena’)
X[,2] %in% c(‘Nafta y/o GNC’) & X[,3] %in% c(‘Classic’)

Retomamos el dataframe factorizado original y le agregamos una columna con los valores de predicción, después hacemos otra para comparar ambos valores.

datosautosfac$prediccion <- predict(modelo, datosautosfac)
datosautosfac <- datosautosfac %>% mutate(coincide = ifelse((cilindrada==prediccion),1,0))

Al igual que con los ejemplos anteriores vamos a ver la precisión de la predicción por modelo. Como acá la predicción es mucho mejor con el de modelo basta para ver el avance.

porcentajepormodelos <- datosautosfac %>%
    group_by(MODEL) %>% 
    summarise(
        porcaciertos = round((mean(coincide)*100),2)
)
porcentajepormodelos <- porcentajepormodelos[order(-porcentajepormodelos$porcaciertos),]
graficoporcentaje <- ggplot(porcentajepormodelos, aes(y=MODEL, x=porcaciertos))+
  geom_point() + 
  scale_y_discrete(limits = porcentajepormodelos$MODEL)+
  labs(title = "Porcentaje de aciertos por modelo", x = "Porcentaje de aciertos", y = "Modelo de vehículo")+
  geom_vline(xintercept = 50, linetype="dashed", 
                color = "red", size=0.8)+
  geom_vline(xintercept = 80, linetype="dashed", 
                color = "blue", size=0.8)+
  geom_vline(xintercept = 95, linetype="dashed", 
                color = "green", size=0.8)
graficoporcentaje

Sólo queda aplicar el modelo a los datos que teníamos sin la información de cilindrada y volver a juntar todo. A diferencia del modelo anterior en este no nos quedan valores sin asignar.

datosautosfac <- datosautosfac %>% select(-c(coincide, prediccion, X))
datosautosfacna$cilindrada <- predict(modelo, datosautosfacna)

datosautosfinal <- rbind(datosautosfacna, datosautosfac)

kable(head(datosautosfinal))
puertas combustible MODEL anio cilindrada
4 Nafta y/o GNC Prisma 2012 1.4
4 Nafta y/o GNC Prisma 2012 1.4
4 Nafta y/o GNC Prisma 2012 1.4
4 Nafta y/o GNC Prisma 2013 1.4
5 Nafta y/o GNC Prisma 2014 1.4
4 Nafta y/o GNC Prisma 2015 1.4

Con esto por ahora estaría con el tema de ML en base a categorías. Lo próximo sería analizar los textos de la descripción para acercarnos al 100% de precisión. Cualquier comentario es bienvenido!