Máquinas de Vector Soporte (Support Vector Machines, SVMs)

Nombre: Andrés Noboa

Cargamos las librerias

library(ggplot2)

Cargamos los data representantes de grupos que no son linealmente separables.

set.seed(10111)
coordinate <- matrix(rnorm(40), 20, 2)
colnames(coordinate) <- c("x1","x2")
y <- c(rep(-1,10), rep(1,10))
coordinate[y == 1, ] <- coordinate[y == 1, ] + 1
df <- data.frame(coordinate, y)
ggplot(data = df, aes(x = x1, y = x2, color = as.factor(y))) +
  geom_point(size = 6) +
  theme_bw() +
  theme(legend.position = "none")

la funcion svm(), nos indica automáticamente si se trata de un problema de clasificación, la variable respuesta es de tipo factor, o de regresión, la variable respuesta es tipo numérico

df$y <- as.factor(df$y)

modelo_svm <- svm(formula = y ~ x1 + x2, data = df, kernel = "linear",
                  cost = 10, scale = FALSE)

El summary del modelo muestra que hay un total de 6 vectores soporte, 3 pertenecen a una clase y 3 a la otra.

summary(modelo_svm)

Call:
svm(formula = y ~ x1 + x2, data = df, kernel = "linear", cost = 10, scale = FALSE)


Parameters:
   SVM-Type:  C-classification 
 SVM-Kernel:  linear 
       cost:  10 

Number of Support Vectors:  6

 ( 3 3 )


Number of Classes:  2 

Levels: 
 -1 1

Empleando la función plot() con un objeto de tipo svm junto con las observaciones de entrenamiento, se obtiene una representación del límite de decisión:

plot(modelo_svm, df)

Alternativa basada en ggplot2 para obtener una representación de los resultados de svm() :

# range de los predictores
range_x1 <- range(data$x1)
range_x2 <- range(data$x2)

# Interpolación de puntos
new_x1 <- seq(from = range_x1[1], to = range_x1[2], length = 75)
new_x2 <- seq(from = range_x2[1], to = range_x2[2], length = 75)
nuevos_puntos <- expand.grid(x1 = new_x1, x2 = new_x2)

# Predicción según el modelo
predicciones <- predict(object = modelo_svm, newdata = nuevos_puntos)

# Se almacenan los puntos predichos para dar color a las regiones
color_regiones <- data.frame(nuevos_puntos, y = predicciones)

# Para extraer la ecuación del hiperplano y del margen es necesario aplicar 
# algebra lineal.
beta <- drop(t(modelo_svm$coefs) %*% as.matrix(data[,c("x1","x2")])[modelo_svm$index,])
beta0 <- modelo_svm$rho


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 = x1, y = x2, color = as.factor(y)),
             size = 0.5) +
  # Se añaden las observaciones
  geom_point(data = data, aes(x = x1, y = x2, color = as.factor(y)),
             size = 6) +
  # Se identifican aquellas observaciones que son vectores soporte del modelo
  geom_point(data = data[modelo_svm$index, ],
             aes(x = x1, y = x2, color = as.factor(y)),
             shape = 21, colour = "black",
             size = 6) +
  # Se añaden las rectas del hiperplano y los márgenes
  geom_abline(intercept = beta0/beta[2], slope = -beta[1]/beta[2]) +
  geom_abline(intercept = (beta0 - 1)/beta[2], slope = -beta[1]/beta[2],
              linetype = "dashed") +    
  geom_abline(intercept = (beta0 + 1)/beta[2], slope = -beta[1]/beta[2],
              linetype = "dashed") +
  theme_bw() +
  theme(legend.position = "none")

Podemos realizar cross-validation mediante el paquete e1071 de R, con tune() podemos especificar un 10-fold cross validation

set.seed(1) # semilla en 1
svm_cv <- tune("svm", y ~ x1 + x2, data = df,
               kernel = 'linear',
               ranges = list(cost = c(0.001, 0.01, 0.1, 1, 5, 10, 20, 50, 100,
                                      150, 200)))
summary(svm_cv)

Parameter tuning of ‘svm’:

- sampling method: 10-fold cross validation 

- best parameters:

- best performance: 0.1 

- Detailed performance results:

NA

Gráfico del error de clasificación vs hiperparámetro C

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

Obtenemos el mejor modelo de los hiperparameters

Test dataset simulado

# Datos de test simulados
set.seed(19)
coordenadas <- matrix(rnorm(40), 20, 2)
colnames(coordenadas) <- c("x1","x2")
y <- sample(c(-1,1), 20, rep = TRUE)
coordenadas[y == 1, ] <- coordenadas[y == 1, ] + 1
test <- data.frame(coordenadas, y)

Predicciones

paste("Error de test:", 100*mean(test$y != predicciones),"%")

[1] "Error de test: 15 %"

Matriz de confusion de las predicciones

table(predicción = predicciones, valor_real = test$y)

          valor_real
predicción -1  1
        -1 10  0
        1   3  7