Practica 13
16040461
12/5/2020
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
#VERGARA HERNANDEZ JESUS ALEJANDRO
#NUMERO CONTROL: 16040461
#PRACTICA 13
#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. https://www.cienciadedatos.net/documentos/34_maquinas_de_vector_soporte_support_vector_machines
#Las Máquinas Soporte Vectorial (SVM, del inglés Support Vector Machines) tienen su origen en los trabajos sobre la teoría del aprendizaje estadístico, inicialmente, las SVM fueron pensadas para aclarar y resolver problemas de clasificación binaria, su aplicación se ha extendido a problemas de clasificación múltiple y regresión. (Castañeda, 2019).
#En un espacio p-dimensional, un hiperplano se define como un subespacio plano y afín de dimensiones p−1. El término afín significa que el subespacio no tiene por qué pasar por el origen. En un espacio de dos dimensiones, el hiperplano es un subespacio de 1 dimensión, es decir, una recta.
#SVM también puede utilizarse como un método de regresión (support vector regression o SVR). SVR sigue los mismos principios que el SVM para clasificación, con alguna diferencia en cuanto al algoritmo (se establece un margen de tolerancia para las predicciones, épsilon).
#La esencia de las SVM puede ser entendida sin el uso de fórmulas, para lo cual es necesario el conocimiento de cuatro conceptos básicos: el hiperplano de separación, el hiperplano óptimo, el margen suave y la función kernel o núcleo. (Cuevas, Alvares, Azcona, & Rodríguez, 2019)
#Hiperplano de separación: Las SVM poseen una gran capacidad para aprender a partir de un conjunto de N muestras experimentales denominado conjunto de entrenamiento: (x1,y1),(x2,y2),…,(xn,ym). Donde cada muestra (xi,yi) para i=1…N está formado por un vector de n características xiϵRn y a una etiqueta yiϵR que indica la clase ±1 a la que pertenece cada muestra.
#El objetivo es encontrar la función f:Rn→±1 que separe los datos en dos clases y que clasifique o pronostique correctamente nuevas muestras perteneciente al conjunto de pruebas o de validación.
#En un problema linealmente separable existen muchos hiperplanos que pueden clasificar los datos, pero las SVM no hayan uno cualquiera sino el único que maximiza la distancia entre el y el dato más cercano de cada clase. Imagen hiperplano de
#El hiperplano de separación óptimo (HSO) y margen máximo: Está definido por el margen máximo de separación entre las dos clases.
#Tomando como referencia la notación de la figura del hiperplano de separación, existen dos hiperplanos que definen las muestras a ambos lados de cada clase:
#El margen máximo está dado por la distancia entre los hiperplanos paralelos y el HSO, cuyo resultado geométrico equivale a 2/||w||.
#El vector de pesos w contiene la *ponderación de cada atributo, indicando qué tanto aportan en el proceso de clasificación o regresión.
#Hallar el mejor hiperplano de separación es la esencia del problema de maximización con restricciones lineales.
#La expresión final del clasificador buscado finalmente sería donde el signo resultante indicará la clase a la cual pertenece un dato determinado.
#Margen suave: Cuando los datos de prueba no son linealmente separables se pueden adoptar dos técnicas para resolver el problema: con optimización “margen suave” y a través de kernel.
#El proceso de optimización del hiperplano en este caso incorpora un parámetro de regularización o tuning parameter C, el cual controla la severidad permitida de las violaciones de las n observaciones sobre el margen e hiperplano, y a la vez, el equilibrio bias-varianza. Sin entrar en detalles matemáticos, si C>0, no más de C observaciones pueden encontrarse en el lado incorrecto del hiperplano. Si C es pequeño, los márgenes serán estrechos pues muy pocas observaciones podrán estar en el lado incorrecto del mismo (esto equivale a un modelo bastante bien ajustado a los datos, el cual puede tener poco bias pero mucha varianza). Conforme se incrementa C, mayor es la toleración a las violaciones sobre el margen, con lo que el margen será más ancho y habrá más vectores soporte (esto equivale a un modelo más flexible y con mayor bias pero menor varianza). Si C=0, el clasificador es equivalente al maximal margin classifier, pues no están permitidas violaciones sobre el margen (todas las observaciones deben estar correctamente clasificadas). En la práctica el parámetro C se escoge u optimiza por validación cruzada.
#SVM no lineales con Kernel: La mayoría de los eventos reales no son separables linealmente por lo que se dificulta la definición del HSO. La figura 2 muestra un conjunto de datos donde no pueden ser separados linealmente por un hiperplano en Rn, pero si en un espacio de mayor dimensión Rh Imagen hiperplano lineal no lineal.Mapeo de datos a una mayor dimensión y separación lineal de las clases en el nuevo espacio.
#Cuando no existe una apropiada superficie lineal de decisión en el espacio original de los datos, se considera un mapeo del vector de entrada en un espacio de mayor dimensión Rh llamado espacio de características, que está dotado de producto escalar.
#Eligiendo la transformación adecuada Rn→Rh se realiza el mapeo y se busca el HSO siguiendo lo dicho anteriormente del apartado anterior que será lineal en Rh, pero representa un espacio no lineal en Rn
#Este tipo de proyección hacia un espacio de característica es a través de las funciones denominadas kernels: K(xi,xk)=ᶲ(xi)∗ᶲ(xk).
#Las funciones kernel permiten realizar las operaciones algebraicas en Rh de manera eficiente y sin conocer a la transformación ᶲ. Así, en principio cualquier técnica de análisis multivariado para datos xϵRn que se pueda reformular en un algoritmo computacional en términos de productos escalares, se puede generalizar a los datos transformados utilizando las funciones núcleos.
#Existen varias funciones kernel o núcleos, destacando las siguientes cuatro, consideradas básicas:
#Kernel lineal: K(xi,xj)=xiT∗xj
#Kernel polinomial: K(xi,xj)=(p+ΥxiT∗xj)d,Υ>0
#Kernel gaussiano RBF: K(xi,xj)=exp(−Υ||xi−xj||2),Υ>0
#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.
#CASO SVM BEBIDAS
#Para este ejemplo de clasificación se utiliza el conjunto de datos OJ, del paquete ISLR. Contiene información sobre compra de dos tipos de bebida (Citrus Hill y Minute Maid Orange Juice) por parte de 1070 clientes (las variables registran distintas características del cliente y el producto). Se generan modelos basados en SVM con tres tipos de kernel: lineal, polinómico y radial, que predigan qué tipo de bebida (Purchase) compra el consumidor, en función del conjunto de predictores.
#LAS LIBRERIAS
#Recordar que se quitan los message y warning con los parámetros y atributos {r message=FALSE, warning=FALSE}
# install.packages("ISLR")
library(ISLR)## Warning: package 'ISLR' was built under R version 3.6.3library(knitr) # Para ver tablas mas amigables en formato html markdown
library(ggplot2) # Gráficas## Warning: package 'ggplot2' was built under R version 3.6.3library(dplyr) # Varias operaciones ## Warning: package 'dplyr' was built under R version 3.6.3##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(caret) # Para particionar datos. De entranamiento y de validación## Warning: package 'caret' was built under R version 3.6.3## Loading required package: lattice#install.packages("e1071") # Para SVM
library(e1071)## Warning: package 'e1071' was built under R version 3.6.3#LOS DATOS
#*Se muestran la estructura de los datos con la función str().
#*Se muestran los estadísticos con summary(datos)
#*Se visualizan los primeros seis registros.
#*Se visualizan los últimos seis registros.
#*La variable independiente o variable de respuesta es la variable Purchase del conjunto de datos.
#*La variable Purchase es de tipo factor, lo cual es requisito para aplicar SVM.
#*CH = Citrus Hill y
#*MM = Minute Maid Orange Juice
datos <- OJ
str(datos)## 'data.frame': 1070 obs. of 18 variables:
## $ Purchase : Factor w/ 2 levels "CH","MM": 1 1 1 2 1 1 1 1 1 1 ...
## $ WeekofPurchase: num 237 239 245 227 228 230 232 234 235 238 ...
## $ StoreID : num 1 1 1 1 7 7 7 7 7 7 ...
## $ PriceCH : num 1.75 1.75 1.86 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
## $ PriceMM : num 1.99 1.99 2.09 1.69 1.69 1.99 1.99 1.99 1.99 1.99 ...
## $ DiscCH : num 0 0 0.17 0 0 0 0 0 0 0 ...
## $ DiscMM : num 0 0.3 0 0 0 0 0.4 0.4 0.4 0.4 ...
## $ SpecialCH : num 0 0 0 0 0 0 1 1 0 0 ...
## $ SpecialMM : num 0 1 0 0 0 1 1 0 0 0 ...
## $ LoyalCH : num 0.5 0.6 0.68 0.4 0.957 ...
## $ SalePriceMM : num 1.99 1.69 2.09 1.69 1.69 1.99 1.59 1.59 1.59 1.59 ...
## $ SalePriceCH : num 1.75 1.75 1.69 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
## $ PriceDiff : num 0.24 -0.06 0.4 0 0 0.3 -0.1 -0.16 -0.16 -0.16 ...
## $ Store7 : Factor w/ 2 levels "No","Yes": 1 1 1 1 2 2 2 2 2 2 ...
## $ PctDiscMM : num 0 0.151 0 0 0 ...
## $ PctDiscCH : num 0 0 0.0914 0 0 ...
## $ ListPriceDiff : num 0.24 0.24 0.23 0 0 0.3 0.3 0.24 0.24 0.24 ...
## $ STORE : num 1 1 1 1 0 0 0 0 0 0 ...kable(summary(datos))| Purchase | WeekofPurchase | StoreID | PriceCH | PriceMM | DiscCH | DiscMM | SpecialCH | SpecialMM | LoyalCH | SalePriceMM | SalePriceCH | PriceDiff | Store7 | PctDiscMM | PctDiscCH | ListPriceDiff | STORE | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| CH:653 | Min. :227.0 | Min. :1.00 | Min. :1.690 | Min. :1.690 | Min. :0.00000 | Min. :0.0000 | Min. :0.0000 | Min. :0.0000 | Min. :0.000011 | Min. :1.190 | Min. :1.390 | Min. :-0.6700 | No :714 | Min. :0.0000 | Min. :0.00000 | Min. :0.000 | Min. :0.000 | |
| MM:417 | 1st Qu.:240.0 | 1st Qu.:2.00 | 1st Qu.:1.790 | 1st Qu.:1.990 | 1st Qu.:0.00000 | 1st Qu.:0.0000 | 1st Qu.:0.0000 | 1st Qu.:0.0000 | 1st Qu.:0.325257 | 1st Qu.:1.690 | 1st Qu.:1.750 | 1st Qu.: 0.0000 | Yes:356 | 1st Qu.:0.0000 | 1st Qu.:0.00000 | 1st Qu.:0.140 | 1st Qu.:0.000 | |
| NA | Median :257.0 | Median :3.00 | Median :1.860 | Median :2.090 | Median :0.00000 | Median :0.0000 | Median :0.0000 | Median :0.0000 | Median :0.600000 | Median :2.090 | Median :1.860 | Median : 0.2300 | NA | Median :0.0000 | Median :0.00000 | Median :0.240 | Median :2.000 | |
| NA | Mean :254.4 | Mean :3.96 | Mean :1.867 | Mean :2.085 | Mean :0.05186 | Mean :0.1234 | Mean :0.1477 | Mean :0.1617 | Mean :0.565782 | Mean :1.962 | Mean :1.816 | Mean : 0.1465 | NA | Mean :0.0593 | Mean :0.02731 | Mean :0.218 | Mean :1.631 | |
| NA | 3rd Qu.:268.0 | 3rd Qu.:7.00 | 3rd Qu.:1.990 | 3rd Qu.:2.180 | 3rd Qu.:0.00000 | 3rd Qu.:0.2300 | 3rd Qu.:0.0000 | 3rd Qu.:0.0000 | 3rd Qu.:0.850873 | 3rd Qu.:2.130 | 3rd Qu.:1.890 | 3rd Qu.: 0.3200 | NA | 3rd Qu.:0.1127 | 3rd Qu.:0.00000 | 3rd Qu.:0.300 | 3rd Qu.:3.000 | |
| NA | Max. :278.0 | Max. :7.00 | Max. :2.090 | Max. :2.290 | Max. :0.50000 | Max. :0.8000 | Max. :1.0000 | Max. :1.0000 | Max. :0.999947 | Max. :2.290 | Max. :2.090 | Max. : 0.6400 | NA | Max. :0.4020 | Max. :0.25269 | Max. :0.440 | Max. :4.000 |
#2.3. Distribución de la variable de respuesta Purchase - En función del tipo de refresco CH y MM
ggplot(data = OJ, aes(x = Purchase, y = ..count.., fill = Purchase)) +
geom_bar() +
labs(title = "Distribución de 'Purchase'") +
scale_fill_manual(values = c("darkgreen", "orangered2"),
labels = c("Citrus Hill", "Orange Juice")) +
theme_bw() + theme(plot.title = element_text(hjust = 0.5))
#PORCENTAJES DE LA VARIABLE RESPUESTA
#*prop.table(): Determina la frecuencia relativa.
#*%>% : es un pipe que significa que el resutlado de la primeara expresión es la entrada de la segunda expresión.
#*round(): redondea
frecuencias <- prop.table(table(datos$Purchase)) %>%
round(digits = 2)
frecuencias##
## CH MM
## 0.61 0.39#El 61 % de las preferencias de los clientes es para el refresco “CM” CH = Citrus Hill
#El 39 % de las preferencias de los clientes es para el refresco “CM” MM = Minute Maid Orange Juice ### 2.5. Datos de entrenamiento y validación Se dividen el conjunto de datos en un grupo de entrenamiento (para el ajuste de los modelos) y otro de test (para la evaluación o datos de validación de los mismos).
#Esta división dependerá de la cantidad de observaciones con las que e tenga y la seguridad con la que se quiera obtener la estimación del test error.
#En este ejemplo se opta por una división 80%-20%. * Se establece una semilla de inicio 123 * Se genera aleatoriamente una vriable entrena con el 80% de los registros para datos de entrenamiento * Los registros que no son de entranamiento serán para dtos de validación
set.seed(123)
entrena <- createDataPartition(y = datos$Purchase, p = 0.8, list = FALSE, times = 1)
# Datos entrenamiento
datos.entrenamiento <- datos[entrena, ]
# Datos validación
datos.validacion <- datos[-entrena, ]
#VERIFICAR LOS DATOS DE ENTRENAMIENTO Y VALIDACION
#Primero se muestran los head() y tail() (primeros y últimos registros) de los datos
#Se tienen 1070 observaciones de los datos
kable(head(datos))| Purchase | WeekofPurchase | StoreID | PriceCH | PriceMM | DiscCH | DiscMM | SpecialCH | SpecialMM | LoyalCH | SalePriceMM | SalePriceCH | PriceDiff | Store7 | PctDiscMM | PctDiscCH | ListPriceDiff | STORE |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| CH | 237 | 1 | 1.75 | 1.99 | 0.00 | 0.0 | 0 | 0 | 0.500000 | 1.99 | 1.75 | 0.24 | No | 0.000000 | 0.000000 | 0.24 | 1 |
| CH | 239 | 1 | 1.75 | 1.99 | 0.00 | 0.3 | 0 | 1 | 0.600000 | 1.69 | 1.75 | -0.06 | No | 0.150754 | 0.000000 | 0.24 | 1 |
| CH | 245 | 1 | 1.86 | 2.09 | 0.17 | 0.0 | 0 | 0 | 0.680000 | 2.09 | 1.69 | 0.40 | No | 0.000000 | 0.091398 | 0.23 | 1 |
| MM | 227 | 1 | 1.69 | 1.69 | 0.00 | 0.0 | 0 | 0 | 0.400000 | 1.69 | 1.69 | 0.00 | No | 0.000000 | 0.000000 | 0.00 | 1 |
| CH | 228 | 7 | 1.69 | 1.69 | 0.00 | 0.0 | 0 | 0 | 0.956535 | 1.69 | 1.69 | 0.00 | Yes | 0.000000 | 0.000000 | 0.00 | 0 |
| CH | 230 | 7 | 1.69 | 1.99 | 0.00 | 0.0 | 0 | 1 | 0.965228 | 1.99 | 1.69 | 0.30 | Yes | 0.000000 | 0.000000 | 0.30 | 0 |
kable(tail(datos))| Purchase | WeekofPurchase | StoreID | PriceCH | PriceMM | DiscCH | DiscMM | SpecialCH | SpecialMM | LoyalCH | SalePriceMM | SalePriceCH | PriceDiff | Store7 | PctDiscMM | PctDiscCH | ListPriceDiff | STORE | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1065 | CH | 251 | 7 | 1.86 | 2.09 | 0.1 | 0.00 | 0 | 0 | 0.484778 | 2.09 | 1.76 | 0.33 | Yes | 0.000000 | 0.053763 | 0.23 | 0 |
| 1066 | CH | 252 | 7 | 1.86 | 2.09 | 0.1 | 0.00 | 0 | 0 | 0.587822 | 2.09 | 1.76 | 0.33 | Yes | 0.000000 | 0.053763 | 0.23 | 0 |
| 1067 | CH | 256 | 7 | 1.86 | 2.18 | 0.0 | 0.00 | 0 | 0 | 0.670258 | 2.18 | 1.86 | 0.32 | Yes | 0.000000 | 0.000000 | 0.32 | 0 |
| 1068 | MM | 257 | 7 | 1.86 | 2.18 | 0.0 | 0.00 | 0 | 0 | 0.736206 | 2.18 | 1.86 | 0.32 | Yes | 0.000000 | 0.000000 | 0.32 | 0 |
| 1069 | CH | 261 | 7 | 1.86 | 2.13 | 0.0 | 0.24 | 0 | 0 | 0.588965 | 1.89 | 1.86 | 0.03 | Yes | 0.112676 | 0.000000 | 0.27 | 0 |
| 1070 | CH | 270 | 1 | 1.86 | 2.18 | 0.0 | 0.00 | 0 | 0 | 0.671172 | 2.18 | 1.86 | 0.32 | No | 0.000000 | 0.000000 | 0.32 | 1 |
kable(head(datos.entrenamiento))| Purchase | WeekofPurchase | StoreID | PriceCH | PriceMM | DiscCH | DiscMM | SpecialCH | SpecialMM | LoyalCH | SalePriceMM | SalePriceCH | PriceDiff | Store7 | PctDiscMM | PctDiscCH | ListPriceDiff | STORE | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2 | CH | 239 | 1 | 1.75 | 1.99 | 0 | 0.3 | 0 | 1 | 0.600000 | 1.69 | 1.75 | -0.06 | No | 0.150754 | 0 | 0.24 | 1 |
| 4 | MM | 227 | 1 | 1.69 | 1.69 | 0 | 0.0 | 0 | 0 | 0.400000 | 1.69 | 1.69 | 0.00 | No | 0.000000 | 0 | 0.00 | 1 |
| 5 | CH | 228 | 7 | 1.69 | 1.69 | 0 | 0.0 | 0 | 0 | 0.956535 | 1.69 | 1.69 | 0.00 | Yes | 0.000000 | 0 | 0.00 | 0 |
| 6 | CH | 230 | 7 | 1.69 | 1.99 | 0 | 0.0 | 0 | 1 | 0.965228 | 1.99 | 1.69 | 0.30 | Yes | 0.000000 | 0 | 0.30 | 0 |
| 7 | CH | 232 | 7 | 1.69 | 1.99 | 0 | 0.4 | 1 | 1 | 0.972182 | 1.59 | 1.69 | -0.10 | Yes | 0.201005 | 0 | 0.30 | 0 |
| 8 | CH | 234 | 7 | 1.75 | 1.99 | 0 | 0.4 | 1 | 0 | 0.977746 | 1.59 | 1.75 | -0.16 | Yes | 0.201005 | 0 | 0.24 | 0 |
kable(tail(datos.entrenamiento))| Purchase | WeekofPurchase | StoreID | PriceCH | PriceMM | DiscCH | DiscMM | SpecialCH | SpecialMM | LoyalCH | SalePriceMM | SalePriceCH | PriceDiff | Store7 | PctDiscMM | PctDiscCH | ListPriceDiff | STORE | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1065 | CH | 251 | 7 | 1.86 | 2.09 | 0.1 | 0.00 | 0 | 0 | 0.484778 | 2.09 | 1.76 | 0.33 | Yes | 0.000000 | 0.053763 | 0.23 | 0 |
| 1066 | CH | 252 | 7 | 1.86 | 2.09 | 0.1 | 0.00 | 0 | 0 | 0.587822 | 2.09 | 1.76 | 0.33 | Yes | 0.000000 | 0.053763 | 0.23 | 0 |
| 1067 | CH | 256 | 7 | 1.86 | 2.18 | 0.0 | 0.00 | 0 | 0 | 0.670258 | 2.18 | 1.86 | 0.32 | Yes | 0.000000 | 0.000000 | 0.32 | 0 |
| 1068 | MM | 257 | 7 | 1.86 | 2.18 | 0.0 | 0.00 | 0 | 0 | 0.736206 | 2.18 | 1.86 | 0.32 | Yes | 0.000000 | 0.000000 | 0.32 | 0 |
| 1069 | CH | 261 | 7 | 1.86 | 2.13 | 0.0 | 0.24 | 0 | 0 | 0.588965 | 1.89 | 1.86 | 0.03 | Yes | 0.112676 | 0.000000 | 0.27 | 0 |
| 1070 | CH | 270 | 1 | 1.86 | 2.18 | 0.0 | 0.00 | 0 | 0 | 0.671172 | 2.18 | 1.86 | 0.32 | No | 0.000000 | 0.000000 | 0.32 | 1 |
#Tercero los head() y tail() (primeros y últimos registros) de los datos de validación.
#Se tienen 213 observaciones de los datos de validación.
kable(head(datos.validacion))| Purchase | WeekofPurchase | StoreID | PriceCH | PriceMM | DiscCH | DiscMM | SpecialCH | SpecialMM | LoyalCH | SalePriceMM | SalePriceCH | PriceDiff | Store7 | PctDiscMM | PctDiscCH | ListPriceDiff | STORE | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | CH | 237 | 1 | 1.75 | 1.99 | 0.00 | 0.0 | 0 | 0 | 0.500000 | 1.99 | 1.75 | 0.24 | No | 0.000000 | 0.000000 | 0.24 | 1 |
| 3 | CH | 245 | 1 | 1.86 | 2.09 | 0.17 | 0.0 | 0 | 0 | 0.680000 | 2.09 | 1.69 | 0.40 | No | 0.000000 | 0.091398 | 0.23 | 1 |
| 10 | CH | 238 | 7 | 1.75 | 1.99 | 0.00 | 0.4 | 0 | 0 | 0.985757 | 1.59 | 1.75 | -0.16 | Yes | 0.201005 | 0.000000 | 0.24 | 0 |
| 16 | CH | 278 | 7 | 2.06 | 2.13 | 0.00 | 0.0 | 0 | 0 | 0.795200 | 2.13 | 2.06 | 0.07 | Yes | 0.000000 | 0.000000 | 0.07 | 0 |
| 18 | MM | 268 | 2 | 1.86 | 2.18 | 0.00 | 0.0 | 0 | 1 | 0.400000 | 2.18 | 1.86 | 0.32 | No | 0.000000 | 0.000000 | 0.32 | 2 |
| 22 | CH | 258 | 1 | 1.76 | 2.18 | 0.00 | 0.0 | 0 | 0 | 0.680000 | 2.18 | 1.76 | 0.42 | No | 0.000000 | 0.000000 | 0.42 | 1 |
kable(tail(datos.validacion))| Purchase | WeekofPurchase | StoreID | PriceCH | PriceMM | DiscCH | DiscMM | SpecialCH | SpecialMM | LoyalCH | SalePriceMM | SalePriceCH | PriceDiff | Store7 | PctDiscMM | PctDiscCH | ListPriceDiff | STORE | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1040 | CH | 237 | 7 | 1.75 | 1.99 | 0 | 0.4 | 0 | 0 | 0.320000 | 1.59 | 1.75 | -0.16 | Yes | 0.201005 | 0 | 0.24 | 0 |
| 1043 | CH | 239 | 1 | 1.75 | 1.99 | 0 | 0.3 | 0 | 1 | 0.651840 | 1.69 | 1.75 | -0.06 | No | 0.150754 | 0 | 0.24 | 1 |
| 1053 | CH | 237 | 7 | 1.75 | 1.99 | 0 | 0.4 | 0 | 0 | 0.740928 | 1.59 | 1.75 | -0.16 | Yes | 0.201005 | 0 | 0.24 | 0 |
| 1056 | MM | 227 | 1 | 1.69 | 1.69 | 0 | 0.0 | 0 | 0 | 0.320000 | 1.69 | 1.69 | 0.00 | No | 0.000000 | 0 | 0.00 | 1 |
| 1057 | CH | 228 | 7 | 1.69 | 1.69 | 0 | 0.0 | 0 | 0 | 0.256000 | 1.69 | 1.69 | 0.00 | Yes | 0.000000 | 0 | 0.00 | 0 |
| 1059 | CH | 233 | 7 | 1.75 | 1.99 | 0 | 0.4 | 1 | 0 | 0.523840 | 1.59 | 1.75 | -0.16 | Yes | 0.201005 | 0 | 0.24 | 0 |
#A la hora de ajustar un support vector classifier, es importante tener en cuenta que el hiperparámetro C (cost) controla el equilibrio bias-varianza y la capacidad predictiva del modelo, ya que determina la severidad permitida respecto a las violaciones sobre el margen.
#En otras palabras, se necesita fijar un margen de separación entre observaciones a priori. Por ello es recomendable evaluar distintos valores del mismo mediante validación cruzada y escoger el valor óptimo.
#IMPORTANTE: Estandarizar los predictores cuando no estén medidos en la misma escala, para que los de mayor magnitud no tengan mayor influencia que el resto. Un argumento disponible en la función svm() para ello es scale = TRUE).
#Para ajustar un support vector classifier, el kernel indicado en la función svm() ha de ser lineal. Se obtiene un valor de coste óptimo mediante validación cruzada utilizando la función tune() del paquete e1071.
#OPTIMIZACION DE HIPERPARAMETROS MEDIANTE VALIDACION CRUZADA 10-FOLD
set.seed(325)
tuning <- tune(svm, Purchase ~ ., data = datos.entrenamiento,
kernel = "linear",
ranges = list(cost = c(0.001, 0.01, 0.1, 1, 5, 10, 15, 20)),
scale = TRUE)
#RESUMEN DE LA VALIDACION CRUZADA DE TUNING
#El valor de coste que resulta en el menor error de validación (0,165) es 15.
summary(tuning)##
## Parameter tuning of 'svm':
##
## - sampling method: 10-fold cross validation
##
## - best parameters:
## cost
## 15
##
## - best performance: 0.1656772
##
## - Detailed performance results:
## cost error dispersion
## 1 0.001 0.3009850 0.05276636
## 2 0.010 0.1691382 0.04602764
## 3 0.100 0.1679754 0.04037149
## 4 1.000 0.1703010 0.04099747
## 5 5.000 0.1703010 0.03755497
## 6 10.000 0.1668263 0.03560699
## 7 15.000 0.1656772 0.03338668
## 8 20.000 0.1668399 0.03479758names(tuning)## [1] "best.parameters" "best.performance" "method" "nparcomb"
## [5] "train.ind" "sampling" "performances" "best.model"#Graficando los costos de tuning
ggplot(data = tuning$performances, aes(x = cost, y = error)) +
geom_line() +
geom_point() +
labs(title = "Error de validación ~ hiperparámetro C") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
#Modelo óptimo obtenido
#El tuning se utilizo para encontrar el mejor costo para el modelo de SVM
#El tuning fué el proceso de optimización del hiperplano para encontar el mejor costo C
modelo <- tuning$best.model
summary(modelo)##
## Call:
## best.tune(method = svm, train.x = Purchase ~ ., data = datos.entrenamiento,
## ranges = list(cost = c(0.001, 0.01, 0.1, 1, 5, 10, 15, 20)),
## kernel = "linear", scale = TRUE)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: linear
## cost: 15
##
## Number of Support Vectors: 345
##
## ( 173 172 )
##
##
## Number of Classes: 2
##
## Levels:
## CH MM#Modelo lineal (linear) SVM igual que óptimo obtenido
#El modelo.lin da lo mismo que modelo
#Se verifica con summary(modelo.lin)
modelo.lin <- svm(Purchase ~ ., data = datos.entrenamiento, kernel = "linear", cost = 15, scale = TRUE)
summary(modelo.lin)##
## Call:
## svm(formula = Purchase ~ ., data = datos.entrenamiento, kernel = "linear",
## cost = 15, scale = TRUE)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: linear
## cost: 15
##
## Number of Support Vectors: 345
##
## ( 173 172 )
##
##
## Number of Classes: 2
##
## Levels:
## CH MM#Realizar predicciones
#Se utilzia el conjunto de datos de entrenamiento
#Se puede usar modelo o modelo.SVM ya que es el mismo
prediccion <- predict(modelo, datos.validacion)
#Mostrar las predicciones
#Las primeras y últimas diez de registro del conjunto de validación
kable(head(prediccion, 10))| x | |
|---|---|
| 1 | CH |
| 3 | CH |
| 10 | CH |
| 16 | CH |
| 18 | CH |
| 22 | CH |
| 26 | CH |
| 41 | CH |
| 45 | CH |
| 49 | CH |
kable(tail(prediccion, 10))| x | |
|---|---|
| 1011 | CH |
| 1014 | CH |
| 1020 | CH |
| 1039 | MM |
| 1040 | MM |
| 1043 | CH |
| 1053 | CH |
| 1056 | MM |
| 1057 | MM |
| 1059 | CH |
length(prediccion)## [1] 213nrow(datos.validacion)## [1] 213#Generar matriz de confusión de la predicción
mat.confusion <- table(predicho = prediccion, real = datos.validacion$Purchase)
mat.confusion## real
## predicho CH MM
## CH 108 17
## MM 22 66#De acuerdo a la métrica Accuracy que son la relación de los aciertos con respecto al total de observaciones.
#La Exactitud ( en inglés, “Accuracy”) se refiere a lo cerca que está el resultado de una medición del valor verdadero.
#En términos estadísticos, la exactitud está relacionada con el sesgo de una estimación. También se conoce como Verdadero Positivo (o “True positive rate”). Se representa por la proporción entre los positivos reales predichos por el algoritmo y todos los casos positivos. OJO: en inglés en ocasiones se usa el término “precision” para la exactitud y el término español precisión ser refiere a “accuracy”. Lo que puede llevar a confusión.
#En forma práctica la Exactitud es la cantidad de predicciones positivas que fueron correctas
#VP Verdaderos Positivos: es la cantidad de positivos que fueron acertados correctamente como positivos por el modelo.
#VN Verdaderos Negativos: es la cantidad de negativos que fueron acertados correctamente como negativos por el modelo.
#FN Falsos Negativos: es la cantidad de positivos que fueron clasificados incorrectamente como negativos. Error tipo 2 (Falsos Negativos)
#FP Falsos Positivos: es la cantidad de negativos que fueron clasificados incorrectamente como positivos. Error tipo 1 (Falsos positivos)
#VP+VN Son los casos.acertados
#VP+FN+FP+VN son todos.los.casos
#casos.acertados/todos.los.casos
#exactitud=(VP+VN)/(VP+FN+FP+VN)
#En R: round((mat.confusion[1,1]+mat.confusion[2,2])/nrow(datos.validacion)∗100,4)
#Se utilizó el modelo de SVM con kernel tipo lineal con costo igual a 15
#El modelo acierta en 174 de un total de 213
#Representa el 81.6901 % en términos de exactitud estadística.
#Gráfica de los valores reales Vs predichos
ggplot(datos.validacion, aes(x = SalePriceCH, y = PriceCH)) +
geom_point(aes(colour = factor(prediccion)))
ggplot(datos.validacion, aes(x = SalePriceMM, y = PriceMM)) +
geom_point(aes(colour = factor(prediccion)))
#Generar modelo SVM Polinomial (polynomial)
#Se utiliza el mismo costo de 15
#Se modifica el kernel a polynomial
#Se puede generar polinomio de segundo, tercer grado secesivamente….
modelo.pol <- svm(Purchase ~ ., data = datos.entrenamiento, kernel = "polynomial", cost = 15, scale = TRUE)
summary(modelo.pol)##
## Call:
## svm(formula = Purchase ~ ., data = datos.entrenamiento, kernel = "polynomial",
## cost = 15, scale = TRUE)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: polynomial
## cost: 15
## degree: 3
## coef.0: 0
##
## Number of Support Vectors: 342
##
## ( 177 165 )
##
##
## Number of Classes: 2
##
## Levels:
## CH MM# Realizar predicciones
#Se utiliza el conjunto de datos de entrenamiento
#Se usa el modelo.pol
prediccion <- predict(modelo.pol, datos.validacion)
#Mostrar las predicciones
#Las primeras y últimas diez de registro del conjunto de validación
kable(head(prediccion, 10))| x | |
|---|---|
| 1 | CH |
| 3 | CH |
| 10 | CH |
| 16 | CH |
| 18 | CH |
| 22 | CH |
| 26 | CH |
| 41 | CH |
| 45 | CH |
| 49 | CH |
kable(tail(prediccion, 10))| x | |
|---|---|
| 1011 | CH |
| 1014 | CH |
| 1020 | CH |
| 1039 | MM |
| 1040 | MM |
| 1043 | CH |
| 1053 | CH |
| 1056 | MM |
| 1057 | CH |
| 1059 | MM |
length(prediccion)## [1] 213nrow(datos.validacion)## [1] 213#Generar matriz de confusión de la predicción
mat.confusion <- table(predicho = prediccion, real = datos.validacion$Purchase)
mat.confusion## real
## predicho CH MM
## CH 108 23
## MM 22 60#Se utilizó el modelo de SVM con kernel tipo polinomial con costo igual a 15.
#El modelo acierta en 168 de un total de 213
#Representa el 78.8732 % en términos de exactitud estadística.
#Gráfica de los valores reales Vs predichos
#Se grafica el precio de venta y el precio de las bebidas CH.
ggplot(datos.validacion, aes(x = SalePriceCH, y = PriceCH)) +
geom_point(aes(colour = factor(prediccion)))
ggplot(datos.validacion, aes(x = SalePriceMM, y = PriceMM)) +
geom_point(aes(colour = factor(prediccion)))
#Generar modelo SVM radial (radial)
#Se utiliza el mismo costo de 15
#Se modifica el kernel a radial
modelo.rad <- svm(Purchase ~ ., data = datos.entrenamiento, kernel = "radial", cost = 15, scale = TRUE)
summary(modelo.rad)##
## Call:
## svm(formula = Purchase ~ ., data = datos.entrenamiento, kernel = "radial",
## cost = 15, scale = TRUE)
##
##
## Parameters:
## SVM-Type: C-classification
## SVM-Kernel: radial
## cost: 15
##
## Number of Support Vectors: 340
##
## ( 173 167 )
##
##
## Number of Classes: 2
##
## Levels:
## CH MM# Realizar predicciones
#Se utiliza el conjunto de datos de entrenamiento
#Se usa el modelo.rad
prediccion <- predict(modelo.rad, datos.validacion)
#Mostrar las predicciones
#Las primeras y últimas diez de registro del conjunto de validación
kable(head(prediccion, 10))| x | |
|---|---|
| 1 | MM |
| 3 | CH |
| 10 | CH |
| 16 | CH |
| 18 | CH |
| 22 | CH |
| 26 | CH |
| 41 | CH |
| 45 | CH |
| 49 | CH |
kable(tail(prediccion, 10))| x | |
|---|---|
| 1011 | CH |
| 1014 | CH |
| 1020 | CH |
| 1039 | CH |
| 1040 | MM |
| 1043 | CH |
| 1053 | CH |
| 1056 | MM |
| 1057 | CH |
| 1059 | CH |
length(prediccion)## [1] 213nrow(datos.validacion)## [1] 213#Generar matriz de confusión de la predicción
mat.confusion <- table(predicho = prediccion, real = datos.validacion$Purchase)
mat.confusion## real
## predicho CH MM
## CH 108 21
## MM 22 62#Se utilizó el modelo de SVM con kernel tipo radial con costo igual a 15.
#El modelo acierta en 170 de un total de 213
#Representa el 79.8122 % en términos de exactitud estadística.
#Gráfica de los valores reales Vs predichos
#Se grafica el precio de venta y el precio de las bebidas CH.
ggplot(datos.validacion, aes(x = SalePriceCH, y = PriceCH)) +
geom_point(aes(colour = factor(prediccion)))
ggplot(datos.validacion, aes(x = SalePriceMM, y = PriceMM)) +
geom_point(aes(colour = factor(prediccion)))
#Comentarios finales
#A partir de los dos distintos tipos de botella y los 1070 compradores de ella, parte las variables para convertirlas en vectores cada una con la direccion hacia las fechas, compras emitidas. Con los 3 distintos tipos de SVM(lineal,polinomio y radial) que nos ayuda a determinar segun los predictores, que tipo de botella comprara el cliente.
#Bibliografía
#Cuevas, V. M., Alvares, S., Azcona, M., & Rodríguez, A. I. (2019). Capacidad predictiva de las Máquinas de Soporte Vectorial. Una aplicación en la planificación financiera. Revista Cubana de Ciencias Informáticas, 59-75.
#Castañeda, S. (01 de 07 de 2019). APLICACIÓN DE SUPPORT VECTOR MACHINE AL MERCADO COLOMBIANO. APLICACIÓN DE SUPPORT VECTOR MACHINE AL MERCADO COLOMBIANO, Trabajo de Grado. Colombia, Colombia, Colombia: Maestría en finanzas cuantitativas- Universidad del Rosario. ## ReferenciasIncluding Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.