[读书笔记]机器学习：实用案例解析（3）

时间：2016-06-06 01:04:17 阅读：691 评论：0 收藏：0 [点我收藏+]

标签：

第3章分类：垃圾过滤

#machine learing for heckers
#chapter 3

library(tm)
library(ggplot2)

#设置路径变量

spam.path <- "ML_for_Hackers/03-Classification/data/spam/"
spam2.path <- "ML_for_Hackers/03-Classification/data/spam_2/"
easyham.path <- "ML_for_Hackers/03-Classification/data/easy_ham/"
easyham2.path <- "ML_for_Hackers/03-Classification/data/easy_ham_2/"
hardham.path <- "ML_for_Hackers/03-Classification/data/hard_ham/"
hardham2.path <- "ML_for_Hackers/03-Classification/data/hard_ham_2/"

###########################################
#构建垃圾邮件和正常邮件的特征词项类别知识库
###########################################
#######################
#构建垃圾邮件的特征词项
#######################
#打开每一个文件，找到空行，将空行之后的文本返回为一个字符串向量（只有一个元素）
#file用于打开文件，open设置rt(read as text), 由于邮件中可能包含非ACSⅡ码字符，
#设置encoding = "latin1"
#readLines按行读入文件
#定位到第一个空行“”并抽取后面的所有文本
#有些文件中未包含空行，会抛出错误，因此用tryCatch捕获这些错误并返回NA
#关闭文件，将所有行合并为一行并返回该向量

get.msg <- function(path){
  con <- file(path, open = "rt", encoding = "latin1")
  text <- readLines(con)
  #The message always begins after the first full line break
  #if not have a break, return NA
  msg <- tryCatch(text[seq(which(text == "")[1]+1, length(text), 1)], error = function(e) return(NA))
  close(con)
  return(paste(msg, collapse = "\n"))
}

#创建向量保存所有正文，向量的每个元素就是一封邮件的内容
#dir函数得到路径下文件列表，除掉cmds文件
#应用sapply函数时，先传入一个无名函数，目的是用paste函数把文件名和适当的路径拼接起来

spam.docs <- dir(spam.path)
spam.docs <- spam.docs[which(spam.docs != "cmds")]
all.spam <- sapply(spam.docs, 
                   function(p) get.msg(paste(spam.path, p, sep = "")))

#输入文本向量，输出TDM（Term Document Matrix,词项-文档矩阵）
#矩阵行表示词项，列表示文档，元素[i, j]代表词项i在文档j中出现的次数
#Corpus函数用于构建语料库（corpus对象），VectorSource用向量构建source对象
#source对象是用来创建语料库的数据源对象
#control变量是一个选项列表，用于设定提取文本的清洗规则
#stopwords移除停用词，removePunctuation, removeNumbers分别移除标点和数字
#minDocFreq设定最小两次出现的词才最终出现在TDM中

get.tdm <- function(doc.vec){
  doc.corpus <- Corpus(VectorSource(doc.vec))
  control <- list(stopwords = TRUE, removePunctuation = TRUE, 
                  removeNumbers = TRUE, minDocFreq = 2)
  doc.dtm <- TermDocumentMatrix(doc.corpus, control)
  return(doc.dtm)
}
spam.tdm <- get.tdm(all.spam)

#用TDM构建垃圾邮件的训练数据：构建数据框保存所有特征词在垃圾邮件中的条件概率
#先将spam.tdm转为标准矩阵，rowSums创建一个包含每个特征在所有文档中总频次的向量
#注意禁止字符自动转为因子
#修改列名，frequency转数字类型

spam.matrix <- as.matrix(spam.tdm)
spam.counts <- rowSums(spam.matrix)
spam.df <- data.frame(cbind(names(spam.counts), as.numeric(spam.counts)), 
                      stringsAsFactors = FALSE)
names(spam.df) <- c("term", "frequency")
spam.df$frequency <- as.numeric(spam.df$frequency)

#关键训练数据1：计算一个特定特征词项所出现的文档在所有文档中所占比例
#sapply函数将行号传入无名函数，计算该行值为正数的元素个数，再除以文档总数（列数）
#关键训练数据2：统计整个语料库中每个词项的频次（不用于分类，但是可以通过对比频次知道某些词是否影响结果）

spam.occurrence <- sapply(1:nrow(spam.matrix), 
                          function(i) {length(which(spam.matrix[i, ] > 0))/ncol(spam.matrix)})
spam.density <- spam.df$frequency/sum(spam.df$frequency)
spam.df <- transform(spam.df, density = spam.density, occurrence = spam.occurrence)

#按照occurrence列降序排列并显示前6条（与书上的结果不同）

技术分享

#######################
#构建正常邮件的特征词项
#######################

easyham.docs <- dir(easyham.path)
easyham.docs <- easyham.docs[which(easyham.docs != "cmds")]
#注意为了平衡数据，将正常邮件数量限定在500
easyham.docs<-easyham.docs[1:500]
all.easyham <- sapply(easyham.docs, 
                      function(p) get.msg(paste(easyham.path, p, sep = "")))
easyham.tdm <- get.tdm(all.easyham)

easyham.matrix <- as.matrix(easyham.tdm)
easyham.counts <- rowSums(easyham.matrix)
easyham.df <- data.frame(cbind(names(easyham.counts), as.numeric(easyham.counts)), 
                      stringsAsFactors = FALSE)
names(easyham.df) <- c("term", "frequency")
easyham.df$frequency <- as.numeric(easyham.df$frequency)

easyham.occurrence <- sapply(1:nrow(easyham.matrix), 
                          function(i) {length(which(easyham.matrix[i, ] > 0))/ncol(easyham.matrix)})
easyham.density <- easyham.df$frequency/sum(easyham.df$frequency)
easyham.df <- transform(easyham.df, density = easyham.density, occurrence = easyham.occurrence)

#按照occurrence列降序排列并显示前6条（与书上的结果不同）

技术分享

#########################################################################
#构造函数classify.email：输入文本返回这封邮件是垃圾邮件的贝叶斯概率估计值
#########################################################################
#抽取正文、转换成TDM、计算特征词项频率
#先验概率默认为50%，未出现词的概率设为0.0001%

classify.email <- function(path, training.df, prior = 0.5, c = 1e-6){
  msg <- get.msg(path)
  msg.tdm <- get.tdm(msg)
  msg.freq <- rowSums(as.matrix(msg.tdm))
  #find intersections of words找到邮件中的词项和出现在训练集中的词项的交集
  msg.match <- intersect(names(msg.freq), training.df$term)
  if(length(msg.match) < 1){
    #如果没有任何词出现在垃圾邮件集中
    #length(msg.freq)是词的个数
    #返回的值很小，因为没有训练集中出现过的词，无法判定
    return(prior*c^(length(msg.freq)))
  }else{
    #交集中词的频率存放到match.probs
    #用这些词的特征概率，计算这封邮件是训练集中对应类别的条件概率
    #返回值=是垃圾邮件的先验概率*各重合词在垃圾邮件训练集中的概率积*缺失词项的小概率积
    match.probs <- training.df$occurrence[match(msg.match, training.df$term)]
    return(prior*prod(match.probs)*c^(length(msg.freq) - length(msg.match)))
  }
}

#############################################
#用不易分类的正常邮件进行测试
#############################################

hardham.docs <- dir(hardham.path)
hardham.docs <- hardham.docs[which(hardham.docs != "cmds")]

hardham.spamtest <- sapply(hardham.docs, 
                           function(p) classify.email(file.path(hardham.path, p), 
                                                      training.df = spam.df))
hardham.hamtest <- sapply(hardham.docs, 
                          function(p) classify.email(file.path(hardham.path, p), 
                                                     training.df = easyham.df))

hardham.res <- ifelse(hardham.spamtest > hardham.hamtest, TRUE, FALSE)
summary(hardham.res)

技术分享

#############################################
#用三种类型的邮件下标为2的邮件集进行测试
#############################################

#creating a function: return the probability and the classification
spam.classifier <- function(path) {
  pr.spam <- classify.email(path, spam.df)
  pr.ham <- classify.email(path, easyham.df)
  return(c(pr.spam, pr.ham, ifelse(pr.spam > pr.ham, 1, 0)))
}
#path list
spam2.docs <- dir(spam2.path)
spam2.docs <- spam2.docs[which(spam2.docs != "cmds")]
easyham2.docs <- dir(easyham2.path)
easyham2.docs <- easyham2.docs[which(easyham2.docs != "cmds")]
hardham2.docs <- dir(hardham2.path)
hardham2.docs <- hardham2.docs[which(hardham2.docs != "cmds")]
#classifying using lapply
spam2.class <- suppressWarnings(lapply(spam2.docs, 
                                       function(p) spam.classifier(file.path(spam2.path, p))))
easyham2.class <- suppressWarnings(lapply(easyham2.docs,
                                          function(p) spam.classifier(file.path(easyham2.path, p))))
hardham2.class <- suppressWarnings(lapply(hardham2.docs,
                                          function(p) spam.classifier(file.path(hardham2.path, p))))

#"lapply"返回的是列表对象，需要转换为矩阵

技术分享

#turn the list into matrix and label them
easyham2.matrix <- do.call(rbind, easyham2.class)
easyham2.final <- cbind(easyham2.matrix, "EASYHAM")
hardham2.matrix <- do.call(rbind, hardham2.class)
hardham2.final <- cbind(hardham2.matrix, "HARDHAM")
spam2.matrix <- do.call(rbind, spam2.class)
spam2.final <- cbind(spam2.matrix, "SPAM")

#combine all matrices and turn them into data frame, name the column

class.matrix <- rbind(easyham2.final, hardham2.final, spam2.final)
class.df <- data.frame(class.matrix, stringsAsFactors = FALSE)
names(class.df) <- c("Pr.SPAM" ,"Pr.HAM", "Class", "Type")

#设置stringAsFactors = FALSE后，数据框所有元素类型均为"character"，因此需要单独更改

技术分享

class.df$Pr.SPAM <- as.numeric(class.df$Pr.SPAM)
class.df$Pr.HAM <- as.numeric(class.df$Pr.HAM)
class.df$Class <- as.logical(as.numeric(class.df$Class))
class.df$Type <- as.factor(class.df$Type)

#creat a plot of results

#直线的绘制，需要使用"geom_abline"命令，设定截距使用"intercept"参数，与书中代码不同

class.plot <- ggplot(class.df, aes(x = log(Pr.HAM), log(Pr.SPAM))) +
  geom_point(aes(shape = Type, alpha = 0.5)) +
  geom_abline(intercept = 0, slope = 1) +
  scale_shape_manual(values = c("EASYHAM" = 1,
                                "HARDHAM" = 2,
                                "SPAM" = 3),
                     name = "Email Type") +
  scale_alpha(guide = "none") +
  xlab("log[Pr(HAM)]") +
  ylab("log[Pr(SPAM)]") +
  theme_bw() +
  theme(axis.text.x = element_blank(), axis.text.y = element_blank())
print(class.plot)

技术分享

#creat a table of results

get.results <- function(bool.vector){
  results <- c(length(bool.vector[which(bool.vector == FALSE)]) / length(bool.vector),
               length(bool.vector[which(bool.vector == TRUE)]) / length(bool.vector))
  return(results)
}
easyham2.col <- get.results(subset(class.df, Type == "EASYHAM")$Class)
hardham2.col <- get.results(subset(class.df, Type == "HARDHAM")$Class)
spam2.col <- get.results(subset(class.df, Type == "SPAM")$Class)
class.res <- rbind(easyham2.col, hardham2.col, spam2.col)
colnames(class.res) <- c("NOT SPAM", "SPAM")
print(class.res)

技术分享

#效果评价：对于正常邮件分类效果好，但是对于垃圾邮件分类效果差，有48.3%的误判
#结果与书上不一致

########################################
#效果改进
########################################
#之前的先验概率设置为50%，但是实际数据集中，垃圾邮件数量347/(347+247+1400)=17.4%

#事实上，垃圾邮件和正常邮件分别约占20%和80%
#因此更改先验概率

#以下是关键代码，重复上面代码的一部分即可得到结果

spam.classifier.new <- function(path){
  pr.spam <- classify.email(path, spam.df, prior = 0.2)
  pr.ham <- classify.email(path, easyham.df, prior = 0.8)
  return(c(pr.spam, pr.ham, ifelse(pr.spam > pr.ham, 1, 0)))
}
spam2.class <- suppressWarnings(lapply(spam2.docs, 
                                       function(p) spam.classifier.new(file.path(spam2.path, p))))
easyham2.class <- suppressWarnings(lapply(easyham2.docs,
                                          function(p) spam.classifier.new(file.path(easyham2.path, p))))
hardham2.class <- suppressWarnings(lapply(hardham2.docs,
                                          function(p) spam.classifier.new(file.path(hardham2.path, p))))

技术分享