R字符串处理应用之邮件考勤自动化
引言
最近发现，担任助教真不是一件轻松的事情啊。虽然老师一直在想方设法减轻我的工作负担，可是核对名单真的是一件考验眼力和耐力的事情。
最近有一件非常艰巨的任务：检查上周的『考勤邮件』。这个『考勤邮件』，容我耐心的解释一番。上周，老师为了不浪费大家的时间，通过在某几分钟内发送一封邮件到公共邮箱的方法来签到。
而我今天才拿到选课学生的名单。我们知道，邮件过了一段时间，标题显示的接收时间就会改变。这个时候，为了确定邮件的发送时间，我必须要每封邮件都打开来看一下，再找到相应的名单，然后打上一个满意的勾。然而，这可是五十多封邮件啊！！！
立志成为数（一）据（名）科（懒）学（人）家的我，怎能甘心做如此机械的活呢？于是，想起最近总结的一篇字符处理相关的博客，正好可以用上。
说干就干！下面，我们就来探索一番，如何用R实现邮件考勤全自动化。
载入数据
首先，从公共邮箱批量下载数据。并载入R。
library(stringr)
library(openxlsx)
#load Name list
NameInformation<-read.xlsx("data/名单_20160308.xlsx",sheet = 1,colNames = TRUE)
str(NameInformation)
NameList<-NameInformation$姓名
NameList<-str_trim(NameList)
#read E-mail name
EmailName<-dir("data/第一次考勤/信件打包")
查看缺勤人员名单
载入数据的第一步，当然是先看看是否全勤啦～
如果没人缺勤，后面的日期提取等脏活累活就可以不用干啦！（再次暴露了懒人的本性= =!）
#match name list,remove E-mails which's subject NOT contain names ON the namelist
# detact weather the subject contains the name
ExistStatus<-lapply(NameList, function(x){
Exist<-str_detect(EmailName,x)
return(sum(Exist))
})
ExistStatus<-unlist(ExistStatus)
# find not checked names
print(paste0("缺勤的同学：",NameList[!ExistStatus]))
#str_detect(EmailName,"张三")
果不其然，有些同学还是不够团结啊！有几个没发邮件的。当然，谨慎的黄老师还是用str_detect()函数重新核对了一下，误伤了同学可不好办呐。
提取邮件接收时间
打开文本编辑器，仔细看了一下几封邮件，发现日期格式大概是这样的：
Date: Wed, 2 Mar 2016 08:06:28 +0800
先将邮件内容读入一个list。接着，用正则表达式，把含有Date: Wed, 2 Mar 2016字样的这一行提取出来。然后，只提取我们需要的时间。最后，使用striptime()函数将字符串转换成时间格式。然而，在Windows下一直得到的返回值一直是NA，在Linux下可以正确转换。万恶的微软！
###########################
## check in email received time ###
# get email content
EmailContent<-lapply(EmailName,function(x){
readLines(con<-file(paste0("data/第一次考勤/信件打包/",x),encoding = 'UTF-8'))
})
# get date and time
EmailDate<-lapply(EmailContent,function(x){
date_vec<-str_subset(x,"Date: Wed, 2 Mar 2016")
date<-str_sub(date_vec,start = 7, end = 30)
return(date)
})
# format conveting
## windows 下有问题，linux下没问题
EmailDate<-lapply(EmailDate,function(x){
strptime(x,"%a, %d %b %Y %I:%M:%S")
})
EmailDate<-unlist(EmailDate)
提取名字
为了做到有凭有据，还是要从主题提取一下名字。这个时候，跟已有的选课名单进行一一匹配即可。
然而，我们的课实在太火爆！有些没有选到课的同学，为了刷刷自己的存在感，也发来了『贺电』。这可不好办！！！如果是一个个核对，找了半天，发现没在选课名单上，岂不气煞人也！然而，有了R，我只需要一个IF语句就搞定啦。
还有一些不知是手抖还是为了刷存在感，的同学，连发了几封E-mail。当然，我并没有生气，我只需要一行代码就可以轻松化解难题。
########################################33
## exteact name on the subject ##
NameOnSubject<-lapply(EmailName,function(x){
ExtractName<-str_extract(x,NameList)
## 有的同学没有选课也发了邮件，或者不小心下载了垃圾邮件
if(sum(is.na(ExtractName))==51){
return(NA)
}
else{
Name<- ExtractName[!is.na(ExtractName)]
return(Name)
}
})
### combine Date and name
NameOnSubject<-unlist(NameOnSubject)
EmailData<-data.frame(CheckTime= EmailDate,NameOnSubject = NameOnSubject,stringsAsFactors = FALSE)
#先去掉名字为NA的邮件
EmailData<-EmailData[!is.na(EmailData$NameOnSubject),]
# 有的同学手抖，发了几封邮件,需要去重
EmailData<-EmailData[!duplicated(EmailData[,"NameOnSubject"]),]
View(EmailData)
str(EmailData)
合并数据集
最后，跟选课名单进行合并即大功告成啦！
CheckInNameList<-data.frame(Name = NameInformation$姓名,CheckInStatus = ExistStatus)
str(CheckInNameList)
# merge namelist and the EmailData
CheckInNameData<-merge(x = CheckInNameList, y = EmailData, by.x = "Name",
by.y = "NameOnSubject",all = TRUE,all.x = TRUE )
library(DT)
datatable(CheckInNameData)
其实仔细想想，邮箱考勤这个机制存在很大的bug。
我们可以一起发挥智慧，思考一下如何加入防作弊机制。如给每个在场的人发送一个唯一的随机码随邮件发送？（不想上课的同学会不会打我？！逃～～～～）
参考文献：
R中的正则表达式及字符处理函数总结
黄耀鹏，R语言中文社区专栏作者，统计硕士生，R User，喜欢历史八卦。
博客：http://yphuang.github.io/
微信回复关键字即可学习
回复 R R语言快速入门免费视频
回复 统计 统计方法及其在R中的实现
回复 用户画像 民生银行客户画像搭建与应用
回复 大数据 大数据系列免费视频教程
回复 可视化 利用R语言做数据可视化
回复 数据挖掘 数据挖掘算法原理解释与应用
回复 机器学习 R&Python机器学习入门