Suport Vectot Machine

Creado: 23-04-2021

En este post se explicara como realiar una clasificación de clientes que van a comprar un cierto producto. Esta clasificación se realizará con el algoritmo SVM.

Introduccion

El método de clasificación-regresión Máquinas de Vector Soporte (Vector Support Machines, SVMs) fue desarrollado en la década de los 90, dentro de campo de la ciencia computacional. Si bien originariamente se desarrolló como un método de clasificación binaria, su aplicación se ha extendido a problemas de clasificación múltiple y regresión. SVMs ha resultado ser uno de los mejores clasificadores para un amplio abanico de situaciones, por lo que se considera uno de los referentes dentro del ámbito de aprendizaje estadístico y machine learning.

Las Máquinas de Vector Soporte se fundamentan en el Maximal Margin Classifier, que a su vez, se basa en el concepto de hiperplano. A lo largo de este ensayo se introducen por orden cada uno de estos conceptos. Comprender los fundamentos de las SVMs requiere de conocimientos sólidos en álgebra lineal. En este ensayo no se profundiza en el aspecto matemático, pero puede encontrarse una descripción detallada en el libro Support Vector Machines Succinctly by Alexandre Kowalczyk.

En R, las librerías e1071 y LiblineaR contienen los algoritmos necesarios para obtener modelos de clasificación simple, múltiple y regresión, basados en Support Vector Machines.

Base de datos

set.seed(2021)
library(readr)
data<- read.csv("Social_Network_Ads.csv")

library(tidyverse)
data%>% DT::datatable(extensions = 'Buttons',
            options = list(dom = 'Blfrtip',
                           buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
                           lengthMenu = list(c(10,25,50,-1),
                                             c(10,25,50,"All"))))

datos= data 
datos$Purchased= ifelse(datos$Purchased==1,"Compra","No compra")
datos %>% ggplot(aes(EstimatedSalary,Age))+
  geom_point(mapping = aes(color=Purchased),size=1.8)+labs(title = "Problema a clasificar")+theme_minimal()

library(cowplot) 
# Main plot
pmain <- ggplot(datos, aes(x = EstimatedSalary, y = Age, color =Purchased))+
  geom_point()+
  ggpubr::color_palette("jco")+theme_cowplot()
# Marginal densities along x axis
xdens <- axis_canvas(pmain, axis = "x")+
  geom_density(data = datos, aes(x = EstimatedSalary, fill = Purchased),
              alpha = 0.7, size = 0.2)+
  ggpubr::fill_palette("jco")
# Marginal densities along y axis
# Need to set coord_flip = TRUE, if you plan to use coord_flip()
ydens <- axis_canvas(pmain, axis = "y", coord_flip = TRUE)+
  geom_density(data = datos, aes(x = Age, fill = Purchased),
                alpha = 0.7, size = 0.2)+
  coord_flip()+
  ggpubr::fill_palette("jco")
p1 <- insert_xaxis_grob(pmain, xdens, grid::unit(.2, "null"), position = "top")
p2<- insert_yaxis_grob(p1, ydens, grid::unit(.2, "null"), position = "right")
ggdraw(p2)

Kernel lineal

data= data[,3:5]
data$Purchased = factor(data$Purchased, levels = c(0, 1))

library(caret)
d<- createDataPartition(data$Purchased,p=0.8,list = FALSE)
data_train<- data[d,]
data_test<- data[-d,]

library(e1071)
classifier = svm(formula = Purchased ~ .,
                 data = data_train,
                 type = 'C-classification',
                 kernel = 'linear',scale = T)
y_pred = predict(classifier, newdata = data_train[-3])

library(hrbrthemes)
rango_X1 <- range(data_train$EstimatedSalary)
rango_X2 <- range(data_train$Age)

# Interpolación de puntos
new_x1 <- seq(from = rango_X1[1], to = rango_X1[2], length = 75)
new_x2 <- seq(from = rango_X2[1], to = rango_X2[2], length = 75)
nuevos_puntos <- expand.grid(EstimatedSalary = new_x1, Age = new_x2)

# Predicción según el modelo de los nuevos puntos
predicciones <- predict(object = classifier, newdata = nuevos_puntos)

# Se almacenan los puntos predichos para el color de las regiones en un dataframe
color_regiones <- data.frame(nuevos_puntos, y = predicciones)

a2<- ggplot() +
  # Representación de las 2 regiones empleando los puntos y coloreándolos
  # según la clase predicha por el modelo
  geom_point(data = color_regiones, aes(x = EstimatedSalary, y = Age, color = as.factor(y)),
             size = 0.5,alpha=2) +
  # Se añaden las observaciones
  geom_point(data = data_train, aes(x = EstimatedSalary, y = Age, color = as.factor(Purchased)),
             size = 2.5)  +
  theme_modern_rc(grid = F) +
  theme(legend.position = "none")
a2

draw_confusion_matrix <- function(cm) {
  
  layout(matrix(c(1,1,2)))
  par(mar=c(2,2,2,2))
  plot(c(100, 345), c(300, 450), type = "n", xlab="", ylab="", xaxt='n', yaxt='n')
  title('CONFUSION MATRIX', cex.main=2)
  
  # create the matrix 
  rect(150, 430, 240, 370, col='#3F97D0')
  text(195, 435, 'Class1', cex=1.2)
  rect(250, 430, 340, 370, col='#F7AD50')
  text(295, 435, 'Class2', cex=1.2)
  text(125, 370, 'Predicted', cex=1.3, srt=90, font=2)
  text(245, 450, 'Actual', cex=1.3, font=2)
  rect(150, 305, 240, 365, col='#F7AD50')
  rect(250, 305, 340, 365, col='#3F97D0')
  text(140, 400, 'Class1', cex=1.2, srt=90)
  text(140, 335, 'Class2', cex=1.2, srt=90)
  
  # add in the cm results 
  res <- as.numeric(cm$table)
  text(195, 400, res[1], cex=1.6, font=2, col='white')
  text(195, 335, res[2], cex=1.6, font=2, col='white')
  text(295, 400, res[3], cex=1.6, font=2, col='white')
  text(295, 335, res[4], cex=1.6, font=2, col='white')
  
  # add in the specifics 
  plot(c(100, 0), c(100, 0), type = "n", xlab="", ylab="", main = "DETAILS", xaxt='n', yaxt='n')
  text(10, 85, names(cm$byClass[1]), cex=1.2, font=2)
  text(10, 70, round(as.numeric(cm$byClass[1]), 3), cex=1.2)
  text(30, 85, names(cm$byClass[2]), cex=1.2, font=2)
  text(30, 70, round(as.numeric(cm$byClass[2]), 3), cex=1.2)
  text(50, 85, names(cm$byClass[5]), cex=1.2, font=2)
  text(50, 70, round(as.numeric(cm$byClass[5]), 3), cex=1.2)
  text(70, 85, names(cm$byClass[6]), cex=1.2, font=2)
  text(70, 70, round(as.numeric(cm$byClass[6]), 3), cex=1.2)
  text(90, 85, names(cm$byClass[7]), cex=1.2, font=2)
  text(90, 70, round(as.numeric(cm$byClass[7]), 3), cex=1.2)
  
  # add in the accuracy information 
  text(30, 35, names(cm$overall[1]), cex=1.5, font=2)
  text(30, 20, round(as.numeric(cm$overall[1]), 3), cex=1.4)
  text(70, 35, names(cm$overall[2]), cex=1.5, font=2)
  text(70, 20, round(as.numeric(cm$overall[2]), 3), cex=1.4)
}  

draw_confusion_matrix(confusionMatrix(data_train$Purchased, y_pred))

y_pred<- predict(classifier,data_test[,-3])
draw_confusion_matrix(confusionMatrix(data_test[,3],y_pred))

rango_X1 <- range(data_test$EstimatedSalary)
rango_X2 <- range(data_test$Age)

# Interpolación de puntos
new_x1 <- seq(from = rango_X1[1], to = rango_X1[2], length = 75)
new_x2 <- seq(from = rango_X2[1], to = rango_X2[2], length = 75)
nuevos_puntos <- expand.grid(EstimatedSalary = new_x1, Age = new_x2)

# Predicción según el modelo de los nuevos puntos
predicciones <- predict(object = classifier, newdata = nuevos_puntos)

# Se almacenan los puntos predichos para el color de las regiones en un dataframe
color_regiones <- data.frame(nuevos_puntos, y = predicciones)

a1<- ggplot() +
  # Representación de las 2 regiones empleando los puntos y coloreándolos
  # según la clase predicha por el modelo
  geom_point(data = color_regiones, aes(x = EstimatedSalary, y = Age, color = as.factor(y)),
             size = 0.5,alpha=2) +
  # Se añaden las observaciones
  geom_point(data = data_test, aes(x = EstimatedSalary, y = Age, color = as.factor(Purchased)),
             size = 2.5)  +
  theme_modern_rc(grid = F) +
  theme(legend.position = "none")
a1

Kernel Radial

classifier = svm(formula = Purchased ~ .,
                 data = data_train,
                 type = 'C-classification',
                 kernel = 'radial',scale = T)
y_pred = predict(classifier, newdata = data_train[-3])

rango_X1 <- range(data_train$EstimatedSalary)
rango_X2 <- range(data_train$Age)

# Interpolación de puntos
new_x1 <- seq(from = rango_X1[1], to = rango_X1[2], length = 75)
new_x2 <- seq(from = rango_X2[1], to = rango_X2[2], length = 75)
nuevos_puntos <- expand.grid(EstimatedSalary = new_x1, Age = new_x2)

# Predicción según el modelo de los nuevos puntos
predicciones <- predict(object = classifier, newdata = nuevos_puntos)

# Se almacenan los puntos predichos para el color de las regiones en un dataframe
color_regiones <- data.frame(nuevos_puntos, y = predicciones)

a3<- ggplot() +
  # Representación de las 2 regiones empleando los puntos y coloreándolos
  # según la clase predicha por el modelo
  geom_point(data = color_regiones, aes(x = EstimatedSalary, y = Age, color = as.factor(y)),
             size = 0.5,alpha=2) +
  # Se añaden las observaciones
  geom_point(data = data_train, aes(x = EstimatedSalary, y = Age, color = as.factor(Purchased)),
             size = 2.5)  +
  theme_modern_rc(grid = F) +
  theme(legend.position = "none")
a3

draw_confusion_matrix(confusionMatrix(data_train$Purchased, y_pred))

y_pred<- predict(classifier,data_test[,-3])
draw_confusion_matrix(confusionMatrix(data_test[,3],y_pred))

rango_X1 <- range(data_test$EstimatedSalary)
rango_X2 <- range(data_test$Age)

# Interpolación de puntos
new_x1 <- seq(from = rango_X1[1], to = rango_X1[2], length = 75)
new_x2 <- seq(from = rango_X2[1], to = rango_X2[2], length = 75)
nuevos_puntos <- expand.grid(EstimatedSalary = new_x1, Age = new_x2)

# Predicción según el modelo de los nuevos puntos
predicciones <- predict(object = classifier, newdata = nuevos_puntos)

# Se almacenan los puntos predichos para el color de las regiones en un dataframe
color_regiones <- data.frame(nuevos_puntos, y = predicciones)

a4<- ggplot() +
  # Representación de las 2 regiones empleando los puntos y coloreándolos
  # según la clase predicha por el modelo
  geom_point(data = color_regiones, aes(x = EstimatedSalary, y = Age, color = as.factor(y)),
             size = 0.5,alpha=2) +
  # Se añaden las observaciones
  geom_point(data = data_test, aes(x = EstimatedSalary, y = Age, color = as.factor(Purchased)),
             size = 2.5)  +
  theme_modern_rc(grid = F) +
  theme(legend.position = "none")
a4

Los mejores parámetros

svm_cv<- tune("svm", Purchased ~ ., data = data_train, kernel = 'linear',
               ranges = list(cost = c(0.0001, 0.0005, 0.001, 0.01, 0.1, 1,1.5,2)))

ggplot(data = svm_cv$performances, aes(x = cost, y = error)) +
  geom_line() +
  geom_point() +
  labs(title = "Error de clasificación vs hiperparámetro C") +
  theme_minimal_grid()

svm_cv$best.parameters

##   cost
## 6    1

classifier_1<- svm_cv$best.model

svm_cv <- tune("svm", Purchased ~., data = data_train, kernel = 'radial',
               ranges = list(cost = c(0.001, 0.01, 0.1, 1, 5, 10, 20),
                             gamma = c(0.5, 1, 2, 3, 4, 5, 10)))

ggplot(data = svm_cv$performances, aes(x = cost, y = error, color = as.factor(gamma)))+
  geom_line() +
  geom_point() +
  labs(title = "Error de clasificación vs hiperparámetros C y gamma", color = "gamma") +
  theme_modern_rc() +
  theme(legend.position = "bottom")

svm_cv$best.parameters

##    cost gamma
## 13   10     1

classifier_2<- svm_cv$best.model

rango_X1 <- range(data_test$EstimatedSalary)
rango_X2 <- range(data_test$Age)

# Interpolación de puntos
new_x1 <- seq(from = rango_X1[1], to = rango_X1[2], length = 75)
new_x2 <- seq(from = rango_X2[1], to = rango_X2[2], length = 75)
nuevos_puntos <- expand.grid(EstimatedSalary = new_x1, Age = new_x2)

# Predicción según el modelo de los nuevos puntos
predicciones <- predict(object = classifier_1, newdata = nuevos_puntos)

# Se almacenan los puntos predichos para el color de las regiones en un dataframe
color_regiones <- data.frame(nuevos_puntos, y = predicciones)

a5<- ggplot() +
  # Representación de las 2 regiones empleando los puntos y coloreándolos
  # según la clase predicha por el modelo
  geom_point(data = color_regiones, aes(x = EstimatedSalary, y = Age, color = as.factor(y)),
             size = 0.5,alpha=2) +
  # Se añaden las observaciones
  geom_point(data = data_test, aes(x = EstimatedSalary, y = Age, color = as.factor(Purchased)),
             size = 2.5)  +
  theme_modern_rc(grid = F) +
  theme(legend.position = "none")
a5

rango_X1 <- range(data_test$EstimatedSalary)
rango_X2 <- range(data_test$Age)

# Interpolación de puntos
new_x1 <- seq(from = rango_X1[1], to = rango_X1[2], length = 75)
new_x2 <- seq(from = rango_X2[1], to = rango_X2[2], length = 75)
nuevos_puntos <- expand.grid(EstimatedSalary = new_x1, Age = new_x2)

# Predicción según el modelo de los nuevos puntos
predicciones <- predict(object = classifier_2, newdata = nuevos_puntos)

# Se almacenan los puntos predichos para el color de las regiones en un dataframe
color_regiones <- data.frame(nuevos_puntos, y = predicciones)

a6<- ggplot() +
  # Representación de las 2 regiones empleando los puntos y coloreándolos
  # según la clase predicha por el modelo
  geom_point(data = color_regiones, aes(x = EstimatedSalary, y = Age, color = as.factor(y)),
             size = 0.5,alpha=2) +
  # Se añaden las observaciones
  geom_point(data = data_test, aes(x = EstimatedSalary, y = Age, color = as.factor(Purchased)),
             size = 2.5)  +
  theme_modern_rc(grid = F) +
  theme(legend.position = "none")
a6

Comparación de los resultados

ata<- ggpubr::ggarrange(a4,a6,a1,a5)
final_plot <- ggpubr::annotate_figure(ata, top = ggpubr::text_grob("Comparación de modelos", size = 15))
final_plot