Фильтрация смс спама с помощью наивного байесовского классификатора (код на R)

Наивный байесовский классификатор

Рассмотрим множество некоторых объектов D = {dq, d2, …, dm}, каждый из которых обладает некоторым набором признаков из множества всех признаков F = {f1, f2, …, fq}, а также одной меткой из множества меток C = {c1, c2, …, cr}. Нашей задачей является вычисление наиболее вероятного класса/метки входящего объекта d, опираясь на набор его признаков Fd = {fd1, fd2, …, fdn}. Другими словами, нам необходимо вычислить такое значение случайной переменной C, при котором достигается апостериорный максимум (maximum a posteriori probability, MAP).

• 2.1 — собственно, это наша цель
• 2.2 — раскладываем по теореме Байеса
• 2.3 — учитывая, что мы ищем аргумент, максимизирующий функцию правдоподобия, и то, что знаменатель не зависит от этого аргумента и является в данном случае константой, то мы можем смело вычеркнуть значение полной вероятности P(d)
• 2.4 — так как логарифм монотонно возрастает для любого x > 0, то максимум любой функции f(x) будет идентичен максимуму ln(f(x)); это нужно для того, чтобы в будущем во время программирования не оперировать с числами, близкими к нулю

Модель наивного байесовского классификатора принимает два допущения, от того она такая и наивная:

1. порядок следования признаков объекта не имеет значения;
2. вероятности признаков не зависят друг от друга при данном классе: .

Учитывая вышеприведенные допущения, продолжим вывод формул.

• 2.6-2.7 — это как раз следствие применения допущений
• 2.8 — здесь, как раз, применяется замечательное свойство логарифма, что позволяет нам избежать потери точности при оперировании очень маленькими значениями

Мы можем изобразить графическую модель наивного байесовского классификатора следующим образом:

Спам классификатор

Теперь от более общей задачи классификации погрузимся в конкретную задачу классификации спама. Итак, мнжество D состоит из смс сообщений. Каждое сообщение помечено меткой из множества C = {ham, spam}. Для того что бы сформулировать понятие признаков, мы будем использовать модель представления bag of words, проиллюстируем это на примере. Допустим, у нас всего два ham смс сообщения в базе

hi how are you
how old are you

Тогда мы можем построить таблицу

Всего 8 слов в корпусе не-спам сообщений, тогда после нормирования мы получим апостериорную вероятность слова, используя maximum likelihood estimation. Для примера вероятность слова «how» при условии, что сообщение не является спамом, будет такая:

P(fi = «how» | C = ham) = 2/8 = 1/4

Или же мы можем записать этот метод в общем виде:

, где q — общее количество уникальных слов в словаре.

Размытие по Лапласу

В этот момент самое время обратить внимание на следующую проблему. Вспомним нашу базу из двух ham сообщений, и, допустим, к нам пришло на классификацию сообщение: "hi bro", и, допустим, априорная вероятность не-спама P(ham) = 1/2. Вычислим вероятности слов:

1. P(«hi» | ham) = 1/8
2. P(«bro» | ham) = 0/8 = 0

Вспомним формулу 2.8 и вычислим выражение, находящееся под argmax при c = ham:

Очевидно, что мы получим либо ошибку либо отрицательную бесконечность, т.к. логарифм в нуле не существует. Если бы мы не использовали логарифмирование, то мы бы получили просто 0, т.е. вероятность этого сообщения была бы равна нулю, что в принципе большой пользы нам дает.

Избежать этого позволяет размытие по Лапласу или k-additive smoothing — этот метод позволяет делать размытие при вычислении вероятностей категорийных данных. В нашем случае это будет выглядеть следующим образом:

, где z >= 0 — коэффициент размытия, а q — это количество значений, которые может принимать случайная величина, в нашем случае ей является количество слов в классе; а q — общее количество слов которые были использованы при обучении модели.

Допустим, всего при прочтении ham и spam сообщений мы нашли 10 уникальных слов, тогда P(«hi» | ham) = ( 1 + 1 ) / (8 + 1*10 ) = 2/18 = 1/9 при коэффициенте размытия z = 1. А нулевая вероятность перестает быть таковой: P(«bro» | ham) = ( 0 + 1) / (8 + 1*10) = 1/18.

С Байесовской точки зрения, данный метод соответствует математическому ожиданию апостериорного распределения, используя в качестве априорного распределения — распределение Дирихле, параметризируемое параметром z.

Эксперимент и код

Я использую базу данных, скачанную с сайта университета города Кампинас, которая содержит 4827 нормальных смс сообщений (ham) и 747 spam сообщений.

Я не делал никакой серьезной предобработки текста, типа стемминга, только несколько простых операций:

• уменьшил текст до строчных букв
• убрал все знаки пунктуации
• все числовые последовательности заменил единицей

PreprocessSentence <- function(s) {   # Cut and make some preprocessing with input sentence   words <- strsplit(gsub(pattern="[[:digit:]]+", replacement="1", x=tolower(s)), '[[:punct:][:blank:]]+')   return(words) }   LoadData <- function(fileName = "./Data/Spam/SMSSpamCollection")  {   # Read data from text file and makes simple preprocessing:    #   to lower case -> replace all digit strings with 1 -> split with punctuation and blank characters   con <- file(fileName,"rt")   lines <- readLines(con)   close(con)   df <- data.frame(lab = rep(NA, length(lines)), data = rep(NA, length(lines)))   for(i in 1:length(lines))   {     tmp <- unlist(strsplit(lines[i], '\t', fixed = T))     df$lab[i] <- tmp[1]     df$data[i] <- PreprocessSentence(tmp[2])   }      return(df) } 

Следующая функция создает разбиение массива данных в соответствующих пропорциях, генерируя тем самым индексы тренировочного, валидационного и тестового набора данных:

CreateDataSet <- function(dataSet, proportions = c(0.6, 0.2, 0.2)) {   # Creates a list with indices of train, validation and test sets     proportions <- proportions/sum(proportions)   hamIdx <- which(df$lab == "ham")       nham <- length(hamIdx)     spamIdx <- which(df$lab == "spam")   nspam <- length(spamIdx)   hamTrainIdx <- sample(hamIdx, floor(proportions[1]*nham))   hamIdx <- setdiff(hamIdx, hamTrainIdx)   spamTrainIdx <- sample(spamIdx, floor(proportions[1]*nspam))   spamIdx <- setdiff(spamIdx, spamTrainIdx)   hamValidationIdx <- sample(hamIdx, floor(proportions[2]*nham))   hamIdx <- setdiff(hamIdx, hamValidationIdx)   spamValidationIdx <- sample(spamIdx, floor(proportions[2]*nspam))   spamIdx <- setdiff(spamIdx, spamValidationIdx)     ds <- list(     train = sample(union(hamTrainIdx, spamTrainIdx)),      validation = sample(union(hamValidationIdx, spamValidationIdx)),      test = sample(union(hamIdx, spamIdx))     )     return(ds) } 

Затем создается модель на основании входного массива данных:

CreateModel <- function(data, laplaceFactor = 0) {   # creates naive bayes spam classifier based on data   m <- list(laplaceFactor = laplaceFactor)   m[["total"]] <- length(data$lab)   m[["ham"]] <- list()     m[["spam"]] <- list()   m[["hamLabelCount"]] <- sum(data$lab == "ham")   m[["spamLabelCount"]] <- sum(data$lab == "spam")   m[["hamWordCount"]] <- 0   m[["spamWordCount"]] <- 0   uniqueWordSet <- c()   for(i in 1:length(data$lab))   {     sentence <- unlist(data$data[i])     uniqueWordSet <- union(uniqueWordSet, sentence)     for(j in 1:length(sentence))     {       if(data$lab[i] == "ham")       {         if(is.null(m$ham[[sentence[j]]]))         {           m$ham[[sentence[j]]] <- 1         }         else         {           m$ham[[sentence[j]]] <- m$ham[[sentence[j]]] + 1         }         m[["hamWordCount"]] <- m[["hamWordCount"]] + 1       }       else if(data$lab[i] == "spam")       {         if(is.null(m$spam[[sentence[j]]]))         {           m$spam[[sentence[j]]] <- 1         }         else         {           m$spam[[sentence[j]]] <- m$spam[[sentence[j]]] + 1         }         m[["spamWordCount"]] <- m[["spamWordCount"]] + 1       }     }   }   m[["uniqueWordCount"]] <- length(uniqueWordSet)   return(m)  } 

Последняя функция, касающаяся модели, классифицирует входящее сообщение, используя обученную модель:

ClassifySentense <- function(s, model, preprocess = T) {   # calculate class of the input sentence based on the model   GetCount <- function(w, ls)   {     if(is.null(ls[[w]]))     {       return(0)     }     return(ls[[w]])   }   words <- unlist(s)   if(preprocess)   {     words <- unlist(PreprocessSentence(s))   }   ham <- log(model$hamWordCount)   spam <- log(model$spamWordCount)   for(i in 1:length(words))   {     ham <- ham + log((GetCount(words[i], model$ham) + model$laplaceFactor)                      /(model$hamWordCount + model$laplaceFactor*model$uniqueWordCount))     spam <- spam + log((GetCount(words[i], model$spam) + model$laplaceFactor)                        /(model$spamWordCount + model$laplaceFactor*model$uniqueWordCount))   }   if(ham >= spam)   {     return("ham")   }   return("spam") } 

Для тестирования модели на множестве используется следующая функция:

TestModel <- function(data, model) {   # calculate percentage of errors   errors <- 0   for(i in 1:length(data$lab))   {     predictedLabel <- ClassifySentense(data$data[i], model, preprocess = F)     if(predictedLabel != data$lab[i])     {       errors <- errors + 1     }   }   return(errors/length(data$lab)) } 

Для поиска оптимального коэффициента размытия используется кроссвалидация на соответствующем множестве:

CrossValidation <- function(trainData, validationData, laplaceFactorValues, showLog = F) {   cvErrors <- rep(NA, length(laplaceFactorValues))   for(i in 1:length(laplaceFactorValues))   {     model <- CreateModel(trainData, laplaceFactorValues[i])     cvErrors[i] <- TestModel(validationData, model)     if(showLog)     {       print(paste(laplaceFactorValues[i], ": error is ", cvErrors[i], sep=""))     }   }   return(cvErrors) } 

Следующий код считывает данные, создает модели для значений параметра размытия от 0 до 10, выбирает наилучший результат, тестирует модель на раннее не используемом тестовом множестве и затем строит график изменения ошибки на кроссвалидационном множестве от параметра размытия и финальный уровень ошибки на тестовом множестве:

rm(list = ls()) source("./Spam/spam.R") set.seed(14880) fileName <- "./Data/Spam/SMSSpamCollection" df <- LoadData() ds <- CreateDataSet(df, proportions = c(0.7, 0.2, 0.1)) laplaceFactorValues <- 1:10 cvErrors <- CrossValidation(df[ds$train, ], df[ds$validation, ], 0:10, showLog = T) bestLaplaceFactor <- laplaceFactorValues[which(cvErrors == min(cvErrors))] model <- CreateModel(data=df[ds$train, ], laplaceFactor=bestLaplaceFactor) testResult <- TestModel(df[ds$test, ], model) plot(cvErrors, type="l", col="blue", xlab="Laplace Factor", ylab="Error Value", ylim=c(0, max(cvErrors))) title("Cross validation and test error value") abline(h=testResult, col="red") legend(bestLaplaceFactor, max(cvErrors), c("cross validation values", "test value level"), cex=0.8, col=c("blue", "red"), lty=1) 

Весь код можно скачать с гитхаба.

Заключение

Как видите, этот метод очень эффективен даже при простой предобработке, показатель ошибки на тестовом множестве (отношение неверно классифицированных сообщений к общему количеству сообщений) всего 2.32%. Где вы можете использовать этот метод? Например, на вашем сайте есть множество комментариев, вы недавно ввели рейтинг комментариев от 1 до 5, и у вас только малая часть реально с рейтингом расставленным людьми; тогда вы можете автоматически расставить более-менее релевантные рейтинги на оставшиеся комментарии.