邮件过滤及排序

1、构建一个判定邮件是否是垃圾邮件的系统，利用SpamAssassin的公开语料库，可以在

http：//https://www.360docs.net/doc/5e12545919.html,/publiccorpus/免费下载。根据邮件内容提取相应的特征词，依据特征次将邮件标注为垃圾或非垃圾邮件，特征词的提取可以根据内容、收发邮件的联系人等，这里我们根据内容。在这过程中需要相应的文本处理包（tm）。我们根据条件概率（bayes）将上述提取的特征词转化为相应的概率，从而分类。在这个过程中我们会遇到关于特征词提取，概率计算的问题，模型训练和测试，在贝叶斯中先验概率的选取，先验概率的选取可以通过正则化进行，将结果可视化等

2、加载相应的包和设置工作路径

library('tm') ##文本处理

library('ggplot2') ##作图

下面有两套文件在相应的文件夹中，一套用来训练分类器，一套用来测试分类器，有三类邮件：易识别的正常邮件、不易识别的正常邮件、垃圾邮件。

spam.path <- file.path("D:/R","spam")

spam2.path <- file.path("D:/R","spam_2")

easyham.path <- file.path("D:/R","easy_ham")

easyham2.path <- file.path("D:/R","easy_ham_2")

hardham.path <- file.path("D:/R","hard_ham")

hardham2.path <- file.path("D:/R","hard_ham_2")

设置好路径后，编写函数，构建邮件的特征词项类别知识库，打开每一个文件找到空行，将空行之后的文本返回为一个字符串向量。

get.msg <- function(path)

{

con <- file(path, open = "rt", encoding = "latin1")

text <- readLines(con)

# The message always begins after the first full line break

msg <- text[] ## msg <- text[seq(which(text == " ")[1] + 1, length(text), 1)]

close(con)

return(paste(msg, collapse = "\n"))

}

以垃圾邮件为例，先得到垃圾邮件的文件列表，在列表中剔除cmds的文件，它们是unix 的基本命令表，然后用上述函数得到垃圾邮件的文本向量

spam.docs <- dir(spam.path) ##获得路劲下的文件名

spam.docs <- spam.docs[which(spam.docs != "cmds")] ##得到垃圾邮件名称

all.spam <- sapply(spam.docs,

function(p) get.msg(file.path(spam.path,p))) ##得到文本向量利用tm包的函数，将得到的文本向量转化为TDM矩阵（词项-----------文档矩阵）([i，j]表示词项i在文档j中出现的次数)，得到下述函数，注意TermDocumentMatrix函数对变量的要求，注意下面参数控制的含义。

get.tdm <- function(doc.vec)

{

control <- list(stopwords = TRUE,

removePunctuation = TRUE,

removeNumbers = TRUE,

minDocFreq = 2)

doc.corpus <- Corpus(VectorSource(doc.vec))

doc.dtm <- TermDocumentMatrix(doc.corpus, control)

return(doc.dtm)

}

spam.tdm<-get.tdm(all.spam) ####得到垃圾邮件的词项-----------文档矩阵

str(spam.tdm)

构造分类器数据矩阵，将上述的词项-----------文档矩阵构造成一个数据框来保存所有特征词在垃圾邮件中的条件概率，根据多少邮件包含这个特征词项来定义一封邮件是垃圾邮件的条件概率。

spam.matrix <- as.matrix(spam.tdm) ###标准化为矩阵形式

head(spam.matrix)

dim(spam.matrix)

spam.matrix[2,c(2,2)]

colnames(spam.matrix)

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")

head(spam.df)

dim(spam.df)

spam.df$frequency <- as.numeric(spam.df$frequency)

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) #计算比例从来当作特征

词的概率# Add the term density and occurrence rate

spam.df <- transform(spam.df,

density = spam.density,

occurrence = spam.occurrence)

head(spam.df[with(spam.df,order(-occurrence)),]) (这里得到的是垃圾邮件的训练数据)

用易识别的正常邮件来构建训练数据，我们用easy_ham中的前500封来构造训练数据。和上述方法相同。

easyham.docs <- dir(easyham.path)

easyham.docs <- easyham.docs[which(easyham.docs != "cmds")]

all.easyham <- sapply(easyham.docs[1:length(spam.docs)],

function(p) get.msg(file.path(easyham.path, p))) 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)

head(easyham.df[with(easyham.df,order(-occurrence)),])

3、构造分类器，将邮件正文输入，输出邮件的类别。

在这个过程中我们将判断的邮件构造成类似上述的矩阵，将判断的邮件与训练数据矩阵取交集，可以得到共有的数据项，这里利用贝叶斯概率来判断，然后将特征词概率乘积，但在这个过程中会出现未知邮件特征词项在训练集中不存在的情况，对于这种情况，nlp 处理通常给特征词一个很小的概率值（0.0001%），下面的过程中有这个实现过程。这里每一个类别的先验概率均为50%，后面会对这个值在讨论，最好是通过正则化来得到先验概率的值。

classify.email <- function(path, training.df, prior = 0.5, c = 1e-6)

{

# Here, we use many of the support functions to get the

# email text data in a workable format

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)

# Now, we just perform the naive Bayes calculation

if(length(msg.match) < 1)

{

return(prior * c ^ (length(msg.freq)))

else

{

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)

我们对语料库中相应的特征词在不同类别中的邮件进行图形可视化，即不同类别邮件中同种特征词的图像的展示。

count.word <- function(path, term)

{

msg <- get.msg(path)

msg.corpus <- Corpus(VectorSource(msg))

# Hard-coded TDM control

control <- list(stopwords = TRUE,

removePunctuation = TRUE,

removeNumbers = TRUE)

msg.tdm <- TermDocumentMatrix(msg.corpus, control)

word.freq <- rowSums(as.matrix(msg.tdm))

term.freq <- word.freq[which(names(word.freq) == term)]

# We use ifelse here because term.freq = NA if nothing is found

return(ifelse(length(term.freq) > 0, term.freq, 0))

}

# Find counts of just terms 'html' and 'table' in all SPAM and EASYHAM docs, and create figure html.spam <- sapply(spam.docs,

function(p) count.word(file.path(spam.path, p), "html")) table.spam <- sapply(spam.docs,

function(p) count.word(file.path(spam.path, p), "table")) spam.init <- cbind(html.spam, table.spam, "SPAM")

head(spam.init)

html.easyham <- sapply(easyham.docs,

function(p) count.word(file.path(easyham.path, p), "html")) table.easyham <- sapply(easyham.docs,

function(p) count.word(file.path(easyham.path, p), "table"))

easyham.init <- cbind(html.easyham, table.easyham, "EASYHAM")

init.df <- data.frame(rbind(spam.init, easyham.init),

stringsAsFactors = FALSE)

head(init.df)

names(init.df) <- c("html", "table", "type")

init.df$html <- as.numeric(init.df$html)

init.df$table <- as.numeric(init.df$table)

init.df$type <- as.factor(init.df$type)

init.plot1 <- ggplot(init.df, aes(x = html, y = table)) +

geom_point(aes(shape = type)) +

scale_shape_manual(values = c("SPAM" = 1, "EASYHAM" = 3), name = "Email Type") +

xlab("Frequency of 'html'") +

ylab("Freqeuncy of 'table'") +

stat_abline(yintersept = 0, slope = 1) +

theme_bw()

init.plot1

ggsave(plot = init.plot1,

filename = file.path("images", "01_init_plot1.pdf"),

width = 10,

height = 10)

init.plot2 <- ggplot(init.df, aes(x = html, y = table)) +

geom_point(aes(shape = type), position = "jitter") +

scale_shape_manual(values = c("SPAM" = 1, "EASYHAM" = 3), name = "Email Type") +

xlab("Frequency of 'html'") +

ylab("Freqeuncy of 'table'") +

stat_abline(yintersept = 0, slope = 1) +

theme_bw()

init.plot2

ggsave(plot = init.plot2,

filename = file.path("images", "02_init_plot2.pdf"),

width = 10,

height = 10)

用所有的邮件类型测试分类器，这里利用一个函数完成上述的判别过程。

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)))

}

作为最后的测试，我们利用第二套数据进行测试。并将函数封装。

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))

}))

spam2.class <- suppressWarnings(lapply(spam2.docs,

function(p)

{

spam.classifier(file.path(spam2.path, p))

}))

Lapply得到的结果是列表，我们利用do.call将结果组织为矩阵形式，然后转为数据框，在得到的结果中标注邮件来自那个文件。

easyham2.matrix <- do.call(rbind, easyham2.class)

easyham2.final <- cbind(easyham2.matrix, "EASYHAM")

head(easyham2.final)

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")

将上述的结果合并组织在一起，转化为数据框形式，并对数据的类型做简单处理，从而为绘制图形作准备。

class.matrix <- rbind(easyham2.final, hardham2.final, spam2.final)

class.df <- data.frame(class.matrix, stringsAsFactors = FALSE)

head(class.df)

names(class.df) <- c("Pr.SPAM" ,"Pr.HAM", "Class", "Type")

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)

str(class.df)

绘制图形

class.plot <- ggplot(class.df, aes(x = log(Pr.HAM), log(Pr.SPAM))) +

geom_point(aes(shape = Type, alpha = 0.5)) +

stat_abline(yintercept = 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())

class.plot

ggsave(plot = class.plot,

filename = file.path("images", "03_final_classification.pdf"),

height = 10,

width = 10)

将不同类型的邮件的结果具体化。

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)

将上述处理过程中的矩阵进行保存，留给下节邮件排序进行处理。

write.csv(spam.df, file.path("D:/R", "spam_df.csv"), https://www.360docs.net/doc/5e12545919.html,s = FALSE)

write.csv(easyham.df, file.path("D:/R", "easyham_df.csv"), https://www.360docs.net/doc/5e12545919.html,s = FALSE)

4、效果改进，修改先验概率，后面的方法与上面相同。这里基于二八原则，正常为八，垃

圾为二，对于这个先验概率可采用正则化进行选择最优化

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)))

}

邮件排序：：基于四个特征：一、社交特征:邮寄的发送者，二、利用系统的时间，衡量收发邮件的时间，三、线程：如果邮件来自已知线程，那么可以确定其活跃度的程度，四、邮件的内容，这里对于内容和标题，我们给予不同值得权重。我们按照时间排序将邮件分成两部分，第一部分用来训练排序系统，另一部分用来测试排序系统。

5、加载相应的包，设置工作路径

library('tm')

library('ggplot2')

library('plyr') ##对数据进行处理

easyham.path <- file.path("D:/R","easy_ham")

构造函数，提取邮件中所有的内容：

msg.full <- function(path)

{

con <- file(path, open = "rt", encoding = "latin1")

msg <- readLines(con)

close(con)

return(msg)

}

对上述邮件内容，我们通过一个正则表达式来提取邮件的发送者的名字：

get.from <- function(msg.vec)

{

from <- msg.vec[grepl("From: ", msg.vec)]

from <- strsplit(from, '[":<> ]')[[1]]

from <- from[which(from != "" & from != " ")]

return(from[grepl("@", from)][1])

}

下面我们提取邮件内容的主题：

get.subject <- function(msg.vec)

{

subj <- msg.vec[grepl("Subject: ", msg.vec)]

if(length(subj) > 0)

{

return(strsplit(subj, "Subject: ")[[1]][2])

}

else

{

return("")

}

}

下面提取邮件的正文：

get.msg <- function(msg.vec)

{

msg <- msg.vec[seq(which(msg.vec == "")[1] + 1, length(msg.vec), 1)]

return(paste(msg, collapse = "\n"))

}

下面对邮件的时间进行提取，由邮件的样式可以看到，时间规则不一致，有各种各样的形式，所以在提取出时间后，我们需要将时间类型转化一致，这一步是单独处理的。

get.date <- function(msg.vec)

{

date.grep <- grepl("^Date: ", msg.vec)

date.grep <- which(date.grep == TRUE)

date <- msg.vec[date.grep[1]]

date <- strsplit(date, "\\+|\\-|: ")[[1]][2]

date <- gsub("^\\s+|\\s+$", "", date)

return(strtrim(date, 25))

}

将上述我们得到的各个特征组织在一起，列为提取的特征，这里有四个特征，行为来自邮件对应的特征值。

parse.email <- function(path)

{

full.msg <- msg.full(path)

date <- get.date(full.msg)

from <- get.from(full.msg)

subj <- get.subject(full.msg)

msg <- get.msg(full.msg)

return(c(date, from, subj, msg, path))

}

提取特征的相应函数已经构造完毕，接下来我们对文件夹的邮件进行上述操作：easyham.docs <- dir(easyham.path)

easyham.docs <- easyham.docs[which(easyham.docs != "cmds")]

easyham.parse <- lapply(easyham.docs,

function(p) parse.email(file.path(easyham.path, p)))

# Convert raw data from list to data frame

ehparse.matrix <- do.call(rbind, easyham.parse)

allparse.df <- data.frame(ehparse.matrix, stringsAsFactors = FALSE)

names(allparse.df) <- c("Date", "From.EMail", "Subject", "Message", "Path")

head(allparse.df)

我们得到的数据中的日期是粗糙的，我们需要对日期进行标准化，在归一化过程中，将第一次的NA值用第二次来替代：

date.converter <- function(dates, pattern1, pattern2)

{

pattern1.convert <- strptime(dates, pattern1)

pattern2.convert <- strptime(dates, pattern2)

pattern1.convert[is.na(pattern1.convert)] <- pattern2.convert[is.na(pattern1.convert)]

return(pattern1.convert)

}

pattern1 <- "%a, %d %b %Y %H:%M:%S"

pattern2 <- "%d %b %Y %H:%M:%S"

allparse.df$Date <- date.converter(allparse.df$Date, pattern1, pattern2) #对上述得到数据处理

最后我们在对上述简单处理的数据在做标准化处理：

allparse.df$Subject <- tolower(allparse.df$Subject)

allparse.df$From.EMail <- tolower(allparse.df$From.EMail)

priority.df <- allparse.df[with(allparse.df, order(Date)), ] ##按时间排序

priority.train <- priority.df[1:(round(nrow(priority.df) / 2)), ] ##取样训练，其余用来测试

6、设置对应特征的权重

先对上述得到的数据按邮件的收发次数，画出最活跃的人通信次数，这里是最低6次。

library(reshape2)

from.weight <- melt(with(priority.train, table(From.EMail)),

https://www.360docs.net/doc/5e12545919.html,="Freq")

head(from.weight)

from.weight <- from.weight[with(from.weight, order(Freq)), ]

from.ex <- subset(from.weight, Freq > 6)

from.scales <- ggplot(from.ex) +

geom_rect(aes(xmin = 1:nrow(from.ex) - 0.5,

xmax = 1:nrow(from.ex) + 0.5,

ymin = 0,

ymax = Freq,

fill = "lightgrey",

color = "darkblue")) +

scale_x_continuous(breaks = 1:nrow(from.ex), labels = from.ex$From.EMail) +

coord_flip() +

scale_fill_manual(values = c("lightgrey" = "lightgrey"), guide = "none") +

scale_color_manual(values = c("darkblue" = "darkblue"), guide = "none") +

ylab("Number of Emails Received (truncated at 6)") +

xlab("Sender Address") +

theme_bw() +

theme(axis.text.y = element_text(size = 5, hjust = 1))

from.scales

ggsave(plot = from.scales,

filename = file.path("images", "0011_from_scales.pdf"),

height = 4.8,

width = 7)

从图中可以看出交流次数的差异是很大的，对此我们对数加权来表示邮件的重要性，以此来标注对应的权重（社交权重）

from.weight <- transform(from.weight,

Weight = log(Freq + 1),

log10Weight = log10(Freq + 1))

将上述转化的结果可视化：

from.rescaled <- ggplot(from.weight, aes(x = 1:nrow(from.weight))) +

geom_line(aes(y = Weight, linetype = "ln")) +

geom_line(aes(y = log10Weight, linetype = "log10")) +

geom_line(aes(y = Freq, linetype = "Absolute")) +

scale_linetype_manual(values = c("ln" = 1,

"log10" = 2,

"Absolute" = 3),

name = "Scaling") +

xlab("") +

ylab("Number of emails Receieved") +

theme_bw() +

theme(axis.text.y = element_blank(), axis.text.x = element_blank())

from.rescaled

ggsave(plot = from.rescaled,

filename = file.path("images", "0012_from_rescaled.pdf"),

height = 4.8,

width = 7)

邮件线程活跃度的权重的计算：

对于收到的邮件我们不知道接收者是否给予回复，为此我们可以按照线程对邮件进行分组，然后衡量每个线程开始之后的活跃时间，来确定线程的权重。

下面可以得到线程：

find.threads <- function(email.df)

{

response.threads <- strsplit(email.df$Subject, "re: ")

is.thread <- sapply(response.threads,

function(subj) ifelse(subj[1] == "", TRUE, FALSE))

threads <- response.threads[is.thread]

senders <- email.df$From.EMail[is.thread]

threads <- sapply(threads,

function(t) paste(t[2:length(t)], collapse = "re: "))

return(cbind(senders,threads))

}

threads.matrix <- find.threads(priority.train)

对线程赋予上述分析中的对数权：

email.thread <- function(threads.matrix)

{

senders <- threads.matrix[, 1]

senders.freq <- table(senders)

senders.matrix <- cbind(names(senders.freq),

senders.freq,

log(senders.freq + 1))

senders.df <- data.frame(senders.matrix, stringsAsFactors=FALSE)

https://www.360docs.net/doc/5e12545919.html,s(senders.df) <- 1:nrow(senders.df)

names(senders.df) <- c("From.EMail", "Freq", "Weight")

senders.df$Freq <- as.numeric(senders.df$Freq)

senders.df$Weight <- as.numeric(senders.df$Weight)

return(senders.df)

}

senders.df <- email.thread(threads.matrix)

head(threads.matrix)

对权重复制，这里用到了变换：

thread.counts <- function(thread, email.df)

{

# Need to check that we are not looking at the original message in a thread,

# so we check the subjects against the 're:' cue.

thread.times <- email.df$Date[which(email.df$Subject == thread |

email.df$Subject == paste("re:", thread))] freq <- length(thread.times)

min.time <- min(thread.times)

max.time <- max(thread.times)

time.span <- as.numeric(difftime(max.time, min.time, units = "secs"))

if(freq < 2)

{

return(c(NA, NA, NA))

}

else

{

trans.weight <- freq / time.span

log.trans.weight <- 10 + log(trans.weight, base = 10)

return(c(freq, time.span, log.trans.weight))

}

}

# This function uses the threads.counts function to generate a weights

# for all email threads.

get.threads <- function(threads.matrix, email.df)

{

threads <- unique(threads.matrix[, 2])

thread.counts <- lapply(threads,

function(t) thread.counts(t, email.df))

thread.matrix <- do.call(rbind, thread.counts)

return(cbind(threads, thread.matrix))

}

thread.weights <- get.threads(threads.matrix, priority.train)

thread.weights <- data.frame(thread.weights, stringsAsFactors = FALSE)

names(thread.weights) <- c("Thread", "Freq", "Response", "Weight")

thread.weights$Freq <- as.numeric(thread.weights$Freq)

thread.weights$Response <- as.numeric(thread.weights$Response)

thread.weights$Weight <- as.numeric(thread.weights$Weight)

thread.weights <- subset(thread.weights, is.na(thread.weights$Freq) == FALSE)

head(thread.weights)

接下来我们得到活跃线程的词项的权重：

term.counts <- function(term.vec, control)

{

vec.corpus <- Corpus(VectorSource(term.vec))

vec.tdm <- TermDocumentMatrix(vec.corpus, control = control)

return(rowSums(as.matrix(vec.tdm)))

}

thread.terms <- term.counts(thread.weights$Thread,

control = list(stopwords = TRUE))

thread.terms <- names(thread.terms)

term.weights <- sapply(thread.terms,

function(t) mean(thread.weights$Weight[grepl(t, thread.weights$Thread, fixed = TRUE)]))

term.weights <- data.frame(list(Term = names(term.weights),

Weight = term.weights),

stringsAsFactors = FALSE,

https://www.360docs.net/doc/5e12545919.html,s = 1:length(term.weights))

接下来我们得到所有邮件共有词项的权重：

msg.terms <- term.counts(priority.train$Message,

control = list(stopwords = TRUE,

removePunctuation = TRUE,

removeNumbers = TRUE))

msg.weights <- data.frame(list(Term = names(msg.terms),

Weight = log(msg.terms, base = 10)),

stringsAsFactors = FALSE,

https://www.360docs.net/doc/5e12545919.html,s = 1:length(msg.terms))

# Remove words that have a zero weight

msg.weights <- subset(msg.weights, Weight > 0)

7、训练和测试排序算法：

首先定义词项查找的权重的函数，包含查找的词项，词项权重的数据框，最后一项为告诉我们是查找线程还是查找词项。

get.weights <- function(search.term, weight.df, term = TRUE)

{

if(length(search.term) > 0)

{

if(term)

{

term.match <- match(names(search.term), weight.df$Term)

}

else

{

term.match <- match(search.term, weight.df$Thread)

}

match.weights <- weight.df$Weight[which(!is.na(term.match))]

if(length(match.weights) < 1)

{

return(1)

}

else

{

return(mean(match.weights))

}

}

else

{

return(1)

}

}

接下来我们开始定义排序函数，该函数将所有的权重值乘在一起，然后再排序，在这里面如果查找不到相应的项，我们将权重复制为1，这个地方的技巧和上面分类的类似：rank.message <- function(path)

{

msg <- parse.email(path)

# Weighting based on message author

# First is just on the total frequency

from <- ifelse(length(which(from.weight$From.EMail == msg[2])) > 0,

from.weight$Weight[which(from.weight$From.EMail == msg[2])],

1)

# Second is based on senders in threads, and threads themselves

thread.from <- ifelse(length(which(senders.df$From.EMail == msg[2])) > 0,

senders.df$Weight[which(senders.df$From.EMail == msg[2])],

1)

subj <- strsplit(tolower(msg[3]), "re: ")

is.thread <- ifelse(subj[[1]][1] == "", TRUE, FALSE)

if(is.thread)

{

activity <- get.weights(subj[[1]][2], thread.weights, term = FALSE)

}

else

{

activity <- 1

}

# Next, weight based on terms

# Weight based on terms in threads

thread.terms <- term.counts(msg[3], control = list(stopwords = TRUE))

thread.terms.weights <- get.weights(thread.terms, term.weights)

# Weight based terms in all messages

msg.terms <- term.counts(msg[4],

control = list(stopwords = TRUE,

removePunctuation = TRUE,

removeNumbers = TRUE))

msg.weights <- get.weights(msg.terms, msg.weights)

# Calculate rank by interacting all weights

rank <- prod(from,

thread.from,

activity,

thread.terms.weights,

msg.weights)

return(c(msg[1], msg[2], msg[3], rank))

}

最后我们将数据分为两类一类训练，一类测试：

train.ranks <- suppressWarnings(lapply(train.paths, rank.message))

train.ranks.matrix <- do.call(rbind, train.ranks)

train.ranks.matrix <- cbind(train.paths, train.ranks.matrix, "TRAINING")

train.ranks.df <- data.frame(train.ranks.matrix, stringsAsFactors = FALSE)

names(train.ranks.df) <- c("Message", "Date", "From", "Subj", "Rank", "Type") train.ranks.df$Rank <- as.numeric(train.ranks.df$Rank)

# Set the priority threshold to the median of all ranks weights

priority.threshold <- median(train.ranks.df$Rank)