用随机森林解决泰坦尼克号沉没问题

机器学习的步骤:先撸一个baseline的model出来,再进行后续的分析步骤,一步步提高,所谓后续步骤可能包括『分析model现在的状态(欠/过拟合),分析我们使用的feature的作用大小,进行feature selection,以及我们模型下的bad case和产生的原因』等等。

kaggle大神说过:
对数据的认识太重要了!
数据中的特殊点、离群点的分析和处理太重要了!
特征工程太重要了!
要做模型融合!

本案例中使用泰坦尼克号乘客数据(姓名,年龄,性别,社会经济阶层等)来预测谁将生存以及谁将死亡。

有两个文件,train.csv和test.csv。Train.csv将包含船上一部分乘客的详细信息(确切地说是891),并将告诉您他们的详细信息以及他们是否幸存。使用您在train.csv数据中找到的模式,您将必须预测其他418名乘客(在test.csv中找到)是否幸免于难。训练和测试数据是一些乘客的个人信息以及存活状况,要尝试根据它生成合适的模型并预测其他人的存活状况。

这是一个二分类问题,是logistic regression所能处理的范畴。
首先通过EXCEL筛选功能可得出近75%的女性幸免于难!然而,只有19%的男性活着告诉它。这是一个非常有前途的猜测!再添加if语句对年龄分类,成年女性(18岁以上)有78%的生存机会,而男性成年人仅有18%的生存机会。您可以看到这与原始比例相比没有太大变化。这告诉我们年龄变量中没有太多额外信息。再来看一个变量:乘客类。比例现在已经发生了巨大变化,这意味着这个变量有一些预测价值。然而,这仍然没有超过男/女分歧。现在让我们了解人们为他们的机票支付的费用,以便每个类别分为以下付款:(i)少于10美元,(ii)介于10美元至20美元之间,(iii)介于20美元至30美元之间,以及(iv)大于$ 30。所有男性仍然无法生存; 然而现在支付超过20美元的三等女性也无法生存。这个小改进应该在排行榜上有所作为!

本例我们使用随机森林方法,随机森林是一种组成式的有监督学习方法,集成学习的基本思想:由多个学习器组合成一个性能更好的学习器(结合几个模型降低泛化误差),集成学习为什么有效?不同的模型通常会在测试集上产生不同的误差。平均上,集成模型至少能与其一成员表现一致;并且如果成员的误差是独立的,集成模型将显著地比其成员表现更好。

集成学习(ensemble learning)通过构建并组合多个学习器来完成学习任务。集成学习通过将多个学习器进行结合,常获得比单一学习器显著优越的泛化性能。

根据个体学习器是否是同类型的学习器(由同一个算法生成,比如C4.5,BP等),分为同质和异质。同质的个体学习器又叫做基学习器,而异质的个体学习器则直接成为个体学习器。

原则:要获得比单一学习器更好的性能,个体学习器应该好而不同。即个体学习器应该具有一定的准确性,不能差于弱学习器,并且具有多样性,即学习器之间有差异。

根据个体学习器的生成方式,目前集成学习分为两大类:
一般是基于个体学习器之间的依赖关系,若个体学习器之间有着强依赖关系、必须串连生成的序列化方法,一般指boosting方法;而个体学习器之间不存在强依赖关系,可以同时生成的并行化方法,有bagging和随机森林等;

随机森林就是用随机的方式建立一个森林,森林里面有很多的决策树,并且每棵树之间是没有关联的。得到一个森林后,当有一个新的样本输入,森林中的每一棵决策树会分别进行一下判断,进行类别归类(针对分类算法),最后比较一下被判定哪一类最多,就预测该样本为哪一类。 即所有决策树预测类别中的众数类别是随机森林所预测的这一样本单元的类别。随机森林算法有两个主要环节:决策树的生长和投票过程。

随机森林实际上是一种特殊的bagging方法,它将决策树用作bagging中的模型。首先,用bootstrap方法生成m个训练集,然后,对于每个训练集,构造一颗决策树,在节点找特征进行分裂的时候,并不是对所有特征找到能使得指标(如信息增益)最大的,而是在特征中随机抽取一部分特征,在抽到的特征中间找到最优解,应用于节点,进行分裂。随机森林的方法由于有了bagging,也就是集成的思想在,实际上相当于对于样本和特征都进行了采样(如果把训练数据看成矩阵,就像实际中常见的那样,那么就是一个行和列都进行采样的过程),所以可以避免过拟合。

Bagging是Bootstrap AggregatING的缩写,是并行式集成学习方法的代表,采样方法是自助采样法,用的是有放回的采样。初始训练集中大约有63.2%的数据出现在采样集中。
Bagging在预测输出进行结合时,对于分类问题,采用简单投票法;对于回归问题,采用简单平均法。

Bagging优点:
高效。Bagging集成与直接训练基学习器的复杂度同阶。
Bagging能不经修改的适用于多分类、回归任务。
包外估计。使用剩下的样本作为验证集进行包外估计(out-of-bag estimate)

随机森林(Random Forest)是Bagging的一个变体。Ramdon Forest在以决策树为基学习器构建Bagging集成的基础上,进一步在决策树的训练过程中引入随机属性选择。

随机森林优点:
由于每次不再考虑全部的属性,而是一个属性子集,所以相比于Bagging计算开销更小,训练效率更高。
由于增加了属性的扰动,随机森林中基学习器的性能降低,使得在随机森林在起始时候性能较差,但是随着基学习器的增多,随机森林通常会收敛于更低的泛化误差,相比于Bagging。

两个随机性的引入,使得随机森林不容易陷入过拟合,具有很好的抗噪声能力
对数据的适应能力强,可以处理离散和连续的,无需要规范化
可以得到变量的重要性, 基于oob误分类率和基于Gini系数的变化

缺点:
在噪声较大的时候容易过拟合

一、获取数据

train<-read.csv("F:\\kaggle\\泰坦尼克号:灾难中的机器学习\\train.csv",header=T,stringsAsFactors=FALSE)
test<-read.csv("F:\\kaggle\\泰坦尼克号:灾难中的机器学习\\test.csv",header=T,stringsAsFactors=FALSE)
#为了处理方便,所以这里要把这两个数据集合并起来
library(dplyr) # 用于加载bind_rows
data<-bind_rows(train,test)#不同于rbind,可以将列数不相等的行合并,test中没有survival一列,自动补为NA
#然后再把同一个数据中分出两个部分来,一个用了训练,一个用来测试
train.row<-1:nrow(train)
test.row<-(1+nrow(train)):(nrow(train)+nrow(test))
attach(data)
str(data)
head(data,3)

数据集包含12个变量,1309条数据,其中891条为训练数据,418条为测试数据
其中:
PassengerId 整型变量,标识乘客的ID,递增变量,对预测无帮助
Survived 整型变量,标识该乘客是否幸存。0表示遇难,1表示幸存。将其转换为factor变量比较方便处理
Pclass 整型变量,标识乘客的社会-经济状态,1代表Upper,2代表Middle,3代表Lower
Name 字符型变量,除包含姓和名以外,还包含Mr. Mrs. Dr.这样的具有西方文化特点的信息
Sex 字符型变量,标识乘客性别,适合转换为factor类型变量
Age 整型变量,标识乘客年龄,有缺失值
SibSp 整型变量,代表兄弟姐妹及配偶的个数。其中Sib代表Sibling也即兄弟姐妹,Sp代表Spouse也即配偶
Parch 整型变量,代表父母或子女的个数。其中Par代表Parent也即父母,Ch代表Child也即子女
Ticket 字符型变量,代表乘客的船票号
Fare 数值型,代表乘客的船票价
Cabin 字符型,代表乘客所在的舱位,有缺失值
Embarked 字符型,代表乘客登船口岸,适合转换为factor型变量(数据模型(随机森林)不支持字符型)

二、特征工程

为了达到预测模型性能更佳,不仅要选取最好的算法,还要尽可能的从原始数据中获取更多的信息。挖掘出更好的训练数据,就是特征工程建立的过程

1.乘客社会等级越高,存活率越高

library(ggplot2) # Data visualization
library(ggthemes) # Data visualization
library(scales) # 把图形弄的更漂亮的,并提供用于自动地确定用于轴和图例符和标签的方法
#首先将Survived因子化,要指出是data中的,否则最后条形图不按0,1分层
data$Survived<-factor(data$Survived)
#用ggplot统计出Pclass的幸存和遇难人数
ggplot(data[1:nrow(train),], aes(x = Pclass, y = ..count.., fill=Survived))+
  geom_bar(stat = "count", position='dodge') + 
  #标题设置
  labs(title="How Pclass impact survivor",y='Count',x='Pclass')+ 
  #文本设置
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1), vjust=-0.5)+ 
  #小题目设置
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

第一二阶层(上层和中层阶级)的幸存率(差不多50%)要远远高于第三阶层的幸存率(25%)。即随着乘客等级越低,在同一等级中的存活率越低

注:关于预测能力的量化指标:
一些具体的量化指标来衡量每自变量的预测能力,并根据这些量化指标的大小,来确定哪些变量进入模型。IV就是这样一种指标,他可以用来衡量自变量的预测能力。类似的指标还有信息增益、基尼系数。

IV的直观解释:假设这个信息总量是I,而这些所需要的信息,就蕴含在所有的自变量C1,C2,C3,……,Cn中,那么,对于其中的一个变量Ci来说,其蕴含的信息越多,那么它对于判断A属于Y1还是Y2的贡献就越大,Ci的信息价值就越大,Ci的IV就越大,它就越应该进入到入模变量列表中。

首先需要认识和理解另一个概念——WOE,因为IV的计算是以WOE为基础的。

WOE的全称是“Weight of Evidence”,即证据权重。WOE是对原始自变量的一种编码形式。

要对一个变量进行WOE编码,需要首先把这个变量进行分组处理(也叫离散化、分箱等等,说的都是一个意思)。分组后,对于第i组,WOE的计算公式如下:



其中,pyi是这个组中响应客户(风险模型中,对应的是违约客户,总之,指的是模型中预测变量取值为“是”或者说1的个体)占所有样本中所有响应客户的比例,pni是这个组中未响应客户占样本中所有未响应客户的比例,#yi是这个组中响应客户的数量,#ni是这个组中未响应客户的数量,#yT是样本中所有响应客户的数量,#nT是样本中所有未响应客户的数量。

从这个公式中我们可以体会到,WOE表示的实际上是“当前分组中响应客户占所有响应客户的比例”和“当前分组中没有响应的客户占所有没有响应的客户的比例”的差异。

对这个公式做一个简单变换,可以得到对于一个分组后的变量,第i 组的WOE为:


变换以后我们可以看出,WOE也可以这么理解,他表示的是当前这个组中响应的客户和未响应客户的比值,和所有样本中这个比值的差异。这个差异是用这两个比值的比值,再取对数来表示的。WOE越大,这种差异越大,这个分组里的样本响应的可能性就越大,WOE越小,差异越小,这个分组里的样本响应的可能性就越小。WOE其实描述了变量当前这个分组,对判断个体是否会响应(或者说属于哪个类)所起到影响方向和大小,当WOE为正时,变量当前取值对判断个体是否会响应起到的正向的影响,当WOE为负时,起到了负向影响。而WOE值的大小,则是这个影响的大小的体现。

同样,对于分组i,也会有一个对应的IV值,计算公式如下:



有了一个变量各分组的IV值,我们就可以计算整个变量的IV值,方法很简单,就是把各分组的IV相加:



其中,n为变量分组个数。

对于变量的一个分组,这个分组的响应和未响应的比例与样本整体响应和未响应的比例相差越大,IV值越大,否则,IV值越小;IV值越高,预测能力最高。



可以算出Pclass的WOE和IV如下:

library(InformationValue) # 算IV跟WOV用的,即高价值数据
WOETable(X=factor(data$Pclass[1:nrow(train)]),Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Pclass[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
library(plyr) #可以进行类似于数据透视表的操作,将数据分割成更小的数据,
#对分割后的数据进行些操作,最后把操作的结果汇总。比如提取首字母,提取姓氏.等等
library(stringr) # String manipulation


从结果可以看出,Pclass的IV为0.5,且“Highly Predictive”,可以将Pclass 作为预测模型的特征变量。

2.乘客头衔Title 对生存率的影响

我们观察名字这一个变量,发现几乎每一个都有Mr. Mrs.
Dr.将这部分信息提取出来后可以作为非常有用一个新变量,可以帮助我们进行预测。此外也可以用乘客的姓代替
家庭,生成家庭变量。

# 从乘客名字中提取头衔
#R中的grep、grepl、sub、gsub、regexpr、gregexpr等函数都使用正则表达式的规则进行匹配。默认是egrep的规则,sub函数只实现第一个位置的替换,gsub函数实现全局的替换。
data$Title <- gsub('(.*, )|(\\..*)', '', data$Name)

# 查看按照性别划分的头衔数量
table(data$Sex, data$Title)

发现头衔的类别太多,并且好多出现的频次是很低的,我们可以将这些类别进行合并

# 合并低频头衔为一类
rareTitle <- c('Dona', 'Lady', 'the Countess','Capt', 'Col', 'Don', 
                'Dr', 'Major', 'Rev', 'Sir', 'Jonkheer')
#重编码变量,将女性以M开头的头衔合并到普通头衔里
data$Title[data$Title=='Mlle']<-'Miss'
data$Title[data$Title=='Ms']<-'Miss'
data$Title[data$Title=='Mme']<-'Mrs'
#把稀有头衔一起放到Rare Title里
data$Title[data$Title %in% rareTitle]<-'Rare Title'
#再次查看按照性别划分的头衔数量
table(data$Sex, data$Title)

下面来看看Title 对生存率的影响

#首先将Title因子化
data$Title<-factor(data$Title)
#用ggplot统计出Title的幸存和遇难人数
ggplot(data[1:nrow(train),], aes(x = Title, y = ..count.., fill=Survived))+
  geom_bar(stat = "count", position='dodge') + 
  #标题设置
  labs(title="How Title impact survivor",y='Count',x='Title')+ 
  scale_fill_discrete(name="Survived", breaks=c(0, 1)) + 
  #文本设置
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1), vjust=-0.5)+ 
  #小题目设置
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

发现不同头衔的幸存率也是不同的。

#算IV和WOV
WOETable(X=factor(data$Title[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Title[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


Title 对survived有很好的预测效果,也需要把Title 添加到预测模型的特征变量中

#最后,从名称中获取到姓氏
#sapply()函数:根据传入参数规则重新构建一个合理的数据类型返回
data$Surname <- sapply(data$Name,  function(x) strsplit(x, split = '[,.]')[[1]][1])

3.乘客性别Sex 对生存率的影响

#首先将Sex因子化
data$Sex<-factor(data$Sex)
#用ggplot统计出Sex的幸存和遇难人数
ggplot(data[1:nrow(train),], aes(x = Sex, y = ..count.., fill=Survived))+
  geom_bar(stat = "count", position='dodge') + 
  #标题设置
  labs(title="How Sex impact survivor",y='Count',x='Sex')+ 
  scale_fill_discrete(name="Survived", breaks=c(0, 1)) + 
  #文本设置
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1), vjust=-0.5)+ 
  #小题目设置
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

女性的幸存率要远远高于男性

#算IV和WOV
WOETable(X=factor(data$Sex[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Sex[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


Sex 对survived有很好的预测效果,也需要把Sex 添加到预测模型的特征变量中

4.乘客年龄Age 对生存率的影响

#将年龄划分成2个阶段 
data$AgeGroup[data$Age < 18] <- 'child'
data$AgeGroup[data$Age >= 18] <- 'adult'
table(data$AgeGroup,data$Survived)

下面分析年龄对生存率的影响

#首先将AgeGroup因子化
data$AgeGroup<-factor(data$AgeGroup)
#用ggplot统计出Sex的幸存和遇难人数
ggplot(data[1:nrow(train),], aes(x = AgeGroup, y = ..count.., fill=Survived))+
  geom_bar(stat = "count", position='dodge') + 
  #标题设置
  labs(title="How AgeGroup impact survivor",y='Count',x='AgeGroup')+ 
  scale_fill_discrete(name="Survived", breaks=c(0, 1)) + 
  #文本设置
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1), vjust=-0.5)+ 
  #小题目设置
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

暂且不管NA (缺失数据)的存活情况,我们可以发现,小孩的成活概率是大于50%的

#算IV和WOV
WOETable(X=factor(data$AgeGroup[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$AgeGroup[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


发现预测能力为somewhat Predictive:有些预测效果,暂且保留这个特征变量,到最后预测模型中对比加入和不加入这个变量对预测结果的影响大小再做结论

虽然电影如实的演示了,“让女性和小孩先走”的这一人道主义原则。但第一条数据就给我们展示出的冰冷的现实。阶层越高,幸存率越高。即在救生船有限的情况下,先让上层阶级的家人(老婆孩子)上救生船。等排到最后的时候才轮到平民阶层的家人(老婆孩子)。

ftable(xtabs(~ Pclass+Sex+Survived, data=data))

第一阶层女性91/94 存活率是0.9680851;第二阶层女性70/76 存活率是0.9210526;第三阶层女性72/144 存活率是0.5

5.配偶及兄弟姐妹数适中的乘客更易幸存

ggplot(data[1:nrow(train),], aes(x = SibSp, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How SibSp impact survivor", x = "SibSp", y = "Count", fill = "Survived") + 
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

配偶及兄弟姐妹数在1的时候幸存率是大于50%的,到了2的时候就成了46.4%。但是高于或者低于1或者2的幸存率就大大降低了

#算IV和WOV
WOETable(X=factor(data$SibSp[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$SibSp[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


SibSp 对survived有很好的预测效果,也需要把SibSp 添加到预测模型的特征变量中

6.父母及子女数适中的乘客更易幸存

ggplot(data[1:nrow(train),], aes(x = Parch, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How Parch impact survivor", x = "Parch", y = "Count", fill = "Survived") + 
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

父母与子女数数目大于等于4或者小于1的幸存率都小于50%

#算IV和WOV
WOETable(X=factor(data$Parch[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Parch[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


Parch 对survived有很好的预测效果,也需要把Parch 添加到预测模型的特征变量中

观察上述两个变量,发现不管是SibSp(配偶及兄弟姐妹数)还是Parch(父母与子女数)其实都是家人的数目,那可以把这俩变量合并到一起

7.家庭规模数量Fsize 对生存率的影响(综合5、6)

# 创建一个包含乘客自己的家庭规模变量
data$Fsize <- data$SibSp + data$Parch + 1
ggplot(data[1:nrow(train),], aes(x = Fsize, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How Fsize impact survivor", x = "Fsize", y = "Count", fill = "Survived") + 
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

家庭成员数在2~4之间的话,个体存活率都会大于50%,而数目为1或者太多的话存活率小

#算IV和WOV
WOETable(X=factor(data$Fsize[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Fsize[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


比前两个因素的IV信息价值高,Fsize 对survived有很好的预测效果,也需要把Fsize添加到预测模型的特征变量中

8.共票号乘客幸存率高

#首先统计出每张票对应的乘客数
ticket.count <- aggregate(data$Ticket, by = list(data$Ticket),
                          function(x) sum(!is.na(x)))
#现将所有乘客按照Ticket分为两组,一组是使用单独票号,另一组是与他人共享票号,并统计出各组的幸存与遇难人数
data$TicketCount <- apply(data, 1, function(x) ticket.count[which(ticket.count[, 1] == x['Ticket']), 2])
#把data里等于1的和大于1的标注成Unique和share
data$TicketCount <- factor(sapply(data$TicketCount, function(x) ifelse(x > 1, 'Share', 'Unique')))
ggplot(data[1:nrow(train),], aes(x = TicketCount, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How TicketCount impact survivor", x = "TicketCount", y = "Count", fill = "Survived")+
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

共票号的幸存率要明显大于不共票号的,猜想共票号的可能是一家人或恋人

#算IV和WOV
WOETable(X=factor(data$TicketCount[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$TicketCount[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


Ticketcount对survived有很好的预测效果,也需要把Ticketcount添加到预测模型的特征变量中

9.支出船票价格对生存率的影响
价格是连续的,采用ggplot中 geom_line()进行模拟

ggplot(data[1:nrow(train), ], aes(x = Fare, fill= as.factor(Survived),color = Survived)) + 
  geom_line(aes(label=..count..), stat = 'bin', binwidth=10)  + 
  labs(title = "How Fare impact survivor", x = "Fare", y = "Count", fill = "Survived")

观察蓝色存活数量的线条,我们可以发现,船票价格越高,生存率越高

#算IV和WOV
WOETable(X=factor(data$Fare[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Fare[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


Fare对survived有很好的预测效果,也需要把Fare添加到预测模型的特征变量中

10.船舱位置Cabin对生存率的影响
Cabin(船舱)这一变量可以看出第一个数值基本上都是一个字母,然后才是一连串数字,其实可以猜到不同的字母表示的就是不同的船舱。所以可以通过字母表示不同船舱的生存率

data$Cabin<-factor(data$Cabin)
ggplot(data[1:nrow(train), ], aes(x = as.factor(sapply(data$Cabin[1:nrow(train)], function(x) str_sub(x, start = 1, end = 1))), y = ..count.., fill = Survived)) +
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How Cabin impact survivor", x = "Cabin", y = "Count", fill = "Survived")+
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5)+
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

不同船舱的生存率不同

#将首字母提出
data$Cabin <- sapply(data$Cabin, function(x) str_sub(x, start = 1, end = 1))
#算IV和WOV
WOETable(X=factor(data$Cabin[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Cabin[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


0.1866526,虽然高价值但是缺失值太多,不太能做一个合格的预测

11.登船位置Embarked对生存率的影响

data$Embarked<-factor(data$Embarked)
ggplot(data[1:nrow(train),], aes(x = Embarked, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How Embarked impact survivor", x = "Embarked", y = "Count", fill = "Survived") + 
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

可以看出字母为S的幸存率比较低,而字母为C的幸存率大于50%

#算IV和WOV
WOETable(X=factor(data$Embarked[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Embarked[1:nrow(train)]), Y=data$Survived[1:nrow(train)])


Embarked 对survived有很好的预测效果,也需要把Embarked添加到预测模型的特征变量中

三、缺失值处理

由于所给的数据集并不大,我们不能通过删除一行或者一列来处理缺失值,因而对于我们关注的一些字段参数,我们需要根据统计学的描述数据(平均值、中位数等等)来合理给出缺失值

summary(data)
library(mice)
md.pattern(data)


Cabin缺失值过多,直接删除,Age有263个缺失,和Fare有1个缺失

1.Age的缺失和填补

#统计年龄的缺失个数
Age_null_count <- sum(is.na(data$Age))

通常我们会使用 rpart (recursive partitioning for regression) 包来做缺失值预测。插值思路是利用rpart(决策树)替代knn来预测缺失值。对于因子类变量而言,我们在调用rpart函数式可以把method设为class(译者注:即用分类树),数值型变量就设定method=anova(回归树)。当然,我们也要避免把响应变量传入函数。

library(rpart) # 回归树的方法,用来预测缺失的数据
age.model <- rpart(Age ~ Pclass + Sex + SibSp + Parch + Fare + Embarked + Title + Fsize, data=data[!is.na(dataAge), ], method='anova') dataAge[is.na(dataAge)] <- predict(age.model, data[is.na(dataAge), ])
在这里使用 mice 包进行处理

# 使自变量因子化
factor_vars <- c('PassengerId','Pclass','Sex','Embarked',
                 'Title','Surname','Fsize')
#lapply()返回一个长度与X一致的列表,每个元素为FUN计算出的结果,且分别对应到X中的每个元素。
data[factor_vars] <- lapply(data[factor_vars],function(x) as.factor(x))
# 设置随机值
set.seed(129)
# 执行多重插补法,剔除一些没什么用的变量:
mice_mod <- mice(data[, !names(data) %in% c('PassengerId','Name','Ticket','Cabin','Family','Surname','Survived')], method='rf') 
# 保存完成的输出 
mice_output <- complete(mice_mod)
#让我们来比较一下我们得到的结果与原来的乘客的年龄分布以确保没有明显的偏差
# 绘制直方图
par(mfrow=c(1,2))
hist(data$Age, freq=F, main='Age: Original Data', 
     col='darkgreen', ylim=c(0,0.04))
hist(mice_output$Age, freq=F, main='Age: MICE Output', 
     col='lightgreen', ylim=c(0,0.04))

右边图和左边图有很高的相似度,所以,我们可以用mice模型的结果对原年龄数据进行替换

# 用mice模型数据替换原始数据
data$Age <- mice_output$Age
# 再次查看年龄的缺失值数据
sum(is.na(data$Age))


2.Fare的缺失与填补

#查看票价的缺失值
getFareNullID <- function(data){
  count <- 0
  for(i in 1:nrow(data))
    if(is.na(data$Fare[i])){
      #打印缺失票价的具体行数
      print(i);
      count <- count+1
    }
  
  return(count)
  
}
fare_null_count <- getFareNullID(data)

得到票价缺失个数为1 ,缺失行数为第1044行

data[1044,]

查看这一行我们会发现,港口和舱位是完整的,我们可以根据相同的港口和相同的舱位来大致估计该乘客的票价,我们取这些类似乘客的中位数来替换缺失的值

#从港口Southampton ('S')出发的三等舱乘客。 从相同港口出发且处于相同舱位的乘客数目
sum(data$Pclass == '3' & data$Embarked == 'S')
# 基于出发港口和客舱等级,替换票价缺失值
data$Fare[1044] <-8.05#8.05为中位数median(data[data$Pclass == '3' & data$Embarked == 'S', ]$Fare, na.rm = TRUE)

四、训练模型

randomForest函数默认生成500棵树,并且默认在每个节点处抽取的变量数,即指定节点中用于二叉树的变量个数,默认情况下数据集变量个数的二次方根(分类模型)或三分之一(预测模型)

#拆分数据集
train <- data[1:891,]
test <- data[892:1309,]
# 构建预测模型
library(randomForest) # 随机森林
library(e1071) # 在机器学习领域,支持向量机SVM(Support Vector Machine)是一个有监督的学习模型, 
#通常用来进行模式识别、分类以及回归分析,文中predict就是这个包的
library(party) # 递归分区的计算工具箱。包的核心是ctree(),这是一个条件推理树的实现,它将树结构的回归模型嵌入到一个明确的条件推理过程理论中。这种非参数类的回归树适用于各种回归问题,包括名义,序数,数字,检查以及多变量响应变量和协变量的任意测量量表。
#基于条件推理树,cforest()提供了布里曼随机森林的实现。
library(class) # 各种分类功能。包括KNN,学习向量量化和自组织图
rf_model <- randomForest(factor(Survived) ~ Pclass + Sex + Age + Fare+ Embarked + Title + Fsize,data = train,na.action=na.roughfix,importance=TRUE)
rf_model

在每棵树的每个节点随机抽取2个变量,从而生成了500棵传统决策树,na.action=na.roughfix参数可将数值变量中的缺失值替换为对应列的中位数,类别变量中的缺失值替换成对应列的众数类(若有多个众数则随机选一个)

注:randomForest包根据传统决策树生成随机森林,而party包中的cforest函数则可基于条件推断树生成随机森林,当预测变量间高度相关时,基于条件推断树的随机森林可能效果更好。

五、交叉验证

一般情况下,应该将训练数据分为两部分,一部分用于训练,另一部分用于验证。或者使用k-fold交叉验证。本文将所有训练数据都用于训练,然后随机选取30%数据集用于验证。

library(MLmetrics) # 衡量回归,分类和排名表现的评估指标的集合,交叉验证的时候用
cv.summarize <- function(data.true, data.predict) {
  print(paste('Recall:', Recall(data.true, data.predict)))  #recall:召回值
  print(paste('Precision:', Precision(data.true, data.predict)))   #precision:精度
  print(paste('Accuracy:', Accuracy(data.predict, data.true)))   #Accuracy:准确性
  print(paste('AUC:', AUC(data.predict, data.true)))  #AUC:Area Under Curve(曲线下面积)
}
set.seed(415)
cv.test.sample <- sample(1:nrow(train), as.integer(0.3 * nrow(train)), replace = TRUE)
cv.test <- data[cv.test.sample,]
#OOB(out-of-bag)即袋外预测误差,是生成树时没有用到的样本点所对应的类别可由生成的树估计时,与其真实类别比较所得的误差
cv.prediction <- predict(rf_model, cv.test, OOB=TRUE, type = "response")
cv.summarize(cv.test$Survived, cv.prediction)

六、重要性排行

# 重要性系数
importance    <- importance(rf_model)
varImportance <- data.frame(Variables = row.names(importance), 
                            Importance = round(importance[ ,'MeanDecreaseGini'],2))

# 创建基于重要性系数排列的变量
rankImportance <- varImportance %>%
  mutate(Rank = paste0('#',dense_rank(desc(Importance))))

# 使用 ggplot2  绘出重要系数的排名
ggplot(rankImportance, aes(x = reorder(Variables, Importance), 
                           y = Importance, data = Importance)) +
  geom_bar(stat='identity') + 
  geom_text(aes(x = Variables, y = 0.5, label = Rank),
            hjust=0, vjust=0.55, size = 4, colour = 'red') +
  labs(x = 'Variables') +
  coord_flip() + 
  theme_few()

最后,我们使用训练好的特征模型作用于测试数据上,得到我们的预测结果

# 对训练集外样本点分类
prediction <- predict(rf_model, test)
# 保存数据结果passagerId 和survived参数
solution <- data.frame(PassengerID = test$PassengerId, Survived = prediction)
# 保存到文件
write.csv(solution, file = 'F:/kaggle/泰坦尼克号:灾难中的机器学习/predict_Solution.csv')
最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 160,026评论 4 364
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 67,655评论 1 296
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 109,726评论 0 244
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 44,204评论 0 213
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 52,558评论 3 287
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 40,731评论 1 222
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 31,944评论 2 314
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 30,698评论 0 203
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 34,438评论 1 246
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 30,633评论 2 247
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 32,125评论 1 260
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 28,444评论 3 255
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 33,137评论 3 238
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 26,103评论 0 8
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 26,888评论 0 197
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 35,772评论 2 276
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 35,669评论 2 271

推荐阅读更多精彩内容