R基于Bayes理论实现中文人员特性的性别判定

Posted on 2017-12-02 07:03 天戈朱阅读(815) 评论(0) 编辑收藏举报

参见基于中文人员特征的性别判定方法理论，告诉一个名字，来猜猜是男是女，多多少少有点算命的味道。此命题是一种有监督的学习方法，从标注好的训练数据学习到一个预测模型，然后对未标注的数据进行预测。

1、首先，有监督的学习方法，就需要这样一批标注数据：大量的人名，以及其性别。训练数据集参考 SofaSofa-数据科学社区及其它网页爬取的数据：

2、对下载的数据进行清洗及特征提取，其流程如下：

根据姓氏辞典把姓氏去掉，留下不带姓氏的名字；
参见上一篇论文，特征有三个维度，分别用X1,X2,X3(=X1X2)表示。如果是单字名，则X1为空格，X2为单字名，X3就是前两者拼接X1X2，清洗后的数据如下，gname (1:男，0:女）
数据清洗示例代码：

remove(list = ls())
space_path <- c("E:\\Teld_Work\\15_UserProfile\\srccode")
setwd(space_path)
Sys.setlocale(category = "LC_ALL",local="chinese")


##读取本地数据
##数据下载地址：http://sofasofa.io/competition.php?id=3& 及其它网络地址爬取
tbl1 <- read.table(file = "train.txt",header = TRUE,sep = ",",fill = TRUE,encoding = "UTF-8")
df <- data.frame(tbl1)

##将数据转入SqlServer进行清洗
chl <- odbcConnect("testsql", uid = "sqladmin", pwd = "123456a?")
sqlSave(chl,df,tablename = "U_demo")
close(chl)

##获取清洗完成的数据
library(RODBC)
chl <- odbcConnect("testsql", uid = "sqladmin", pwd = "123456a?")
df <- sqlQuery(chl,"select fn1,fn2,fn,gname from U_SexByNameSample")
close(chl)

##将数据转存为本地rda文件
save(df,file = "sexbyname.rda")

始于贝叶斯公式，对于名字X1X2,工程实现中，在预测阶段，可能会遇到一些特征在训练样本中没有，则需要做一下平滑（比如分子加一个很小的值），不然男女概率都为0，无法预测。
- P(男|X1X2)=P(男)*P(X1|男)*P(X2|男)*P(X1X2|男)
- P(女|X1X2)=P(女)*P(X1|女)*P(X2|女)*P(X1X2|女)
- 特别注意的是，P(X1|男)表示的是训练样本中，男性用户中，名字第一个字出现X1的概率，如果第二个字出现X1，不算在这里。
示例代码如下：

remove(list = ls())
space_path <- c("E:\\Teld_Work\\15_UserProfile\\srccode")
setwd(space_path)

##姓名拆分
buildVe <- function(name)
{
  len <- nchar(name)
  f2 <- substr(name,len,len)
  f1 <- c("")
  if (len > 2)
  {
    f1 <- substr(name,len-1,len-1)
  }
  fn <- paste0(f1,f2)
  
  return(c(f1,f2,fn))
}


#模型  
naive.bayes.prediction <- function(name) 
{ 
  if (exists("sexDf") == FALSE)
  {
    load("sexbyname.rda")  
  }
  
  smv <- 0.001;   #解决特征在样本中没有的场景
  vec <- buildVe(name);
  
  #计算先验概率 
  sex.M <- (sum(sexDf[,4] == "1") + smv)/ length(sexDf[,4]);  
  sex.F <- (sum(sexDf[,4] == "0") + smv)/ length(sexDf[,4]);
  
  # 计算 name 是男性概率  
  pred.M <-  
    (sum((sexDf[,1] == vec[1]) & (sexDf[,4] == "1")) + smv) / sum(sexDf[,4] == "1") * 
    (sum((sexDf[,2] == vec[2]) & (sexDf[,4] == "1")) + smv) / sum(sexDf[,4] == "1") * 
    (sum((sexDf[,3] == vec[3]) & (sexDf[,4] == "1")) + smv) / sum(sexDf[,4] == "1") * 
    sex.M; 
  
  # 计算 name 是女性概率  
  pred.F <-  
    (sum((sexDf[,1] == vec[1]) & (sexDf[,4] == "0"))+ smv) / sum(sexDf[,4] == "0") * 
    (sum((sexDf[,2] == vec[2]) & (sexDf[,4] == "0"))+ smv) / sum(sexDf[,4] == "0") * 
    (sum((sexDf[,3] == vec[3]) & (sexDf[,4] == "0"))+ smv) / sum(sexDf[,4] == "0") * 
    sex.F;  
  
 ## return(list(post.pred.M = pred.M,  
 ##              post.pred.F = pred.F,  
 ##              prediction  = ifelse(pred.M >= pred.F, "男", "女")));  
  return(paste0("pred.M:",pred.M,",pred.F:",pred.F,"; --prediction:",ifelse(pred.M >= pred.F, "男", "女")))
}

在实际应用中，这个模型适合于我们知道用户姓名但是不知道性别的情况，比如某电商网站，一般情况用户订单中填的收货人姓名都是真实的，注册信息中可能带有性别但是不靠谱可能是乱填的，随便写俩人员通过模型预估结果如下：

> naive.bayes.prediction("刘德华")
[1] "pred.M:2.03045549425324e-09,pred.F:1.68712051662787e-11; --prediction:男"
> naive.bayes.prediction("张学友")
[1] "pred.M:2.24279371989392e-11,pred.F:2.30827962001087e-16; --prediction:男"
> naive.bayes.prediction("金星")
[1] "pred.M:6.28564627624871e-09,pred.F:7.02613664124613e-10; --prediction:男"
> naive.bayes.prediction("李玉刚")
[1] "pred.M:6.06865747851669e-11,pred.F:1.22259348253025e-15; --prediction:男"
> naive.bayes.prediction("李冰冰")
[1] "pred.M:4.61521485457943e-11,pred.F:1.35846175847352e-10; --prediction:女"
> naive.bayes.prediction("章子怡")
[1] "pred.M:4.51645469372974e-09,pred.F:5.16427477696052e-09; --prediction:女"
>