Clasificador de SPAM en SMS basado en el algoritmo de Naive-Bayes
JOSE ANTONIO COZAR
July 14, 2018
Objetivo
Realizar un clasificador de SMS’s basado en el algoritmo de Naive-Baye mediante el cual determinar si el contenido de un sms corresponde a un mensaje de spam o no.
Fuente de Datos
# condicional para evaluar si ya tenemos en el directorio de trabajo el archivo descargado
if(!file.exists('myfile.zip')) {
url <- "http://archive.ics.uci.edu/ml/machine-learning-databases/00228/smsspamcollection.zip"
download.file(url, destfile = 'myfile.zip', method = 'curl')
unzip('myfile.zip')
}
sms_raw <- read.csv('SMSSpamCollection', header=FALSE, stringsAsFactors = FALSE , sep='\t')Exploración
Empezemos echando un vistazo a los datos descargados y así tener una idea clara del contenido del dataframe.
head(sms_raw)## V1
## 1 ham
## 2 ham
## 3 spam
## 4 ham
## 5 ham
## 6 spam
## V2
## 1 Go until jurong point, crazy.. Available only in bugis n great world la e buffet... Cine there got amore wat...
## 2 Ok lar... Joking wif u oni...
## 3 Free entry in 2 a wkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receive entry question(std txt rate)T&C's apply 08452810075over18's
## 4 U dun say so early hor... U c already then say...
## 5 Nah I don't think he goes to usf, he lives around here though
## 6 FreeMsg Hey there darling it's been 3 week's now and no word back! I'd like some fun you up for it still? Tb ok! XxX std chgs to send, £1.50 to rcvstr(sms_raw)## 'data.frame': 3184 obs. of 2 variables:
## $ V1: chr "ham" "ham" "spam" "ham" ...
## $ V2: chr "Go until jurong point, crazy.. Available only in bugis n great world la e buffet... Cine there got amore wat..." "Ok lar... Joking wif u oni..." "Free entry in 2 a wkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receive entry question("| __truncated__ "U dun say so early hor... U c already then say..." ...Nuestro dataframe está compuesto por 3184 observaciones y 2 variables. En primer lugar vamos a renombrar las variables con nombres descriptivos que hagan alusión a su contenido.
names(sms_raw) <- c('type', 'txt')
head(sms_raw)## type
## 1 ham
## 2 ham
## 3 spam
## 4 ham
## 5 ham
## 6 spam
## txt
## 1 Go until jurong point, crazy.. Available only in bugis n great world la e buffet... Cine there got amore wat...
## 2 Ok lar... Joking wif u oni...
## 3 Free entry in 2 a wkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receive entry question(std txt rate)T&C's apply 08452810075over18's
## 4 U dun say so early hor... U c already then say...
## 5 Nah I don't think he goes to usf, he lives around here though
## 6 FreeMsg Hey there darling it's been 3 week's now and no word back! I'd like some fun you up for it still? Tb ok! XxX std chgs to send, £1.50 to rcvSeguidamente exploraremos el dataframe en busca de observaciones incompletas.
colSums(is.na(sms_raw))## type txt
## 0 0Todas las observaciones del dataframe están completas. Por último revisaremos la composición del dataframe y en especial en este caso el contenido de la variable type que contiene la tipología del sms.
summary(sms_raw)## type txt
## Length:3184 Length:3184
## Class :character Class :character
## Mode :character Mode :characterprop.table(table(sms_raw$type)) ##
## ham spam
## 0.8624372 0.1375628Por tanto tenemos 2746 mensajes no spam (86%) y 438 mensajes spam (14%). En cuanto a la variable txt, esta contiene 3184 cadenas de caracteres que corresponde a los mensajes sms originales.
Preparación, limpieza y estandarización
Son varias la tareas que necesitamos abordar en este apartado:
- Convertir el contenido de la variable type a tipo factor
- Eliminar carácteres de puntuación que no aportar inicialmente información para hacer la clasificación
- Convertir todo el contenido de la variable txt a minúsculas o mayúscula
- Eliminar palabras que no aportan información para realizar la clasificación como artículos, preposiciones, pronombres, etc
En primer lugar convirtamos el contenido de type a tipo factor.
sms_raw$type <- factor(sms_raw$type)
str(sms_raw)## 'data.frame': 3184 obs. of 2 variables:
## $ type: Factor w/ 2 levels "ham","spam": 1 1 2 1 1 2 1 1 2 2 ...
## $ txt : chr "Go until jurong point, crazy.. Available only in bugis n great world la e buffet... Cine there got amore wat..." "Ok lar... Joking wif u oni..." "Free entry in 2 a wkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receive entry question("| __truncated__ "U dun say so early hor... U c already then say..." ...Para el resto de tareas usaremos el paquete tm y aprovecharemos varias de sus funciones incorporadas para tratar el texto de los sms’s.
# chequea si el paquete tm está instalado. Si no lo está lo instalará. Ojo con las dependencias ya que la instación de este paquete falla algunas veces. Revisar los posibles errores que se muestran por consola para encontrar la solución.
if("tm" %in% row.names(installed.packages()) == FALSE) {
install.packages("tm")
}
library(tm)## Loading required package: NLPVamos a realizar varias tareas sucesivas sobre la lista sms_raw$txt que contiene todos los mensajes con la ayuda de la librería tm recientemente instalada. Lo primero vamos a crear un corpus con todos los mensajes usando la función VCorpus() del paquete tm. Es necesario tener en cuenta que esta función recibe como argumento un vector junto con varios parámetros de control o configuración (ver documentación del paquete tm aquí)
sms_corpus <- VCorpus(VectorSource(sms_raw$txt), readerControl = list(language="en", enconding="UTF-8"))Aplicaremos a continuación varios procesos sucesivos a nuestro corpus con la ayuda de la función DocumentTermMatrix() del paquete tm junto con varios parámetros de control o configuración (ver documentación del paquete tm aquí)
sms_dtm <- DocumentTermMatrix(sms_corpus, control = list(tolower=TRUE, removeNumbers=TRUE, stopwords=TRUE, removePunctuation=TRUE, stemming=TRUE))Conjunto de datos de entrenamiento y test
A continuación crearemos los dos subconjuntos de datos de entrenamiento y test a partir del objeto sms_dtm. Usaremos la función sample para obtener una muestra aleatoria de índices de filas con las que crear cada uno de los subconjuntos anteriores.
set.seed(3141592)
index <- sample(nrow(sms_dtm),round(0.75*nrow(sms_dtm)))
sms_dtm_train <- sms_dtm[index,]
sms_dtm_test <- sms_dtm[-index,]Del mismo modo crearemos dos subconjuntos de la variable type de los datos originales haciéndo uso de los mismos índices.
sms_train_labels <- sms_raw[index,]$type
sms_test_labels <- sms_raw[-index,]$typeComprobamos a continuación que la proporcion de casos de spam y no spam son similares en el conjunto de entrenamiento y test.
prop.table(table(sms_train_labels))## sms_train_labels
## ham spam
## 0.8597152 0.1402848prop.table(table(sms_test_labels))## sms_test_labels
## ham spam
## 0.870603 0.129397Opcionalmente podemos visualizar las palabras que más aparecen en nuestro conjunto de datos en forma de nube de palabras. Para realizarlo necesitaremos hacer uso de los paquetes R wordcloud y *RColorBrewer.
# chequea si el paquete wordcloud está instalado. Si no lo está lo instalará.
if("wordcloud" %in% row.names(installed.packages()) == FALSE) {
install.packages("wordcloud")
}
library(wordcloud)
# chequea si el paquete RColorBrewer está instalado. Si no lo está lo instalará.
if("RColorBrewer" %in% row.names(installed.packages()) == FALSE) {
install.packages("RColorBrewer")
}
library(RColorBrewer)
# crear los subconjuntos de sms de spam y no spam
ham <- subset(sms_raw, type == "ham")
spam <- subset(sms_raw, type == "spam")
# genera la nube de palabras para sms no spam
wordcloud(ham$txt, max.words = 100, random.color = TRUE, colors = brewer.pal(9,"BuGn" ))
# genera la nube de palabras para sms spam
wordcloud(spam$txt, max.words = 100, random.color = TRUE, colors = brewer.pal(9,"Reds" ))
Crearemos ahora un vector con las palabras más frecuentes en el conjunto de datos de entrenamiento con la ayuda de la función findFreqTerms() del paquete tm
sms_freq_words <- findFreqTerms(sms_dtm_train, lowfreq = 5)
str(sms_freq_words)## chr [1:1135] "abiola" "abl" "about" "abt" "accept" "access" "account" ...Ahora filtraremos las columnas de sms_dtm_train y sms_dtm_test para que sólo aparezcan esas columnas descartando el resto y creando dos nuevos objetos con los resultados.
sms_dtm_test_freq <- sms_dtm_test[,sms_freq_words]
sms_dtm_train_freq <- sms_dtm_train[,sms_freq_words]Cómo último paso de esta etapa debemos tener en cuenta los clasificadores de Naives Bayes sólo aceptan variables de tipo categoría y no numéricas por lo que necesitaremos realizar una última transformación sobre nuestra matriz de datos. Dado que la cabecera de cada columna representa una palabra, y los valores representan el número de veces que esa palabra aparece en el sms correspondiente, crearemos una función que transforme esos valores numéricos.
num2cat <- function(x) {
x <- ifelse(x>0,"Yes","Not")
}
sms_test <- apply(sms_dtm_test_freq, MARGIN = 2, num2cat)
sms_train <- apply(sms_dtm_train_freq, MARGIN = 2, num2cat)Entrenamiento
Para implementar el algoritmo de clasificación de Naive-Bayes haremos uso del paquete R e1071 que instalaremos en el nmuestro entorno de trabajo si no lo tenemos aun.
# chequea si el paquete e1071 está instalado. Si no lo está lo instalará.
if("e1071" %in% row.names(installed.packages()) == FALSE) {
install.packages("e1071")
}
library(e1071) En primer lugar entrenamos el modelo.
sms_classifier <- naiveBayes(sms_train, sms_train_labels, laplace = 0)Seguidamente realizamos una predicción con el modelo creado y el conjunto de datos test.
sms_test_pred <- predict(sms_classifier, sms_test)Evaluación del modelo
Ahora compararemos la predicción de clasificación realizada sms_test_pred con la clasifiación correcta del grupo test sms_test_labels. Pra llevar a cabo esta tarea crearemos una matriz de confusión con la ayuda del paquete R gmodels.
# chequea si el paquet gmodels está instalado. Si no lo está lo instalará.
if("gmodels" %in% row.names(installed.packages()) == FALSE) {
install.packages("gmodels")
}
library(gmodels)
CrossTable(x=sms_test_labels, y=sms_test_pred )##
##
## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 796
##
##
## | sms_test_pred
## sms_test_labels | ham | spam | Row Total |
## ----------------|-----------|-----------|-----------|
## ham | 692 | 1 | 693 |
## | 9.504 | 75.497 | |
## | 0.999 | 0.001 | 0.871 |
## | 0.979 | 0.011 | |
## | 0.869 | 0.001 | |
## ----------------|-----------|-----------|-----------|
## spam | 15 | 88 | 103 |
## | 63.943 | 507.953 | |
## | 0.146 | 0.854 | 0.129 |
## | 0.021 | 0.989 | |
## | 0.019 | 0.111 | |
## ----------------|-----------|-----------|-----------|
## Column Total | 707 | 89 | 796 |
## | 0.888 | 0.112 | |
## ----------------|-----------|-----------|-----------|
##
## Con los parámetros actuales el modelo nos ha dado una precisión del 98% y por tanto un error del 2%, resultados bastante aceptables. De los 796 SMS’s del test, sólo un caso fue clasificado como SPAM sin serlo y 15 casos fuero clasificados como NO SPAM cuando si lo eran. Vayamos un poco más lejos en la evaluación del modelo con la ayuda del paquete R caret que igualmente nos genera la misma matriz de confusión junto a otros indicadores más avanzados que profundizan en la bondad del modelo.
# chequea si el paquet caret está instalado. Si no lo está lo instalará.
if("caret" %in% row.names(installed.packages()) == FALSE) {
install.packages("caret")
}
library(caret)
confusionMatrix(table(sms_test_labels, sms_test_pred))## Confusion Matrix and Statistics
##
## sms_test_pred
## sms_test_labels ham spam
## ham 692 1
## spam 15 88
##
## Accuracy : 0.9799
## 95% CI : (0.9676, 0.9885)
## No Information Rate : 0.8882
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9053
## Mcnemar's Test P-Value : 0.001154
##
## Sensitivity : 0.9788
## Specificity : 0.9888
## Pos Pred Value : 0.9986
## Neg Pred Value : 0.8544
## Prevalence : 0.8882
## Detection Rate : 0.8693
## Detection Prevalence : 0.8706
## Balanced Accuracy : 0.9838
##
## 'Positive' Class : ham
##