SVM con datos de la felicidad
Rubén Pizarro Gurrola
8/4/2022
Objetivo
Contruir un modelo de clasificación basado en el algoritmo de máquinas de soporte vectorial (SVM) con distintos tipos de kernel.
Los kernel pueden ser lineal radial polinomial, entre otros.
Descripción
Se cargan las librerías necesarias para contr,ir el modelo de Máquinas de soprte vectorial (SVM) Cargar los datos https://raw.githubusercontent.com/rpizarrog/Machine-Learning-con-R/main/datos/estado%20de%20felicidad%20variables.csv
Se eva
Fundamento teórico
Documento basado en (Pizarro 2020)
Desarrollo
Cargar librerías
library(knitr) # Para ver tablas mas amigables en formato html markdown
library(ggplot2) # Gráficas
library(dplyr) # Varias operaciones
library(caret) # Para particionar datos. De entranamiento y de validación
#install.packages("e1071") # Para SVM
library(e1071)Cargar los datos
datos <- read.csv("https://raw.githubusercontent.com/rpizarrog/Machine-Learning-con-R/main/datos/estado%20de%20felicidad%20variables.csv", stringsAsFactors = TRUE)Explorar datos
str(datos)## 'data.frame': 52 obs. of 10 variables:
## $ genero : Factor w/ 2 levels "FEMENINO","MASCULINO": 2 1 2 1 2 1 2 1 2 1 ...
## $ esto.civil : Factor w/ 4 levels "CASADO","DIVORCIADO",..: 3 1 2 4 1 3 4 2 1 3 ...
## $ edad : int 25 35 45 54 52 28 56 32 35 29 ...
## $ satisfaccion.laboral : num 80 50 70 50 40 50 71.5 60 70 80 ...
## $ satisfaccion.profesional: num 90 80 78 80 50 60 60.8 80 60 80 ...
## $ vida.familiar : num 70 60 80 60 60 54 86.9 30 72 90 ...
## $ vida.social : num 80 70 40 80 70 60 70.6 50 60 60 ...
## $ salud : Factor w/ 3 levels "BUENO","MALO",..: 1 2 3 1 1 2 2 3 1 2 ...
## $ dinero : num 90 30 70 20 60 50 70 20 70 80 ...
## $ estado : Factor w/ 2 levels "FELIZ","NO FELIZ": 1 2 1 2 2 2 1 2 1 1 ...summary(datos)## genero esto.civil edad satisfaccion.laboral
## FEMENINO :26 CASADO :16 Min. :25.00 Min. : 24.00
## MASCULINO:26 DIVORCIADO: 6 1st Qu.:34.00 1st Qu.: 50.00
## SOLTERO :23 Median :39.50 Median : 60.00
## VIUDO : 7 Mean :40.79 Mean : 64.03
## 3rd Qu.:45.00 3rd Qu.: 80.00
## Max. :88.00 Max. :100.00
## satisfaccion.profesional vida.familiar vida.social salud
## Min. : 40.00 Min. : 20.00 Min. : 20.00 BUENO :25
## 1st Qu.: 60.00 1st Qu.: 50.00 1st Qu.: 50.00 MALO :13
## Median : 70.00 Median : 61.00 Median : 60.00 REGULAR:14
## Mean : 68.98 Mean : 65.48 Mean : 64.57
## 3rd Qu.: 80.00 3rd Qu.: 80.00 3rd Qu.: 80.00
## Max. :100.00 Max. :100.00 Max. :100.00
## dinero estado
## Min. : 20.00 FELIZ :32
## 1st Qu.: 48.00 NO FELIZ:20
## Median : 60.00
## Mean : 60.86
## 3rd Qu.: 80.00
## Max. :100.00head()
kable(head(datos, 10), caption = "Primeros 10")| genero | esto.civil | edad | satisfaccion.laboral | satisfaccion.profesional | vida.familiar | vida.social | salud | dinero | estado |
|---|---|---|---|---|---|---|---|---|---|
| MASCULINO | SOLTERO | 25 | 80.0 | 90.0 | 70.0 | 80.0 | BUENO | 90 | FELIZ |
| FEMENINO | CASADO | 35 | 50.0 | 80.0 | 60.0 | 70.0 | MALO | 30 | NO FELIZ |
| MASCULINO | DIVORCIADO | 45 | 70.0 | 78.0 | 80.0 | 40.0 | REGULAR | 70 | FELIZ |
| FEMENINO | VIUDO | 54 | 50.0 | 80.0 | 60.0 | 80.0 | BUENO | 20 | NO FELIZ |
| MASCULINO | CASADO | 52 | 40.0 | 50.0 | 60.0 | 70.0 | BUENO | 60 | NO FELIZ |
| FEMENINO | SOLTERO | 28 | 50.0 | 60.0 | 54.0 | 60.0 | MALO | 50 | NO FELIZ |
| MASCULINO | VIUDO | 56 | 71.5 | 60.8 | 86.9 | 70.6 | MALO | 70 | FELIZ |
| FEMENINO | DIVORCIADO | 32 | 60.0 | 80.0 | 30.0 | 50.0 | REGULAR | 20 | NO FELIZ |
| MASCULINO | CASADO | 35 | 70.0 | 60.0 | 72.0 | 60.0 | BUENO | 70 | FELIZ |
| FEMENINO | SOLTERO | 29 | 80.0 | 80.0 | 90.0 | 60.0 | MALO | 80 | FELIZ |
tail()
kable(tail(datos, 10), caption = "Ultimos 10")| genero | esto.civil | edad | satisfaccion.laboral | satisfaccion.profesional | vida.familiar | vida.social | salud | dinero | estado | |
|---|---|---|---|---|---|---|---|---|---|---|
| 43 | FEMENINO | SOLTERO | 45 | 90 | 95 | 90 | 100 | BUENO | 90 | FELIZ |
| 44 | MASCULINO | VIUDO | 88 | 65 | 66 | 89 | 87 | REGULAR | 45 | NO FELIZ |
| 45 | MASCULINO | CASADO | 54 | 90 | 90 | 90 | 100 | BUENO | 75 | FELIZ |
| 46 | MASCULINO | SOLTERO | 80 | 80 | 80 | 90 | 90 | BUENO | 90 | FELIZ |
| 47 | MASCULINO | SOLTERO | 39 | 50 | 80 | 90 | 80 | REGULAR | 90 | FELIZ |
| 48 | FEMENINO | SOLTERO | 40 | 30 | 60 | 80 | 50 | REGULAR | 50 | NO FELIZ |
| 49 | FEMENINO | SOLTERO | 49 | 80 | 80 | 80 | 80 | BUENO | 70 | FELIZ |
| 50 | MASCULINO | SOLTERO | 39 | 60 | 80 | 48 | 50 | REGULAR | 50 | NO FELIZ |
| 51 | FEMENINO | SOLTERO | 30 | 100 | 100 | 100 | 100 | BUENO | 100 | NO FELIZ |
| 52 | FEMENINO | SOLTERO | 32 | 70 | 80 | 80 | 80 | BUENO | 80 | FELIZ |
Transformar/Limpiar datos
Como parte de preparar los datos habrá que transformar la variable estado:
La variable de interés es FELIZ o NO FELIZ * FELIZ = 1 * NO FELIZ = 0
datos <- datos %>%
mutate(estado.01 = if_else(estado == "FELIZ", 1, 0))genero * MASCULINO: 1 * FEMENINO: 2
datos <- datos %>%
mutate(genero.12 = if_else(genero == "MASCULINO", 1, 2), )edo_civil
SOLTERO: 1
CASADO: 2
DIVORCIADO: 3
VIUDO: 4
datos <- datos %>%
mutate(esto.civil.14 = ifelse(esto.civil == "SOLTERO", 1, ifelse(esto.civil == "CASADO", 2, ifelse(esto.civil == "DIVORCIADO", 3, 4))))edo_civil
BUENO: 1
MALO: 2
REGULAR 3
datos <- datos %>%
mutate(salud.13 = ifelse(salud == "BUENO", 1, ifelse(salud == "MALO", 2, 3)))El haber transformado los datos a valores numéricos ayuda en algunos modelos que requieren datos numéricos, sin embargo para el modelo de SVM se pueden dejar los valores de los atributos simplemente indicando que son de tipo factor.
Se puede transformar a factor al momento de leer los datos csv con el argumento la stringsAsFactors = TRUE o se puede factorizar o categorizar mediante las funciones as.factor() o factor().
Particionar los datos
Partir los datos con una semilla de 2022 con el 70% para dAtos de entrenamiento y el 30% para datos de validación.
Sembrar semilla
set.seed(2022)Datos de entrenamiento
n <- nrow(datos)
entrena <- createDataPartition(y = datos$estado, p = 0.70, list = FALSE, times = 1)
entrena## Resample1
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
## [7,] 8
## [8,] 9
## [9,] 10
## [10,] 11
## [11,] 13
## [12,] 14
## [13,] 15
## [14,] 16
## [15,] 18
## [16,] 19
## [17,] 20
## [18,] 21
## [19,] 22
## [20,] 23
## [21,] 24
## [22,] 25
## [23,] 28
## [24,] 29
## [25,] 30
## [26,] 32
## [27,] 33
## [28,] 36
## [29,] 37
## [30,] 38
## [31,] 41
## [32,] 42
## [33,] 44
## [34,] 46
## [35,] 47
## [36,] 50
## [37,] 52# Datos entrenamiento
datos.entrenamiento <- datos[entrena, ] # [renglones, columna]
kable(datos.entrenamiento, caption = "Datos de entrenamiento")| genero | esto.civil | edad | satisfaccion.laboral | satisfaccion.profesional | vida.familiar | vida.social | salud | dinero | estado | estado.01 | genero.12 | esto.civil.14 | salud.13 | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | MASCULINO | SOLTERO | 25 | 80 | 90 | 70 | 80.00 | BUENO | 90.0 | FELIZ | 1 | 1 | 1 | 1 |
| 2 | FEMENINO | CASADO | 35 | 50 | 80 | 60 | 70.00 | MALO | 30.0 | NO FELIZ | 0 | 2 | 2 | 2 |
| 3 | MASCULINO | DIVORCIADO | 45 | 70 | 78 | 80 | 40.00 | REGULAR | 70.0 | FELIZ | 1 | 1 | 3 | 3 |
| 4 | FEMENINO | VIUDO | 54 | 50 | 80 | 60 | 80.00 | BUENO | 20.0 | NO FELIZ | 0 | 2 | 4 | 1 |
| 5 | MASCULINO | CASADO | 52 | 40 | 50 | 60 | 70.00 | BUENO | 60.0 | NO FELIZ | 0 | 1 | 2 | 1 |
| 6 | FEMENINO | SOLTERO | 28 | 50 | 60 | 54 | 60.00 | MALO | 50.0 | NO FELIZ | 0 | 2 | 1 | 2 |
| 8 | FEMENINO | DIVORCIADO | 32 | 60 | 80 | 30 | 50.00 | REGULAR | 20.0 | NO FELIZ | 0 | 2 | 3 | 3 |
| 9 | MASCULINO | CASADO | 35 | 70 | 60 | 72 | 60.00 | BUENO | 70.0 | FELIZ | 1 | 1 | 2 | 1 |
| 10 | FEMENINO | SOLTERO | 29 | 80 | 80 | 90 | 60.00 | MALO | 80.0 | FELIZ | 1 | 2 | 1 | 2 |
| 11 | MASCULINO | DIVORCIADO | 45 | 60 | 60 | 70 | 50.00 | REGULAR | 90.0 | FELIZ | 1 | 1 | 3 | 3 |
| 13 | MASCULINO | CASADO | 26 | 50 | 45 | 80 | 60.00 | MALO | 20.0 | NO FELIZ | 0 | 1 | 2 | 2 |
| 14 | FEMENINO | SOLTERO | 34 | 60 | 40 | 50 | 80.00 | BUENO | 65.9 | FELIZ | 1 | 2 | 1 | 1 |
| 15 | MASCULINO | DIVORCIADO | 42 | 50 | 65 | 56 | 62.58 | REGULAR | 33.5 | NO FELIZ | 0 | 1 | 3 | 3 |
| 16 | FEMENINO | VIUDO | 35 | 80 | 70 | 20 | 20.00 | MALO | 20.5 | NO FELIZ | 0 | 2 | 4 | 2 |
| 18 | FEMENINO | SOLTERO | 34 | 54 | 80 | 56 | 60.00 | REGULAR | 55.0 | FELIZ | 1 | 2 | 1 | 3 |
| 19 | MASCULINO | DIVORCIADO | 34 | 60 | 70 | 80 | 50.00 | MALO | 100.0 | FELIZ | 1 | 1 | 3 | 2 |
| 20 | FEMENINO | SOLTERO | 32 | 40 | 50 | 80 | 90.00 | BUENO | 95.0 | FELIZ | 1 | 2 | 1 | 1 |
| 21 | MASCULINO | SOLTERO | 29 | 50 | 60 | 60 | 80.00 | MALO | 70.0 | FELIZ | 1 | 1 | 1 | 2 |
| 22 | FEMENINO | SOLTERO | 26 | 60 | 60 | 60 | 60.00 | BUENO | 60.0 | FELIZ | 1 | 2 | 1 | 1 |
| 23 | MASCULINO | CASADO | 45 | 60 | 60 | 60 | 60.00 | BUENO | 50.0 | FELIZ | 1 | 1 | 2 | 1 |
| 24 | FEMENINO | VIUDO | 45 | 50 | 60 | 60 | 30.00 | REGULAR | 35.0 | NO FELIZ | 0 | 2 | 4 | 3 |
| 25 | MASCULINO | CASADO | 28 | 50 | 40 | 80 | 30.00 | MALO | 30.0 | NO FELIZ | 0 | 1 | 2 | 2 |
| 28 | FEMENINO | CASADO | 40 | 45 | 50 | 40 | 90.00 | MALO | 60.0 | NO FELIZ | 0 | 2 | 2 | 2 |
| 29 | MASCULINO | SOLTERO | 41 | 60 | 60 | 60 | 60.00 | BUENO | 49.0 | FELIZ | 1 | 1 | 1 | 1 |
| 30 | FEMENINO | VIUDO | 38 | 80 | 70 | 30 | 40.00 | BUENO | 45.0 | NO FELIZ | 0 | 2 | 4 | 1 |
| 32 | FEMENINO | CASADO | 38 | 60 | 80 | 90 | 80.00 | BUENO | 60.0 | FELIZ | 1 | 2 | 2 | 1 |
| 33 | FEMENINO | CASADO | 37 | 80 | 60 | 70 | 50.00 | BUENO | 60.0 | FELIZ | 1 | 2 | 2 | 1 |
| 36 | FEMENINO | CASADO | 43 | 95 | 80 | 90 | 90.00 | BUENO | 80.0 | FELIZ | 1 | 2 | 2 | 1 |
| 37 | MASCULINO | CASADO | 55 | 70 | 70 | 65 | 89.00 | MALO | 75.0 | FELIZ | 1 | 1 | 2 | 2 |
| 38 | MASCULINO | SOLTERO | 45 | 65 | 70 | 45 | 65.00 | BUENO | 45.0 | FELIZ | 1 | 1 | 1 | 1 |
| 41 | MASCULINO | SOLTERO | 39 | 60 | 80 | 48 | 50.00 | BUENO | 60.0 | FELIZ | 1 | 1 | 1 | 1 |
| 42 | MASCULINO | SOLTERO | 42 | 90 | 80 | 50 | 100.00 | REGULAR | 80.0 | FELIZ | 1 | 1 | 1 | 3 |
| 44 | MASCULINO | VIUDO | 88 | 65 | 66 | 89 | 87.00 | REGULAR | 45.0 | NO FELIZ | 0 | 1 | 4 | 3 |
| 46 | MASCULINO | SOLTERO | 80 | 80 | 80 | 90 | 90.00 | BUENO | 90.0 | FELIZ | 1 | 1 | 1 | 1 |
| 47 | MASCULINO | SOLTERO | 39 | 50 | 80 | 90 | 80.00 | REGULAR | 90.0 | FELIZ | 1 | 1 | 1 | 3 |
| 50 | MASCULINO | SOLTERO | 39 | 60 | 80 | 48 | 50.00 | REGULAR | 50.0 | NO FELIZ | 0 | 1 | 1 | 3 |
| 52 | FEMENINO | SOLTERO | 32 | 70 | 80 | 80 | 80.00 | BUENO | 80.0 | FELIZ | 1 | 2 | 1 | 1 |
Datos de validación
# Datos validación
datos.validacion <- datos[-entrena, ] # Los que no son de entrenamiento
kable(datos.validacion, caption = "Datos de validación")| genero | esto.civil | edad | satisfaccion.laboral | satisfaccion.profesional | vida.familiar | vida.social | salud | dinero | estado | estado.01 | genero.12 | esto.civil.14 | salud.13 | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 7 | MASCULINO | VIUDO | 56 | 71.5 | 60.8 | 86.9 | 70.6 | MALO | 70.0 | FELIZ | 1 | 1 | 4 | 2 |
| 12 | FEMENINO | VIUDO | 48 | 60.0 | 50.0 | 50.0 | 45.5 | MALO | 70.0 | NO FELIZ | 0 | 2 | 4 | 2 |
| 17 | MASCULINO | CASADO | 48 | 50.0 | 50.0 | 50.0 | 50.0 | BUENO | 49.5 | FELIZ | 1 | 1 | 2 | 1 |
| 26 | FEMENINO | DIVORCIADO | 32 | 80.0 | 70.0 | 40.0 | 40.0 | MALO | 40.0 | NO FELIZ | 0 | 2 | 3 | 2 |
| 27 | MASCULINO | SOLTERO | 36 | 65.0 | 60.0 | 62.0 | 87.0 | REGULAR | 56.5 | FELIZ | 1 | 1 | 1 | 3 |
| 31 | MASCULINO | CASADO | 36 | 85.0 | 80.0 | 90.0 | 50.0 | BUENO | 80.0 | FELIZ | 1 | 1 | 2 | 1 |
| 34 | FEMENINO | SOLTERO | 40 | 60.0 | 80.0 | 40.0 | 50.0 | REGULAR | 30.0 | NO FELIZ | 0 | 2 | 1 | 3 |
| 35 | MASCULINO | CASADO | 40 | 60.0 | 70.0 | 50.0 | 30.0 | BUENO | 50.0 | FELIZ | 1 | 1 | 2 | 1 |
| 39 | FEMENINO | CASADO | 41 | 24.0 | 57.0 | 33.0 | 71.0 | BUENO | 100.0 | NO FELIZ | 0 | 2 | 2 | 1 |
| 40 | FEMENINO | SOLTERO | 40 | 80.0 | 80.0 | 90.0 | 30.0 | REGULAR | 50.0 | FELIZ | 1 | 2 | 1 | 3 |
| 43 | FEMENINO | SOLTERO | 45 | 90.0 | 95.0 | 90.0 | 100.0 | BUENO | 90.0 | FELIZ | 1 | 2 | 1 | 1 |
| 45 | MASCULINO | CASADO | 54 | 90.0 | 90.0 | 90.0 | 100.0 | BUENO | 75.0 | FELIZ | 1 | 1 | 2 | 1 |
| 48 | FEMENINO | SOLTERO | 40 | 30.0 | 60.0 | 80.0 | 50.0 | REGULAR | 50.0 | NO FELIZ | 0 | 2 | 1 | 3 |
| 49 | FEMENINO | SOLTERO | 49 | 80.0 | 80.0 | 80.0 | 80.0 | BUENO | 70.0 | FELIZ | 1 | 2 | 1 | 1 |
| 51 | FEMENINO | SOLTERO | 30 | 100.0 | 100.0 | 100.0 | 100.0 | BUENO | 100.0 | NO FELIZ | 0 | 2 | 1 | 1 |
Modelo SVM Lineal
Estimar el mejor costo para el modelo
El costo tiene que ver con la flexibilidad de los vectores de soporte, esto significa que tan bien clasifica el modelo.
La expresión estado ~ . significa que la variable estado está e función o depende de todas (.) las variables. Algo similar a esto: genero + esto.civil + edad + …. dinero.
La variable ajuste.costo identifica el mejor costo para la construcción del modelo como parámetro.
## set.seed(2022)
ajuste.costo <- tune(svm, estado ~ genero + esto.civil + edad + satisfaccion.laboral + satisfaccion.profesional + vida.familiar + vida.social + salud + dinero, data = datos.entrenamiento,
kernel = "linear",
ranges = list(cost = seq(from= 0.01, to=1, by = 0.04)),
scale = TRUE)
summary(ajuste.costo)##
## Parameter tuning of 'svm':
##
## - sampling method: 10-fold cross validation
##
## - best parameters:
## cost
## 0.05
##
## - best performance: 0.1333333
##
## - Detailed performance results:
## cost error dispersion
## 1 0.01 0.3750000 0.2812286
## 2 0.05 0.1333333 0.2490724
## 3 0.09 0.1583333 0.2467380
## 4 0.13 0.1333333 0.1850926
## 5 0.17 0.1333333 0.1850926
## 6 0.21 0.1333333 0.1850926
## 7 0.25 0.1333333 0.1850926
## 8 0.29 0.1333333 0.1850926
## 9 0.33 0.1333333 0.1850926
## 10 0.37 0.1583333 0.1819391
## 11 0.41 0.1833333 0.2415229
## 12 0.45 0.1833333 0.2415229
## 13 0.49 0.1833333 0.2415229
## 14 0.53 0.1833333 0.2415229
## 15 0.57 0.1833333 0.2415229
## 16 0.61 0.1833333 0.2415229
## 17 0.65 0.1833333 0.2415229
## 18 0.69 0.1833333 0.2415229
## 19 0.73 0.1833333 0.2415229
## 20 0.77 0.1833333 0.2415229
## 21 0.81 0.1583333 0.1819391
## 22 0.85 0.1333333 0.1850926
## 23 0.89 0.1333333 0.1850926
## 24 0.93 0.1333333 0.1850926
## 25 0.97 0.1333333 0.1850926Mejor costo
Con la función filter de la librería dplyr se filtra el mejor costo
mejor.costo <- filter(ajuste.costo$performances, error == min(ajuste.costo$performances$error))
mejor.costo <- min(mejor.costo$cost)
mejor.costo## [1] 0.05Graficando el mejor costo
ggplot(data = ajuste.costo$performances, aes(x = cost, y = error)) +
# geom_line() +
geom_point(col='red') +
labs(title = "Error de validación ~ hiperparámetro C") +
# theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
Construir un modelo SVM lineal
modelo.svm.lineal <- svm(estado ~ genero + esto.civil + edad + satisfaccion.laboral + satisfaccion.profesional + vida.familiar + vida.social + salud + dinero, data = datos.entrenamiento, kernel = "linear", cost = mejor.costo, scale = TRUE)
summary(modelo.svm.lineal)##
## Call:
## svm(formula = estado ~ genero + esto.civil + edad + satisfaccion.laboral +
## satisfaccion.profesional + vida.familiar + vida.social + salud +
## dinero, data = datos.entrenamiento, kernel = "linear", cost = mejor.costo,
## scale = TRUE)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: linear
## cost: 0.05
##
## Number of Support Vectors: 26
##
## ( 13 13 )
##
##
## Number of Classes: 2
##
## Levels:
## FELIZ NO FELIZHacer predicciones
Las predicciones se hacen con los datos de validación
predicciones <- predict(object = modelo.svm.lineal, datos.validacion )
predicciones## 7 12 17 26 27 31 34 35
## FELIZ NO FELIZ NO FELIZ NO FELIZ FELIZ FELIZ NO FELIZ NO FELIZ
## 39 40 43 45 48 49 51
## FELIZ FELIZ FELIZ FELIZ NO FELIZ FELIZ FELIZ
## Levels: FELIZ NO FELIZEvaluar el modelo
El modelo se evalúa utilizando la matriz de confusión con la métrica accuracy = exactitud.
Crear tabla comparativa y convertir a tipo factor las predicciones. La tabla comparativa solo extrae de las columnas de interés que son las columnas del 1 al 10 y la de predicciones 15.
tabla.comparativa <- data.frame(datos.validacion, predicciones)
kable(tabla.comparativa[c(1:10, 15),], caption = "Tabla comparativa")| genero | esto.civil | edad | satisfaccion.laboral | satisfaccion.profesional | vida.familiar | vida.social | salud | dinero | estado | estado.01 | genero.12 | esto.civil.14 | salud.13 | predicciones | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 7 | MASCULINO | VIUDO | 56 | 71.5 | 60.8 | 86.9 | 70.6 | MALO | 70.0 | FELIZ | 1 | 1 | 4 | 2 | FELIZ |
| 12 | FEMENINO | VIUDO | 48 | 60.0 | 50.0 | 50.0 | 45.5 | MALO | 70.0 | NO FELIZ | 0 | 2 | 4 | 2 | NO FELIZ |
| 17 | MASCULINO | CASADO | 48 | 50.0 | 50.0 | 50.0 | 50.0 | BUENO | 49.5 | FELIZ | 1 | 1 | 2 | 1 | NO FELIZ |
| 26 | FEMENINO | DIVORCIADO | 32 | 80.0 | 70.0 | 40.0 | 40.0 | MALO | 40.0 | NO FELIZ | 0 | 2 | 3 | 2 | NO FELIZ |
| 27 | MASCULINO | SOLTERO | 36 | 65.0 | 60.0 | 62.0 | 87.0 | REGULAR | 56.5 | FELIZ | 1 | 1 | 1 | 3 | FELIZ |
| 31 | MASCULINO | CASADO | 36 | 85.0 | 80.0 | 90.0 | 50.0 | BUENO | 80.0 | FELIZ | 1 | 1 | 2 | 1 | FELIZ |
| 34 | FEMENINO | SOLTERO | 40 | 60.0 | 80.0 | 40.0 | 50.0 | REGULAR | 30.0 | NO FELIZ | 0 | 2 | 1 | 3 | NO FELIZ |
| 35 | MASCULINO | CASADO | 40 | 60.0 | 70.0 | 50.0 | 30.0 | BUENO | 50.0 | FELIZ | 1 | 1 | 2 | 1 | NO FELIZ |
| 39 | FEMENINO | CASADO | 41 | 24.0 | 57.0 | 33.0 | 71.0 | BUENO | 100.0 | NO FELIZ | 0 | 2 | 2 | 1 | FELIZ |
| 40 | FEMENINO | SOLTERO | 40 | 80.0 | 80.0 | 90.0 | 30.0 | REGULAR | 50.0 | FELIZ | 1 | 2 | 1 | 3 | FELIZ |
| 51 | FEMENINO | SOLTERO | 30 | 100.0 | 100.0 | 100.0 | 100.0 | BUENO | 100.0 | NO FELIZ | 0 | 2 | 1 | 1 | FELIZ |
Convertir a tipo factor
tabla.comparativa$predicciones <- as.factor(tabla.comparativa$predicciones)matriz <- confusionMatrix(tabla.comparativa$estado, tabla.comparativa$predicciones)
matriz## Confusion Matrix and Statistics
##
## Reference
## Prediction FELIZ NO FELIZ
## FELIZ 7 2
## NO FELIZ 2 4
##
## Accuracy : 0.7333
## 95% CI : (0.449, 0.9221)
## No Information Rate : 0.6
## P-Value [Acc > NIR] : 0.2173
##
## Kappa : 0.4444
##
## Mcnemar's Test P-Value : 1.0000
##
## Sensitivity : 0.7778
## Specificity : 0.6667
## Pos Pred Value : 0.7778
## Neg Pred Value : 0.6667
## Prevalence : 0.6000
## Detection Rate : 0.4667
## Detection Prevalence : 0.6000
## Balanced Accuracy : 0.7222
##
## 'Positive' Class : FELIZ
## El modelo tiene un valor de accuracy o exactitud aproximadamente del 73% comparado con el algoritmo de regresión logística que fue de un 70% y comparado con el algoritmo de árbol de clasificación que tuvo un valor del 80% este algoritmo de SVM está por encima de uno de ellos en esta métrica.
Este algoritmo resulta ser más eficiente en las predicciones.
Predicciones con datos nuevos
genero = factor('MASCULINO', levels = c("MASCULINO", "FEMENINO"))
esto.civil = factor('SOLTERO', levels = c( "SOLTERO", "CASADO", "DIVORCIADO", "VIUDO"))
edad = 39
satisfaccion.laboral <- 90
satisfaccion.profesional <- 90
vida.familiar <- 80
vida.social <- 90
salud <- factor('REGULAR', levels = c('BUENO', 'MALO', 'REGULAR'))
dinero <- 70
datos.nuevos <- data.frame(genero, esto.civil, edad, satisfaccion.laboral, satisfaccion.profesional, vida.familiar, vida.social, salud, dinero)
datos.nuevos## genero esto.civil edad satisfaccion.laboral satisfaccion.profesional
## 1 MASCULINO SOLTERO 39 90 90
## vida.familiar vida.social salud dinero
## 1 80 90 REGULAR 70PREDICCION <- predict(object = modelo.svm.lineal, datos.nuevos)
PREDICCION## 1
## FELIZ
## Levels: FELIZ NO FELIZModelo SVM polinomial
Estimar el mejor costo para el modelo
El costo tiene que ver con la flexibilidad de los vectores de soporte, esto significa que tan bien clasifica el modelo.
La expresión estado ~ . significa que la variable estado está en función o depende de todas (.) las variables. Algo similar a esto: genero + esto.civil + edad + …. dinero.
La variable ajuste.costo identifica el mejor costo para la construcción del modelo como parámetro.
## set.seed(2022)
ajuste.costo <- tune(svm, estado ~ genero + esto.civil + edad + satisfaccion.laboral + satisfaccion.profesional + vida.familiar + vida.social + salud + dinero, data = datos.entrenamiento,
kernel = "polynomial",
ranges = list(cost = seq(from= 0.01, to=1, by = 0.04)),
scale = TRUE)
summary(ajuste.costo)##
## Parameter tuning of 'svm':
##
## - sampling method: 10-fold cross validation
##
## - best parameters:
## cost
## 0.81
##
## - best performance: 0.3166667
##
## - Detailed performance results:
## cost error dispersion
## 1 0.01 0.3666667 0.3073181
## 2 0.05 0.3666667 0.3073181
## 3 0.09 0.3666667 0.3073181
## 4 0.13 0.3666667 0.3073181
## 5 0.17 0.3666667 0.3073181
## 6 0.21 0.3666667 0.3073181
## 7 0.25 0.3666667 0.3073181
## 8 0.29 0.3666667 0.3073181
## 9 0.33 0.3666667 0.3073181
## 10 0.37 0.3416667 0.3054293
## 11 0.41 0.3416667 0.3054293
## 12 0.45 0.3416667 0.3054293
## 13 0.49 0.3416667 0.3054293
## 14 0.53 0.3416667 0.3054293
## 15 0.57 0.3416667 0.3054293
## 16 0.61 0.3416667 0.3054293
## 17 0.65 0.3416667 0.3054293
## 18 0.69 0.3416667 0.3054293
## 19 0.73 0.3416667 0.3054293
## 20 0.77 0.3416667 0.3054293
## 21 0.81 0.3166667 0.3234650
## 22 0.85 0.3166667 0.3234650
## 23 0.89 0.3166667 0.3234650
## 24 0.93 0.3166667 0.3234650
## 25 0.97 0.3166667 0.3234650Mejor costo
Con la función filter de la librería dplyr se filtra el mejor costo
mejor.costo <- filter(ajuste.costo$performances, error == min(ajuste.costo$performances$error))
mejor.costo <- min(mejor.costo$cost)
mejor.costo## [1] 0.81Graficando el mejor costo
ggplot(data = ajuste.costo$performances, aes(x = cost, y = error)) +
# geom_line() +
geom_point(col='red') +
labs(title = "Error de validación ~ hiperparámetro C") +
# theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
Construir un modelo SVM lineal
modelo.svm.poly <- svm(estado ~ genero + esto.civil + edad + satisfaccion.laboral + satisfaccion.profesional + vida.familiar + vida.social + salud + dinero, data = datos.entrenamiento, kernel = "polynomial", cost = mejor.costo, scale = TRUE)
summary(modelo.svm.poly)##
## Call:
## svm(formula = estado ~ genero + esto.civil + edad + satisfaccion.laboral +
## satisfaccion.profesional + vida.familiar + vida.social + salud +
## dinero, data = datos.entrenamiento, kernel = "polynomial", cost = mejor.costo,
## scale = TRUE)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: polynomial
## cost: 0.81
## degree: 3
## coef.0: 0
##
## Number of Support Vectors: 29
##
## ( 15 14 )
##
##
## Number of Classes: 2
##
## Levels:
## FELIZ NO FELIZHacer predicciones
Las predicciones se hacen con los datos de validación
predicciones <- predict(object = modelo.svm.poly, datos.validacion )
predicciones## 7 12 17 26 27 31 34 35 39 40 43 45 48
## FELIZ FELIZ FELIZ FELIZ FELIZ FELIZ FELIZ FELIZ FELIZ FELIZ FELIZ FELIZ FELIZ
## 49 51
## FELIZ FELIZ
## Levels: FELIZ NO FELIZEvaluar el modelo
El modelo se evalúa utilizando la matriz de confusión con la métrica accuracy = exctitud.
Crear tabla comparativa y convertir a tipo factor las predicciones
tabla.comparativa <- data.frame(datos.validacion, predicciones)
kable(tabla.comparativa[c(1:10, 15),], caption = "Tabla comparativa")| genero | esto.civil | edad | satisfaccion.laboral | satisfaccion.profesional | vida.familiar | vida.social | salud | dinero | estado | estado.01 | genero.12 | esto.civil.14 | salud.13 | predicciones | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 7 | MASCULINO | VIUDO | 56 | 71.5 | 60.8 | 86.9 | 70.6 | MALO | 70.0 | FELIZ | 1 | 1 | 4 | 2 | FELIZ |
| 12 | FEMENINO | VIUDO | 48 | 60.0 | 50.0 | 50.0 | 45.5 | MALO | 70.0 | NO FELIZ | 0 | 2 | 4 | 2 | FELIZ |
| 17 | MASCULINO | CASADO | 48 | 50.0 | 50.0 | 50.0 | 50.0 | BUENO | 49.5 | FELIZ | 1 | 1 | 2 | 1 | FELIZ |
| 26 | FEMENINO | DIVORCIADO | 32 | 80.0 | 70.0 | 40.0 | 40.0 | MALO | 40.0 | NO FELIZ | 0 | 2 | 3 | 2 | FELIZ |
| 27 | MASCULINO | SOLTERO | 36 | 65.0 | 60.0 | 62.0 | 87.0 | REGULAR | 56.5 | FELIZ | 1 | 1 | 1 | 3 | FELIZ |
| 31 | MASCULINO | CASADO | 36 | 85.0 | 80.0 | 90.0 | 50.0 | BUENO | 80.0 | FELIZ | 1 | 1 | 2 | 1 | FELIZ |
| 34 | FEMENINO | SOLTERO | 40 | 60.0 | 80.0 | 40.0 | 50.0 | REGULAR | 30.0 | NO FELIZ | 0 | 2 | 1 | 3 | FELIZ |
| 35 | MASCULINO | CASADO | 40 | 60.0 | 70.0 | 50.0 | 30.0 | BUENO | 50.0 | FELIZ | 1 | 1 | 2 | 1 | FELIZ |
| 39 | FEMENINO | CASADO | 41 | 24.0 | 57.0 | 33.0 | 71.0 | BUENO | 100.0 | NO FELIZ | 0 | 2 | 2 | 1 | FELIZ |
| 40 | FEMENINO | SOLTERO | 40 | 80.0 | 80.0 | 90.0 | 30.0 | REGULAR | 50.0 | FELIZ | 1 | 2 | 1 | 3 | FELIZ |
| 51 | FEMENINO | SOLTERO | 30 | 100.0 | 100.0 | 100.0 | 100.0 | BUENO | 100.0 | NO FELIZ | 0 | 2 | 1 | 1 | FELIZ |
Convertir a tipo factor
tabla.comparativa$predicciones <- as.factor(tabla.comparativa$predicciones)matriz <- confusionMatrix(tabla.comparativa$estado, tabla.comparativa$predicciones)
matriz## Confusion Matrix and Statistics
##
## Reference
## Prediction FELIZ NO FELIZ
## FELIZ 9 0
## NO FELIZ 6 0
##
## Accuracy : 0.6
## 95% CI : (0.3229, 0.8366)
## No Information Rate : 1
## P-Value [Acc > NIR] : 1.00000
##
## Kappa : 0
##
## Mcnemar's Test P-Value : 0.04123
##
## Sensitivity : 0.6
## Specificity : NA
## Pos Pred Value : NA
## Neg Pred Value : NA
## Prevalence : 1.0
## Detection Rate : 0.6
## Detection Prevalence : 0.6
## Balanced Accuracy : NA
##
## 'Positive' Class : FELIZ
## El modelo SVM Polinomial tiene un valor de accuracy o exactitud aproximadamente del 60% comparado con otros modelos de clasificación incluyendo el SVM lineal es menor.
Predicciones con datos nuevos
genero = factor('MASCULINO', levels = c("MASCULINO", "FEMENINO"))
esto.civil = factor('SOLTERO', levels = c( "SOLTERO", "CASADO", "DIVORCIADO", "VIUDO"))
edad = 39
satisfaccion.laboral <- 90
satisfaccion.profesional <- 90
vida.familiar <- 80
vida.social <- 90
salud <- factor('REGULAR', levels = c('BUENO', 'MALO', 'REGULAR'))
dinero <- 70
datos.nuevos <- data.frame(genero, esto.civil, edad, satisfaccion.laboral, satisfaccion.profesional, vida.familiar, vida.social, salud, dinero)
datos.nuevos## genero esto.civil edad satisfaccion.laboral satisfaccion.profesional
## 1 MASCULINO SOLTERO 39 90 90
## vida.familiar vida.social salud dinero
## 1 80 90 REGULAR 70PREDICCION <- predict(object = modelo.svm.poly, datos.nuevos)
PREDICCION## 1
## FELIZ
## Levels: FELIZ NO FELIZSVM Radial
Estimar el mejor costo para el modelo
El costo tiene que ver con la flexibilidad de los vectores de soporte, esto significa que tan bien clasifica el modelo.
La expresión estado ~ . significa que la variable estado está e función o depende de todas (.) las variables. Algo similar a esto: genero + esto.civil + edad + …. dinero.
La variable ajuste.costo identifica el mejor costo para la construcción del modelo como parámetro.
## set.seed(2022)
ajuste.costo <- tune(svm, estado ~ genero + esto.civil + edad + satisfaccion.laboral + satisfaccion.profesional + vida.familiar + vida.social + salud + dinero, data = datos.entrenamiento,
kernel = "radial",
ranges = list(cost = seq(from= 0.01, to=1, by = 0.04)),
scale = TRUE)
summary(ajuste.costo)##
## Parameter tuning of 'svm':
##
## - sampling method: 10-fold cross validation
##
## - best parameters:
## cost
## 0.57
##
## - best performance: 0.1416667
##
## - Detailed performance results:
## cost error dispersion
## 1 0.01 0.3916667 0.2117315
## 2 0.05 0.3916667 0.2117315
## 3 0.09 0.3916667 0.2117315
## 4 0.13 0.3916667 0.2117315
## 5 0.17 0.3916667 0.2117315
## 6 0.21 0.3916667 0.2117315
## 7 0.25 0.3916667 0.2117315
## 8 0.29 0.3916667 0.2117315
## 9 0.33 0.3666667 0.2427975
## 10 0.37 0.3166667 0.2629369
## 11 0.41 0.3166667 0.2629369
## 12 0.45 0.2583333 0.2203042
## 13 0.49 0.2000000 0.1427248
## 14 0.53 0.1666667 0.1469862
## 15 0.57 0.1416667 0.1523985
## 16 0.61 0.1416667 0.1523985
## 17 0.65 0.1416667 0.1523985
## 18 0.69 0.1416667 0.1523985
## 19 0.73 0.1416667 0.1523985
## 20 0.77 0.1416667 0.1523985
## 21 0.81 0.1416667 0.1523985
## 22 0.85 0.1416667 0.1523985
## 23 0.89 0.1416667 0.1523985
## 24 0.93 0.1416667 0.1523985
## 25 0.97 0.1416667 0.1523985Mejor costo
Con la función filter() de la librería dplyr se filtra el mejor costo
mejor.costo <- filter(ajuste.costo$performances, error == min(ajuste.costo$performances$error))
mejor.costo <- min(mejor.costo$cost)
mejor.costo## [1] 0.57Graficando el mejor costo
ggplot(data = ajuste.costo$performances, aes(x = cost, y = error)) +
# geom_line() +
geom_point(col='red') +
labs(title = "Error de validación ~ hiperparámetro C") +
# theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
Construir un modelo SVM lineal
modelo.svm.radial <- svm(estado ~ genero + esto.civil + edad + satisfaccion.laboral + satisfaccion.profesional + vida.familiar + vida.social + salud + dinero, data = datos.entrenamiento, kernel = "radial", cost = mejor.costo, scale = TRUE)
summary(modelo.svm.radial)##
## Call:
## svm(formula = estado ~ genero + esto.civil + edad + satisfaccion.laboral +
## satisfaccion.profesional + vida.familiar + vida.social + salud +
## dinero, data = datos.entrenamiento, kernel = "radial", cost = mejor.costo,
## scale = TRUE)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: radial
## cost: 0.57
##
## Number of Support Vectors: 29
##
## ( 15 14 )
##
##
## Number of Classes: 2
##
## Levels:
## FELIZ NO FELIZHacer predicciones
Las predicciones se hacen con los datos de validación
predicciones <- predict(object = modelo.svm.radial, datos.validacion )
predicciones## 7 12 17 26 27 31 34 35
## FELIZ NO FELIZ NO FELIZ NO FELIZ FELIZ FELIZ NO FELIZ FELIZ
## 39 40 43 45 48 49 51
## FELIZ FELIZ FELIZ FELIZ NO FELIZ FELIZ FELIZ
## Levels: FELIZ NO FELIZEvaluar el modelo
El modelo se evalúa utilizando la matriz de confusión con la métrica accuracy = exactitud.
Crear tabla comparativa y convertir a tipo factor las predicciones
tabla.comparativa <- data.frame(datos.validacion, predicciones)
kable(tabla.comparativa[c(1:10, 15),], caption = "Tabla comparativa")| genero | esto.civil | edad | satisfaccion.laboral | satisfaccion.profesional | vida.familiar | vida.social | salud | dinero | estado | estado.01 | genero.12 | esto.civil.14 | salud.13 | predicciones | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 7 | MASCULINO | VIUDO | 56 | 71.5 | 60.8 | 86.9 | 70.6 | MALO | 70.0 | FELIZ | 1 | 1 | 4 | 2 | FELIZ |
| 12 | FEMENINO | VIUDO | 48 | 60.0 | 50.0 | 50.0 | 45.5 | MALO | 70.0 | NO FELIZ | 0 | 2 | 4 | 2 | NO FELIZ |
| 17 | MASCULINO | CASADO | 48 | 50.0 | 50.0 | 50.0 | 50.0 | BUENO | 49.5 | FELIZ | 1 | 1 | 2 | 1 | NO FELIZ |
| 26 | FEMENINO | DIVORCIADO | 32 | 80.0 | 70.0 | 40.0 | 40.0 | MALO | 40.0 | NO FELIZ | 0 | 2 | 3 | 2 | NO FELIZ |
| 27 | MASCULINO | SOLTERO | 36 | 65.0 | 60.0 | 62.0 | 87.0 | REGULAR | 56.5 | FELIZ | 1 | 1 | 1 | 3 | FELIZ |
| 31 | MASCULINO | CASADO | 36 | 85.0 | 80.0 | 90.0 | 50.0 | BUENO | 80.0 | FELIZ | 1 | 1 | 2 | 1 | FELIZ |
| 34 | FEMENINO | SOLTERO | 40 | 60.0 | 80.0 | 40.0 | 50.0 | REGULAR | 30.0 | NO FELIZ | 0 | 2 | 1 | 3 | NO FELIZ |
| 35 | MASCULINO | CASADO | 40 | 60.0 | 70.0 | 50.0 | 30.0 | BUENO | 50.0 | FELIZ | 1 | 1 | 2 | 1 | FELIZ |
| 39 | FEMENINO | CASADO | 41 | 24.0 | 57.0 | 33.0 | 71.0 | BUENO | 100.0 | NO FELIZ | 0 | 2 | 2 | 1 | FELIZ |
| 40 | FEMENINO | SOLTERO | 40 | 80.0 | 80.0 | 90.0 | 30.0 | REGULAR | 50.0 | FELIZ | 1 | 2 | 1 | 3 | FELIZ |
| 51 | FEMENINO | SOLTERO | 30 | 100.0 | 100.0 | 100.0 | 100.0 | BUENO | 100.0 | NO FELIZ | 0 | 2 | 1 | 1 | FELIZ |
Convertir a tipo factor
tabla.comparativa$predicciones <- as.factor(tabla.comparativa$predicciones)matriz <- confusionMatrix(tabla.comparativa$estado, tabla.comparativa$predicciones)
matriz## Confusion Matrix and Statistics
##
## Reference
## Prediction FELIZ NO FELIZ
## FELIZ 8 1
## NO FELIZ 2 4
##
## Accuracy : 0.8
## 95% CI : (0.5191, 0.9567)
## No Information Rate : 0.6667
## P-Value [Acc > NIR] : 0.2092
##
## Kappa : 0.5714
##
## Mcnemar's Test P-Value : 1.0000
##
## Sensitivity : 0.8000
## Specificity : 0.8000
## Pos Pred Value : 0.8889
## Neg Pred Value : 0.6667
## Prevalence : 0.6667
## Detection Rate : 0.5333
## Detection Prevalence : 0.6000
## Balanced Accuracy : 0.8000
##
## 'Positive' Class : FELIZ
## El modelo SVM Radial tiene un valor de accuracy o exactitud aproximadamente del 86% comparado con otros modelos de clasificación incluyendo otros SVM lineal es mucho mejor.
Predicciones con datos nuevos
genero = factor('MASCULINO', levels = c("MASCULINO", "FEMENINO"))
esto.civil = factor('SOLTERO', levels = c( "SOLTERO", "CASADO", "DIVORCIADO", "VIUDO"))
edad = 39
satisfaccion.laboral <- 90
satisfaccion.profesional <- 90
vida.familiar <- 80
vida.social <- 90
salud <- factor('REGULAR', levels = c('BUENO', 'MALO', 'REGULAR'))
dinero <- 70
datos.nuevos <- data.frame(genero, esto.civil, edad, satisfaccion.laboral, satisfaccion.profesional, vida.familiar, vida.social, salud, dinero)
datos.nuevos## genero esto.civil edad satisfaccion.laboral satisfaccion.profesional
## 1 MASCULINO SOLTERO 39 90 90
## vida.familiar vida.social salud dinero
## 1 80 90 REGULAR 70PREDICCION <- predict(object = modelo.svm.poly, datos.nuevos)
PREDICCION## 1
## FELIZ
## Levels: FELIZ NO FELIZBibliografía
Pizarro, Rubén. 2020. “Support Vector Machine (SVM). Análisis de Regresión Caso Bebidas.” https://rpubs.com/rpizarro/605730.