¿Cuánto se puede saber desde los discursos?

Esto es un juego.

Esta entrada la estuve pensando en la última semana de Septiembre 2015, en especial debido a varios acontecimientos y fechas que se celebran en México. Ejemplo, el 1° de Septiembre se hace entrega del informe anual del gobierno por parte del presidente, el día 15 se celebra el día de la independencia de México, el día 27 de Septiembre del 2014 sucedieron unos hechos lamentables en el estado de Guerrera dónde 43 estudiantes de una Normal Rural fueron “desaparecido”. Pero más aún, con motivo de este último suceso se han realizado manifestaciones y posiblemente se vuelven desde este año actos que se realizarán año con año.

Lo que observé en Facebook, en twitter  y en la prensa, suele ser variado dependiendo del perfil tanto de las personas como de los periódicos. Pero algo que observé fue que las críticas se centraban en los discursos del presidente, sobré algo que decía, sobre lo dicho en la ONU con sede en New York mientras se llevaban acabo manifestaciones en México. Sobre el tipo de palabras, sobre los comentarios, etc.

Algunas frases fueron tomadas como los objetivos centrales de las críticas de dichos discursos. Entiendo que existen un equipo que redacta los discursos del presidente, pero también entiendo que existe un personal que revisa y que verifica el tipo de términos y explicaciones que se dirán. Evito imaginar que se tenga una estrategia para hacer crítica o freno a las aspiraciones políticas de un posible candidato a la presidencia, cuando aún faltan 3 años para la contienda electoral, la entrada la hago sin tener una postura política sobre las conclusiones e interpretaciones que se dieron a los discursos.

Pensé que no sería mala idea jugar con una muestra pequeña de discursos (48) y analizar cosas básicas para tratar de ver cómo ha cambiado la “similaridad” entre los discursos, ver cuáles han sido los tópicos a los largo de los meses y tratar de ver qué se puede saber de manera estadística desde los discursos. Pienso que son otros los capacitados para hacer un análisis de tiempo y espacio donde se dice tal o cual discurso y la relevancia o repercusión de lo dicho.

Esto no desentona en tipo de entradas, ya que no es para nada una manifestación política o una entrada donde trato de mostrar algo negativo del gobierno o donde trato de concluir o deducir algo sobre lo que sucede en el país. Es simplemente jugar con un puñado de datos y ver que se descubre.

Con toda mi ignorancia sobre como interpretar un discurso, me atrevo a suponer de un modo simplista que cada discursos político tienen algo de “localidad” y de “temporalidad”. Con localidad, pienso que depende de donde es emitido, de cuan tan importante es el lugar donde se emite y lo temporal me refiero al momento que rodea a dicho discurso, los acontecimiento cercanos, los sucesos sociales y políticos que acontecen en las fechas en las que se dice dicho discurso. Por otro lado, imagino que otro factor que afecta la “relevancia” de un discurso es gracias a los medios de comunicación, ya que bien un discurso puede ser parte de un evento donde un mandatario comunica algo o puede ser usado como parte de la información que usa y discute un medio de comunicación, el cual termina perneando la opinión publica.

Esto de cierto modo me permite hacer una análisis de textos, clasificar los discursos, detectar tópicos en los discursos, comparar por medio de medidas de similaridad como han cambiado o en qué meses se muestra mayor similaridad, comparar la muestra con respecto al informe y la participación en la ONU, etc. Estos aspectos pueden ser trabajados con una combinación de herramientas y algoritmos, lo cual pensé que sería divertido ver hasta donde se puede saber algo desde los discursos.

Sobre la muestra.

Tomé 48 discursos, 4 por mes desde Septiembre 2014 hasta Septiembre 2015. Los elegí de manera aleatoria, todos fueron guardados en archivos txt. Los  discursos varían, tanto en cantidad de palabras como el tipo de evento en el cual se emitió.

La muestra de discursos fue tratada tanto para hacer un Corpus Global, como uno por cada Mes, y de igual forma se compararon todos los discursos de manera independiente para identificar similaridad.

Lo que decidí hacer.

Escribí unas funciones las cuales me permitían dos cosas, extraer las palabras que aparecen con mayor frecuencia y aplicando LDA tomé 20 palabras del primer tópico detectado. Definí un corpus por año,  por mes y tomé los discursos qué más escuche comentar, el discurso del Informe de Gobierno y el Discursos en la ONU como la pareja inicial a comparar.

Así que use la medida de similaridad de Jaccard, que es una medida muy sencilla para definir entre los discursos cuales eran más cercanos según las palabras más frecuentes y cuales por las 20 palabras detectadas en el primer tópico.

Primero muestro un ejemplo y al final muestro los resultados obtenidos con todos los discursos.

Informe de Gobierno e informe ONU.

El código lo comparto más adelante. Los resultados son los siguientes:

#Comparación entre los discursos de la UNO y el Informe de Gobierno

dir1="C:\\.....ruta.....\\150928_ONU.txt"

dir2="D:\\.....ruta......\\150902_Informe_EPN.txt"

#Extracción del mensaje
Doc1<-msg(dir1)
Doc2<-msg(dir2)

#Contrucción de la matriz de terminos
TMD1<-tdm2(Doc1)
TMD2<-tdm2(Doc2)

#Se contruye su matrix de frecuencias
L1=TablaFreq(TMD1)
L2=TablaFreq(TMD2)

head(L1,5)
#    Términos  Frecuencia density ocurrencia
#356 naciones   15       0.01764706 1
#351 mundo      10       0.01176471 1
#330 méxico      9       0.01058824 1
#391 paz         9       0.01058824 1
#551 unidas      9       0.01058824 1
 
head(L2,5)
#     Términos Frecuencia density ocurrencia
#1597  méxico    92    0.014212884 1
#1603  mil       69    0.010659663 1
#1661  nacional  51    0.007878882 1
#1767  país      51    0.007878882 1
#1596  mexicanos 48    0.007415418 1

Jaccard(head(L1,20),head(L2,20))
#0.1428
#Gráfica
graphFreq(L1)
graphFreq(L2)

#Contruyo el DTM de cada texto
DTM_1=DTM(Doc1)
DTM_2=DTM(Doc2)

#Extraego las priemras 20 palabras asociadas con el primer tópico
top1<-TopicLDA(DTM_1)
top2<-TopicLDA(DTM_2)

top1
[1] "naciones" "derechos" "onu" "organización" "respeto" "agenda" 
[7] "frente" "humanidad" "humanos" "armas" "colectiva" "con" 
[13] "general" "seguridad" "señores" "acción" "clara" "consejo" 
[19] "favor" "futuro" 

top2
[1] "méxico" "con" "mil" "país" "reforma" 
[6] "gobierno" "mayor" "año" "administración" "familias" 
[11] "república" "años" "por" "justicia" "programa" 
[16] "educación" "crecimiento" "condiciones" "partir" "pobreza

Jaccard(top1,top2)
#0.0256

Se observa que hay una similaridad mayor entre los discursos cuando se consideran la palabras con mayor frecuencia o apariciones. La palabra que generó mayor crítica en los medios fue “populismo” y “populistas”. Estas dos palabras hicieron que se criticaran mucho los 2 discursos, lo que muestran los datos es que esas palabras aparecen muy poco, comparado con el efecto que generaron en los medios. De cierto modo son como “palabras singulares” que ejercieron mucho impacto en la apreciación del discurso.

La gráficas de las 50 palabras más citadas son las siguientes:

EPN_ONU

Discurso ONU

EPN_IG

Discurso Informe de Gobierno

Se observa que entre los dos discursos existe una diferencia considerable entre el tipo de palabras que se emplean y la frecuencia, también de la gráfica se puede apreciar que hay cierta “forma” diferente entre las palabras más citadas. Lo cual es notorio que la palabra “méxico” domina el discurso de Informe de Gobierno, por otro lado las palabras “naciones” y “mundo” el discurso de la ONU.

Lo que no muestra gran cambio es el desvanecimiento del color, que representa los cambios de la “densidad” de la frecuencia de las palabras. Concluir algo de estos datos es sutil y posiblemente confuso y atrevido, así que limitándome a lo estadístico se puede decir que hay en estructura diferencias pero muy sutiles, casi no se puede decir nada de esta comparación.

Dándole una interpretación a los tópicos y las mediciones de similaridad, los discursos en cuanto a “estructura”; las palabras más frecuentes, muestran un 14% de similaridad. Pero cuando uno analiza las palabras asociadas al primer tópico detectado, se observa que realmente solo son similares en escaso 2%. Los tópicos me parecen más relevantes, y es notoria la diferencia detectada. Las 20 palabras del primer tópico muestran al discurso de la ONU como algo “global” o “mundial”, y al discurso del informe de gobierno lo muestran como algo “nacional” y de problemas “socio económicos”.

En conclusión; como es de esperar,  se puede decir que los discursos no son tan similares (bajo esta medida de similaridad).

Lo global

Haciendo un corpus con los 48 discursos analizar, puedo comparar con respecto a los otros dos y analizar el comportamiento de la similaridad.

#Procesamiento de los discursos
#Librería para la nube de palabras
library(wordcloud)

dir="D:.....ruta....."
setwd(dir)
#Lista de directorios
filesall<-dir()
#Documentos y corpus
corpusalldoc<-sapply(filesall,function(p)msg(p))
corpusall<-tdm2(corpusalldoc)

#Tabla de frecuencias
Lall=TablaFreq(corpusall)

#Gráfica de frecuencias
graphFreq(Lall)

#Tópicos
DTMall<-DTM(corpusalldoc)
Topic_all<-TopicLDA(DTMall)

#Selección de conjunto de palabras para la nube de palabras
Grupo1<-rowSums(as.matrix(corpusall))
Grupo1<-subset(Grupo1,Grupo1>=30)
m<-as.matrix(Grupo1)
dim(m)
word_freqs = sort(rowSums(m), decreasing=TRUE)
dm = data.frame(word=names(word_freqs), freq=word_freqs)
wordcloud(dm$word, dm$freq, random.order=FALSE, random.color=FALSE,colors=brewer.pal(10,"Dark2"))

La gráfica y la nube de palabras que se obtiene es la siguiente:

Palabras_48 disc

Nube_48disc

Comparando con la métrica de similaridad se tienen lo siguiente:

#Medida de Similaridad
#Palabras más frecuentes
#UNO vs los 48 Discursos
Jaccard(Lall[,1],L1[,1])
#0.123
#Informe de Gobierno vs 48 Discursos
Jaccard(Lall[,1],L2[,1])
#0.282

#Tópicos
#ONU vs los 48 Discursos
Jaccard(Topic_all,top1)
#0.0526
#Informe de Gobiernos vs los 48 Discursos
Jaccard(Topic_all,top2)
#0.1428

Se aprecia que la medida de similaridad es mayor entre el discurso de informe que el de la ONU con respecto al corpus de los discursos. Era de esperar que fuera así, por la naturaleza del discurso y la fecha a la cual corresponde.

Es claro que los dos discursos tienen mayor similaridad con la muestra de discursos en el año, que entre ellos. Las dos preguntas que me hago al observar esto es, ¿cómo se comporta esta medida de similaridad por mes? y ¿cuál discurso muestra mayor similaridad con el de gobierno y el de la ONU?

Por Mes y por Discurso.

Haciendo la comparación por meses, se tienen que a comparar los dos discursos, el de la ONU y el del Informe, se tienen que por corpus construido por mes, se tiene gráficas como las siguientes:

Frec_Meses

El comportamiento por tópicos muestra otro comportamiento, el cual genera la siguiente gráfica:

Topic_Meses

Las gráficas de la métrica por mes muestra lo que uno puede esperar, el discurso de la ONU llega a no tener nada de similaridad en los meses de Marzo y Abril con la frecuencia de palabras, pero peor aún muestra poca similaridad con el primer grupo de tópicos en los meses de Octubre, Diciembre, Enero, Abril, Mayo y Septiembre. Es decir, el discurso dado en la ONU considerando que su primer grupo de tópicos se refiere aspecto mundiales o globales, ese no fue tema en esos meses con respecto a la muestra.

Por otro lado, el discurso del informe uno espera que sea similar al dado cada año o que las palabras que se usan en el mes de Septiembre suelen ser usuales. Eso muestra la primera gráfica, pero además vuelve a ser similar al inicio del año. Por otro lado al considerar los tópicos no muestra el mismo comportamiento, resulta que el mes de Junio es por alguna razón el mes con el cual muestra mayor similaridad. Eso me resulta raro, pero así resultó la medida de similaridad.

Ahora considerando cada uno de los discursos elegidos para analizar, el comportamiento que muestran con la frecuencia de palabras es el siguiente:

Freq_por_discurso

Esta muestra algo un poco más interesante, primero el mes de Septiembre muestra mayor similaridad y me resulta extraño que solo con el mes de Septiembre en el 2014, pero también uno puede observar que el mes de Enero con respecto al informe muestra un comportamiento de alta similaridad. Uno puede pensar que con motivo de inicio del año los discursos suelen ser “alentadores” , “nacionalistas”, “de mejoras” , etc. Esto pienso que puede ser interesante revisar una muestra de varios años y comparar como se comporta conforme pasan los años y quizás muestra estacionalidad la medida de similaridad.

Respecto al informe de la ONU muestra que no es usual que en los discursos se haga uso del mismo tipo de palabras, lo cual uno puede esperarlo ya que no suele decirse mucho del contexto “global”, como en el discursos de la ONU.

La gráfica de los tópicos, muestra el siguiente comportamiento:

 Topic_por_discursoLos tópicos muestran una cosa curiosa, el discurso de la ONU muestra entre los meses de Noviembre-Diciembre una alza, ¿efecto de la navidad para hablar del mundo?..no lo se, esto igual permite que si se hace una muestra mayor analizar si hay algún efecto en el primer grupo de tópicos detectados con la técnicas LDA.

Por otro lado el comportamiento del discurso del Informe muestra una alta similaridad en meses como Enero, Mayo y Junio. De nuevo que el mes de Enero aparezca con valores considerablemente mayores me hace suponer que al inicio del año y a medio año suelen tener este comportamiento de realzar o motivar ciertas cosas “nacionalistas” o “de esperanza” de ser un mejor país. No lo se, solo me hace pensar que teniendo una muestra mayor uno puede empezar hacer cosas más interesantes y jugar a poner algunas hipótesis para experimentar.

 ¿Qué cosas hacer para mejorar esto?

Haciéndome auto-críticas, pienso que hacer una muestra mayor y con discursos de varios años puede resultar más interesante. Por otro lado hacer uso de mejores técnicas o de otras técnicas de medidas de similaridad para explorar como se comportan los discursos con varias medidas. Por último no estaría mal hacer una muestra de otros mandatarios para revisar como evolucionan los tópicos y ver como se comportan ante camios o hechos históricos, cosas de ese estilo.

 Código

Comparto las funciones principales, el resto son muchas líneas de código de loops o de procesar un poco los datos para hacer las gráficas. Por lo cual comparto solo lo más importante del código.

library(tm)
library(NLP)
library(ggplot2)

#######################################
#Mensaje
msg<-function(path){
 con<-file(path,open='rt')
 text<-readLines(con, warn = FALSE, n=-1, encoding = "UCS-2LE")
 close(con)
 return(paste(text, collapse = "\n"))
}

#####################################
#TDM

tdm<-function(doc){
 control<-list(removeWords(stopwords("spanish")),
 removePunctuation,
 removeNumbers,
 content_transformer(tolower),
 minDocFreq=2)
 doc.corpus<-Corpus(VectorSource(doc))
 doc.tdm<-TermDocumentMatrix(doc.corpus,control)
 return(doc.tdm)
}

#######################################
#TDM versión 2
tdm2<-function(doc){
 docCor<-Corpus(VectorSource(doc))
 docs <- tm_map(docCor, stripWhitespace)
 docs <- tm_map(docs, removeWords, stopwords("spanish"))
 docs <- tm_map(docs, removePunctuation)
 docs <-tm_map(docs,removeNumbers)
 docs <- tm_map(docs,content_transformer(tolower))
 DocsTDM <- TermDocumentMatrix(docs) 
 return(DocsTDM)
 }

############################################
#Tabla de frecuencias
TablaFreq<-function(TDM){
 docmatrix <- as.matrix(TDM)
 doc.counts <- rowSums(docmatrix)
 doc.df <- data.frame(cbind(names(doc.counts),as.numeric(doc.counts)),stringsAsFactors = FALSE)
 names(doc.df) <- c("Términos", "Frecuencia")
 doc.df$Frecuencia <- as.numeric(doc.df$Frecuencia)
 doc.occurrence <- sapply(1:nrow(docmatrix),
 function(i)
 {
 length(which(docmatrix[i, ] > 0)) / ncol(docmatrix)
 })
 doc.density <- doc.df$Frecuencia / sum(doc.df$Frecuencia)
 doc.df <- transform(doc.df,density = doc.density,ocurrencia =doc.occurrence)
 S=head(doc.df[with(doc.df, order(-Frecuencia)),], n=50)
 return(S)
 }

##############################################
#Gráfica de frecuencias
graphFreq<-function(L){
 library(ggplot2)
 #Se debe de introducir la matriz con frecuencias
 #Gráfica de palabras y frencia
 p<-ggplot(L,aes(x=factor(Términos, levels=unique(as.character(Términos)) ), y=Frecuencia))+geom_bar(stat = "identity",aes(fill=density))+
 coord_flip()+xlab('Apariciones en el texto')+ylab('Las 50 palabras más frecuentes') 
 return(p)
 }

##########################################
#Función para extraer el Document term Matrix
DTM<-function(Texto){
 docCor<-Corpus(VectorSource(Texto))
 docs <- tm_map(docCor, stripWhitespace)
 docs <- tm_map(docs, removeWords, stopwords("spanish"))
 docs <- tm_map(docs, removePunctuation)
 docs<-tm_map(docs,removeNumbers)
 docs <- tm_map(docs,content_transformer(tolower))
 DocsTDM <- DocumentTermMatrix(docs) 
 return(DocsTDM)
}

################################################
#Topic
TopicLDA<-function(DTMdoc){
 #Regresa las 20 palabras relevantes del primer tópico detectado
 library(topicmodels)
 r.lda=LDA(DTMdoc,method="Gibbs",2)
 L=terms(r.lda,20)
 return(L[,1])
 }

##############################################
#Similaridad de Jaccard
Jaccard<-function(A,B){
 a=length(intersect(A,B))
 b=length(union(A,B))
 a/b
}

Anuncios

Comparación entre Máquina de Soporte Vectorial, Naive Bayes, Árboles de Decisión y Métodos Lineales

De lo que trata esta entrada.

En la entrada no explico a detalles técnicas sobre cada una de los algoritmos empleados, pero pueden consultarse en las referencias o en las categorías Machine Learning en R project y Machine Learning en Python.

Para el ejemplo solo uso código en R, la intención es usar tres muestras de datos simulados para mostrar las estimaciones que realiza la función svm de la librería e1071, solo en el caso de usarla para clasificar. Y por último uso unos datos  de correos clasificados como spam o no-spam provenientes del repositorio UCI Machine Learning Repository los cuales se encuentran cargados en la librería kernlab de  R project para aplicar las técnicas y comparar svm con otras técnicas.

Ejemplo.-Solo Suppor Vector Machine

En este ejemplo solo hago dos muestras de datos simulados, con distribuciones  Gaussianas y la intención es compartir los detalles de qué es en rasgos generales lo que hace el algoritmo de maquina de soporte vectorial al clasificar datos, esto es para dos dimensiones. Es decir, sobre un plano ya que visualmente se vuelve claro y con esa idea se puede pensar en el tipo de cosas que hace el algoritmo en más dimensiones.

Los primeros datos no se mezclan, por lo cual es visualmente claro como separarlos.

#Datos
#Librerías requeridas para el ejemplo

library(ggplot2)
library(e1071)

#Datos de mezcla 1

N<-500
x1<- rnorm(N) * 0.1
y1<- rnorm(N) * 0.1
X1<- t(as.matrix(rbind(x1, y1)))
x2<- rnorm(N) * 0.1 + 0.5
y2<- rnorm(N) * 0.1 + 0.5
X2<- t(as.matrix(rbind(x2, y2)))
X<- as.matrix(rbind(X1, X2))
X=data.frame(X)
X['Clus']=1
X[500:1000,3]=2
ggplot(X,aes(x=x1,y=y1))+geom_point(size=3,aes(colour=factor(Clus)))+ggtitle('Mezcla 1')+theme(plot.title=element_text(lineheight = 2,face='bold'))+
 xlab('Variable X1')+ylab('Variable Y1')

La gráfica de los puntos se ve así:Mezcla1_Gas

Para la siguiente mezcla considero tres muestras donde las clasifico en dos categorías.

#Mezcla 2
N<-500
x1<- rnorm(500,mean=0,sd=3)*0.1 
y1<- rnorm(500,mean=0,sd=3)*0.1 
X1<- t(as.matrix(rbind(x1, y1)))
x3<- rnorm(250,mean=0,sd=3)*0.1 
y3<- rnorm(250,mean=0,sd=3)*0.1+0.7 
X3<- t(as.matrix(rbind(x3, y3)))
x2<- rnorm(N,mean=1.5,sd=4)*0.1 + 0.5
y2<- rnorm(N,mean=0,sd=3)*0.1 + 0.5
X2<- t(as.matrix(rbind(x2, y2)))
Datos2<- as.matrix(rbind(X1, X3,X2))
Datos2=data.frame(Datos2)
Datos2['Clus']=1
Datos2[600:1250,3]=2
ggplot(Datos2,aes(x=x1,y=y1,colour=factor(Clus)))+geom_point(size=3)+ggtitle('Mezcla 2')+theme(plot.title=element_text(lineheight = 2,face='bold'))+
 xlab('Variable X1')+ylab('Variable Y1')

Mez2_GaussLa gráfica de los datos se ve como la anterior imagen.

Los datos muestran comportamientos distintos, los primeros es claro que se puede separar por una recta, pero la gráfica de la segunda muestra no se ve claramente que lo mejor sea separar los datos por una recta.

Como una buena práctica se debe de tomar una muestra de datos para entrenar el algoritmo (train set) y una cantidad de datos de prueba(test set). Para los siguientes ejemplos considero todos los datos, para ilustrar cual sería la gráfica de los datos predichos por el modelo.

La técnica de SVM para clasificar tienen de fondo la idea de encontrar el mejor “hiperplano” por medio del cual separar los datos. En este ejemplo el concepto de hiperplano es una recta, es decir; los datos están en dos dimensiones (x,y) y se busca la mejor recta que separe los datos, si uno piensa en datos con tres dimensiones (x,y,z) que pueden pensarse como alto, largo y ancho lo que se busca es encontrar el mejor plano que separa los datos, por ello el nombre de hiperplano.

Uso la librería e1071 para estimar el algoritmo SVM con el kernel lineal y radial para la primera muestra de datos, para la segunda uso lineal, polinomial, radial y sigmoid. La intención de este ultimo es compara cual de las cuatro muestra una similitud gráfica más parecida a los datos originales y comparo la tasa de predicciones correctas. Existen más librerías para hacer uso de SVM, dejo en la referencia las ligas.

Primera muestra de datos.

#SVM con Kernel Lineal
#Se procede a dejar una semilla para hacer una elección del mejor valor de parámetro cost

set.seed (1)
#Se hace cross-validation de k-fold, con k=10. Esto mediante la función tune()

tune.out=tune(svm,factor(Clus)~.,data=Datos1,kernel="linear",type='C-classification',scale=FALSE,ranges=list(cost=c(0.001,0.01, 0.1, 1,5,10,100)))
tune.out
summary(tune.out)

#Se elige el mejor modelo con el mejor valor para el parámetro cost

bestmod=tune.out$best.model
summary(bestmod)
# Gráfica del mejor modelo con kernel lineal

plot(bestmod,Datos1)

#Predicción
Pred=predict(bestmod,Datos1)

table(predicción=Pred,Valores_reales=Datos1$Clus)

# Valores_reales
# predicción 1 2
#         1 499 1
#         2 0 500
#Con los valores obtenidos se tiene un 99.9% de eficiencia 

Algunas observaciones, el modelo pasa por un proceso de validación cruzada usando la función tune(), esto siempre es recomendable para elegir un buen modelo. El parámetro cost, significa el nivel de penalización que permite el modelo, en otras palabras el algoritmo busca la mejor recta que separe los datos y como tal el costo para encontrar esa recta requiere tolerar posibles datos que afectan a la estimación de dicha recta. Esto quizás es una explicación burda y mala, pero detrás de todo algoritmo de Machine Learning está un proceso de optimización el cual determina el valor de los parámetros que hacen que el algoritmo tenga el mejor valor posible.

La gráfica que se obtiene de este modelo es la siguiente:

SVM_Muestra1_ker-lineal

 

Esta gráfica muestra las dos clases que se buscaban definir.La eficiencia es muy alta, de 1000 datos clasifica correctamente el 99.9%.

Lo que se espera de otro kernel es que prevalezca la eficiencia de SVM y más aún que la gráfica de la clasificación sea casi igual a la obtenido cuando se usa un kernel lineal.

#Kernel radial
set.seed (1)
tune.out=tune(svm,factor(Clus)~.,data=Datos1,kernel="radial",type='C-classification',scale=FALSE,ranges=list(cost=c(0.001,0.01, 0.1, 1,5,10,100)))
tune.out
summary(tune.out)
bestmod_r=tune.out$best.model
summary(bestmod_r)
plot(bestmod_r,Datos1)
Pred=predict(bestmod_r,Datos1)
table(predicción=Pred,Valores_reales=Datos1$Clus)
# Valores_reales
# predicción 1 2
# 1 499 1
# 2 0 500
#Eficiencia de la clasificación 99.9%

Al obtener la gráfica del modelo por SVM se tiene:

SVM_Muestra1_ker-radial

Lo cual muestra una imagen muy similar a la obtenida con el kernel lineal. La tasa de eficiencia al clasificar es prácticamente la misma, 99.9%

Con la segunda muestra de datos pensar en separar por una recta no parece lo natural. Primero hago la estimación con cuatro tipo de kernels de la función svm y muestro la gráfica que regresa el modelo.

#Segunda muestra de datos
#Se usa primero el kernel lineal

set.seed (1)
tune.out=tune(svm,factor(Clus)~.,data=Datos2,kernel="linear",type='C-classification',scale=FALSE,ranges=list(cost=c(0.001,0.01, 0.1, 1,5,10,100)))
tune.out
summary(tune.out)
bestmod_l=tune.out$best.model
summary(bestmod_l)
plot(bestmod_l,Datos2)
Pred=predict(bestmod_l,Datos2)
table(predicción=Pred,Valores_reales=Datos2$Clus)
# Valores_reales
# predicción 1 2
# 1 504 99
# 2 95 552
#Eficiencia de la clasificación 84.4%

Se tiene la siguiente gráfica como resultado de implementar el algoritmo:

SVM_Mezcla2_ker-lineal

Si se compara los datos que predice el modelo con respecto a los originales se tienen lo siguiente:

Orig_vs_Ker-lineal

Se observa que la predicción muestra totalmente separadas las dos clases y cabe notar que se tiene el 84.4% eficiencia.

#Kernel polinomial

set.seed (1)
tune.out=tune(svm,factor(Clus)~.,data=Datos2,kernel="polynomial",type='C-classification',scale=FALSE,ranges=list(cost=c(0.001,0.01, 0.1, 1,5,10,100)))
tune.out
summary(tune.out)
bestmod_p=tune.out$best.model
summary(bestmod_p)
plot(bestmod_p,Datos2)
Pred=predict(bestmod_p,Datos2)
table(predicción=Pred,Valores_reales=Datos2$Clus)
# Valores_reales
# predicción 1 2
# 0 543 174
# 1 56 477
#Eficiencia de la clasificación 81.6%, con kernel polinomial

La gráfica que se obtiene del modelo es:

SVM_Mezcla2_ker-polin

Y otra vez haciendo una gráfica para comparar la predicción con los datos originales se tiene:

Orig_vs_Ker-pol

Se aprecia que no es tan definida la recta que separa las clases como en el ejemplo del kernel lineal, pero la eficiencia se reduce ya que es de 81.6%

#Kernel sigmoid

set.seed (1)
tune.out=tune(svm,factor(Clus)~.,data=Datos2,kernel="sigmoid",type='C-classification',scale=FALSE,ranges=list(cost=c(0.001,0.01, 0.1, 1,5,10,100)))
tune.out
summary(tune.out)
bestmod_s=tune.out$best.model
summary(bestmod_s)
#Informa del tipo de modelo, del que puede considerarse como el mejor modelo
plot(bestmod_s,Datos2)
Pred=predict(bestmod_s,Datos2)
table(predicción=Pred,Valores_reales=Datos2$Clus)
# Valores_reales
# predicción 1 2
#         1 509 102
#         2 90 549
#Eficiencia de la clasificación 84.6%, con kernel Sigmoid

La gráfica que se obtiene del modelo es la siguiente:

SVM_Mezcla2_ker-sigmoid

Haciendo la gráfica comparativa de predicción y datos originales se obtiene:Orig_vs_Ker-sigmoid

 

Se aprecia que es muy similar a la que se obtiene con el kernel lineal y hasta el nivel de eficiencia resulta muy aproximado, ya que es del 84.6%

#Kernel Radial
set.seed (1)
tune.out=tune(svm,factor(Clus)~.,data=Datos2,kernel="radial",type='C-classification',scale=FALSE,ranges=list(cost=c(0.001,0.01, 0.1, 1,5,10,100)))
tune.out
summary(tune.out)
bestmod_r=tune.out$best.model
summary(bestmod_r)
plot(bestmod_r,Datos2)
Pred=predict(bestmod_r,Datos2)
table(predicción=Pred,Valores_reales=Datos2$Clus)
# Valores_reales
# predicción 1 2
# 1 497 94
# 2 102 557
#Eficiencia de la clasificación 84.3%, con kernel lineal

La gráfica obtenida con este kernel es la siguiente:

SVM_Mezcla2_ker-radial

 

Y al comparar las predicciones con los datos originales se tiene:

Orig_vs_Ker-radial

Se aprecia que es similar a la obtenida por el kernel lineal y sigmoid, más aún la eficiencia resulta ser del 84.3%.

Entonces en resumen los datos al ser clasificados mediante SVM con distintos kernel resultó en estos datos resulta tener mejor eficiencia el kernel sigmoid, por un porcentaje mínimo sobre el lineal.

Para mostrar como se comporta SVM con una muestra de datos altamente no lineales o que resulta difícil separar por medio de una recta , genero una muestra más.

#Datos altamente no lineales

#Distribución uniforme 1250 valores
x1=runif(1250)-0.5
x2=runif (1250)-0.5
#Variable Indicadora
y=1*(x1^2-x2^2> 0)

#Gráfica donde se muestran los puntos pintados por etiqueta de y
#Se contruye un data.frame con los datos
X=data.frame(x1,x2,y)
ggplot(data=X,aes(x=x1,y=x2))+geom_point(aes(colour=factor(y),shape=factor(y)))+ggtitle('Datos Originales')+theme(plot.title=element_text(lineheight = 2,face='bold'))+
 xlab('Variable X1')+ylab('Variable X2')

La gráfica de los datos es la siguiente:

Datos_No-lineales

En esta muestra de datos se aprecia que separar las clases por una recta no parece lo más eficiente, para constatarlo estimo la clasificación con el kernel lineal.

#Kernel lineal
set.seed (1)
tune.out=tune(svm,factor(y)~.,data=X,kernel="linear",type='C-classification',scale=FALSE,ranges=list(cost=c(0.001,0.01, 0.1, 1,5,10,100)))
tune.out
summary(tune.out)
bestmod=tune.out$best.model
summary(bestmod)
#Informa del tipo de modelo, del que puede considerarse como el mejor modelo
plot(bestmod,X)
Pred=predict(bestmod,X)
table(predicción=Pred,Valores_reales=X$y)
# Valores_reales
# predicción 0 1
# 0 305 201
# 1 301 443
#Eficiencia de la clasificación 59.8%

La gráfica que se obtiene del SVM con kernel lineal es:

SVM_Mezcla3_ker-lineal

Haciendo la comparación entre datos originales y las predicciones se tiene lo siguiente:

Orig3_vs_Ker-lineal

Se aprecia que no es muy favorable usar el kernel lineal con estos datos, la eficiencia de la clasificación es del 59.4%

Para comparar con otro kernel uso el radial para hacer la clasificación.

#Kernel Radial

set.seed(1)
tune.out=tune(svm,factor(y)~.,data=X,kernel="radial",sacale=FALSE,type='C-classification',ranges=list(cost=c(0.001,0.01, 0.1, 1,5,10,100)))
tune.out
summary(tune.out)
bestmod=tune.out$best.model
summary(bestmod)
#Informa del tipo de modelo, del que puede considerarse como el mejor modelo
Pred=predict(bestmod,X)
table(predicción=Pred,Valores_reales=X$y)
# Valores_reales
# predicción 0 1
# 0 603 7
# 1 3 637
#Eficiencia de la clasificación 99.2%, con kernel radial

La gráfica que se obtiene con este kernel es la siguiente:

SVM_Mezcla3_ker-radial

Esta imagen muestra que las curvas que se obtienen con el kernel radial son parecidas a las de los datos originales. Haciendo la comparación entre los datos y las estimaciones se obtiene lo siguiente:

Orig3_vs_Ker-Radial

Se aprecia que es muy similar y más aún la eficiencia es del 99.2%, lo cual comparado con el lineal es sumamente mejor usar el kernel radial.

Ejemplo con datos de correos clasificados

Los datos se encuentran cargados en la librería kernelabs, con la cual también se puede estimar la máquina de soporte vectorial. Las comparaciones las hago con varias técnicas:

  • Naive Bayes
  • LDA y Regresión Logística
  • Redes Neuronales
  • Árboles de decisión y random forest

Antes de eso aplico con los cuatro kernel disponibles en svm de e1071 para elegir el que mejor clasificación realiza en la muestra de prueba (test set).

Primero reviso los datos.

#Exploración breve de los datos
#Se cargan primero las librerías

library(kernlab)
library(e1071)
library(MASS)
library(nnet)
librery(randomForest)
data(spam)

#Datos
head(spam)
dim(spam)
#4601 58
str(spam)

#############################################
#Preparación de datos

index=sort(sample.int(4601,1150))
spam.train=spam[-index,]
spam.test=spam[index,]

Se puede hacer algo más al explorar la información, diseñar algunas gráficas o usar alguna técnica de estadística de exploración.

Lo que se hace en el código anterior es dividir los datos entre una conjunto de entrenamiento y un conjunto de prueba.

Aplico los cuatro kernel para elegir el que mejor clasificación realiza.

#SVM con diferentes kernel
########################################
#Kernel lineal

svmfit=svm(type~.,data=spam.train,kernel="linear",cost=0.1,type='C-classification' )
summary(svmfit)
Pred=predict(svmfit,spam.test)
table(predicción=Pred,Valores_reales=spam.test$type)
#         Valores_reales
#predicción nonspam spam
#   nonspam 646 40
#   spam     40 424
#Eficiencia del modelo 93.04%
#######################################
#Kernel radial
svmfit=svm(type~.,data=spam.train,kernel="radial",cost=0.1,type='C-classification' )
summary(svmfit)

set.seed(1)
tune.out=tune(svm,type~.,data=spam.train,kernel="radial",type='C-classification',ranges=list(cost=c(0.001,0.01, 0.1, 1,10,100)))
tune.out
summary(tune.out)
bestmod_r=tune.out$best.model
summary(bestmod_r)
Pred=predict(bestmod_r,spam.test)
table(predicción=Pred,Valores_reales=spam.test$type)
#           Valores_reales
#predicción nonspam spam
#   nonspam     652 36
#   spam         34 428
#Eficiencia del modelo 93.91%
#################################################
#Kernel sigmoid
svmfit=svm(type~.,data=spam.train,kernel="sigmoid",cost=0.1,type='C-classification' )
summary(svmfit)
set.seed(1)
tune.out=tune(svm,type~.,data=spam.train,kernel="sigmoid",type='C-classification',ranges=list(cost=c(0.001,0.01, 0.1, 1,10,100)))
tune.out
summary(tune.out)
bestmod_s=tune.out$best.model
summary(bestmod_s)
Pred=predict(bestmod_s,spam.test)
table(predicción=Pred,Valores_reales=spam.test$type)
#           Valores_reales
#predicción nonspam spam
#    nonspam    649 78
#    spam        37 386
#Eficiencia del modelo 90%
################################################
#Kernel polynomial
svmfit=svm(type~.,data=spam.train,kernel="polynomial",cost=0.1,type='C-classification' )
summary(svmfit)
set.seed(1)
tune.out=tune(svm,type~.,data=spam.train,kernel="polynomial",type='C-classification',ranges=list(cost=c(0.001,0.01, 0.1, 1,10,100)))
tune.out
summary(tune.out)
bestmod_p=tune.out$best.model
summary(bestmod_p)
Pred=predict(bestmod_p,spam.test)
table(predicción=Pred,Valores_reales=spam.test$type)
#           Valores_reales
#predicción nonspam spam
#   nonspam     661 53
#   spam         25 411
#Eficiencia del modelo 93.2%

Se observa en las tasas de error que el mejor kernel de svm es el radial, así que considero este contra el cual comparo las otras técnicas.

Si bien no explico a detalle lo que hace el código en breve es estimar vía tune() la elección del mejor valor de cross-validation de varios valores.

Una técnica clásica para clasificar correos es Naive Bayes, la cual considera ciertas propiedades teóricas que permiten hacer un calculo rápido. Uso NaiveBayes de la librería e1071.

#Naive Bayes vs SVM elegido
NB=naiveBayes(type~.,data=spam.train)
Pred=predict(NB,spam.test)

table(predicción=Pred,Valores_reales=spam.test$type)
# Valores_reales
#predicción nonspam spam
# nonspam 362 18
# spam 324 446
#Se tiene una eficiencia del 70.2% de bien clasificados

Resulta que es mejor el modelo SVM ante el Naive Bayes por un porcentaje altamente mejor.

#Regresión Logística-LDA vs SVM elegido

Mod.lm=glm(type~.,data=spam.train,family='binomial')
summary(Mod.lm)
Mod.lmprob=predict(Mod.lm,newdata=spam.test,type="response")
Mod.pred=rep('nonspam',1150)
Mod.pred[Mod.lmprob>0.5]='spam'
table(Predicción=Mod.pred,Valores_Reales=spam.test$type)
#           Valores_Reales
#Predicción nonspam spam
#   nonspam 643 39
#   spam     43 425
#Predicción 92.86%
############################################
#Método LDA
lda.fit=lda(type~.,data=spam.train)
lda.pred=predict(lda.fit,spam.test)
lda.class=lda.pred$class
table(Predicción=lda.class,Valores_Reales=spam.test$type)
#lda.class nonspam spam
#   nonspam    650 91
#   spam        36 373
#Tasa de eficiencia 88.9%

Se tienen que el porcentaje de eficiencia en la clasificación de SVM 93.91% es mayor de casi 1% mejor que los métodos lineales, en este caso la regresión logística resulta ser la mejor entre las técnicas lineales.

Sin explicar detalles elijo un modelo de redes neuronales para clasificar, la librería es nnet y la función tienen el mismo nombre.

#Redes Neuronales
red=nnet(type~.,data=spam.train,size=2)
Pred=predict(red,spam.test,type="class")

table(Predicción=Pred,Valores_Reales=spam.test$type)
# Valores_Reales
#Predicción nonspam spam
# nonspam 650 29
# spam 36 435
#Tasa de eficiencia 94.34%

Resulta que el modelo de redes neuronales resulta ser mejor casi 0.5% mejor que el modelo de SVM. Lo cual faltaría hacer una revisión para definir el mejor modelo de redes neuronales y quizás la mejora es mejor o nula pero tendrías los valores óptimos de los parámetros.

#Dos técnicas de arboles
# La primera es por árboles y se hace cross-validation para elegir el mejor modelo
 
tree.spam=tree(type~.,spam.train)
set.seed (3)
cv =cv.tree(tree.spam,FUN=prune.misclass )

#Gráfica de Cross-validation para elegir el mejor valor de del parámetro best
par(mfrow =c(1,2))
plot(cv$size,cv$dev,type="b",col="2")
plot(cv$k,cv$dev,type="b",col="3")

prune.tree=prune.misclass(tree.spam,best=8)
tree.pred=predict(prune.tree,spam.test,type="class")
table(tree.pred,Valores_Reales=spam.test$type)

#         Valores_Reales
#tree.pred nonspam spam
#  nonspam 644 58
#  spam     42 406
#Tasa de clasificación 91.3%
#################################################
#Modelo de Random Forest

set.seed (1)
rf.spam =randomForest(type~.,data=spam.train,mtry=7, importance =TRUE)
rf.pred_spam=predict(rf.spam,newdata=spam.test,type="class")

table(rf.pred_spam,Valores_Reales=spam.test$type)
#            Valores_Reales
#rf.pred_spam nonspam spam
#     nonspam 663 29
#     spam     23 435
#Tasa de clasificación 95.4%

Revisando la tasa de clasificaciones correcta por medio de las técnicas de árboles de decisión , resulta ser la mejor técnica para clasificar los datos de los correos. Se obtienen que la técnica de Random Forest resulta clasificar correctamente el 95.4%, comparado con la red neuronal y SVM es mejor casi en un 2%.

La única intensión de este ejemplo es hacer una comparación entre diversas técnicas de clasificación, de cierto modo hacer un ejemplo sencillo y que se puede replicar. Ha esto le faltaría agregar algunos gráficos que muestran los resultados o hacer algunas variaciones de los parámetros requeridos en cada algoritmos para determinar con mejor eficiencia el mejor modelo.

Espero ilustre de manera breve la variedad de técnicas y permita visualizar que al final se requiere probar con muchos modelos para elegir uno entre todos los realizados.