Kaggle项目案例分析 泰坦尼克号生存预测

一、数据来源及说明

 1.1 数据来源

  来自Kaggle的非常经典数据项目   Titanic：Machine Learning

 1.2 数据说明

 数据包含train.csv 和test.csv 两个文件数据集，一个训练用，一个测试用。train文档数据是用来分析和建模，包含泰坦尼克号乘  客的各项基本信息变量和生存情况；test数据是用来最终预测其生存情况并生成结果文件。

二、分析思路

 本项目主要根据train数据的分析并建立模型，预测test数据中乘客在沉船事件中的生存情况。思路如下：

（1）数据整理分析

（2）数据清洗，为建模做准备（如变量整合，建立新变量，填补缺失值空白值）

（3）建立模型并预测，提交网站排名

 三、数据整理分析

3.1 导入数据，初步分析

train<-read.csv("train.csv")

test <- read.csv("test.csv")

library('dplyr') 

binddata<-bind_rows(train,test)      #合并train和test数据

str(binddata)

summary(binddata)

查看后可见数据集包含12个变量，1309条数据，其中891条为训练数据，418条为测试数据。

各变量说明：

PassengerId：标识乘客的ID，对预测无帮助

Survived：生存情况，1为存活，0为死亡

Pclass：客舱等级，1为高级，2为中级，3为低级

Name：乘客名字

Sex：乘客性别

Age：乘客年龄

SibSp：在船兄弟姐妹数/配偶数

Parch：在船父母数/子女数

Ticket：船票编号

Fare：船票价格

Cabin：客舱号

Embarked：登船港口

3.2  各变量对存活率的影响

先看Pclass对存活率的影响

binddata$Survived <- factor(binddata$Survived)

library(ggplot2)

library(ggthemes)

ggplot(data = binddata[1:nrow(train),],aes(x = Pclass, y = ..count.., fill=Survived)) +geom_bar(stat = "count", position='dodge') + 

      xlab('客舱等级') + ylab('乘客数量') + ggtitle('不同客舱等级对存活率的影响') +

      scale_fill_manual(values = c("red","green")) +theme_economist(base_size=16)+


      geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1), vjust=-0.5)

图中可见 Pclass=1的乘客大部分幸存，Pclass=2的幸存乘客接近一半，Pclass=3的乘客不到25%。建模前，为了对自变量进行筛选，可用WOE和IV值来衡量Pclass的预测能力。从结果可以看出，Pclass的IV为0.5009497，且“Highly Predictive”。由此可以暂时将Pclass作为预测模型的特征变量之一。

library(InformationValue)

WOETable(X=factor(binddata$Pclass[1:nrow(train)]), Y=binddata$Survived[1:nrow(train)])

IV(X=factor(binddata$Pclass[1:nrow(train)]), Y=binddata$Survived[1:nrow(train)])

从结果可以看出，Pclass的IV为0.5009497，且“Highly Predictive”。由此可以暂时将Pclass作为预测模型的特征变量之一。

同理，其它变量（Name，Sex，Age，SibSp，Parch，Ticket，Fare，Cabin，Embarked）可参照以上方法，做图表可视化和计算出InformationValue，从而协助筛选部分变量来建立预测模型。这里省略显示。

四、数据清洗，变量整合

4.1 通过提取变量Name，新建变量Title

Name本身没有辨识意义，但是Name中含有诸如Mr. Miss类的称呼，将其提取出来。

binddata$Title <- gsub('(.*, )|(\\..*)', '', binddata$Name)

table(binddata$Title)

binddata$Title[binddata$Title == 'Ms']          <- 'Miss'

rare_title <- c('Dona', 'Lady', 'the Countess','Capt', 'Col', 'Don',Dr', 'Major', '

                           Rev', 'Sir', 'Jonkheer')                      #把较少的称呼抬头整合一起

binddata$Title[binddata$Title == 'Mlle']        <- 'Miss'                #把称呼Melle归入Miss，下同

binddata$Title[binddata$Title == 'Ms']          <- 'Miss'

binddata$Title[binddata$Title == 'Mme']        <- 'Mrs'                                  


binddata$Title[binddata$Title %in% rare_title]  <- 'Rare Title'

4.2 新建变量Family ID，并赋值

Name中还含有家庭信息，也将其提取出来

binddata$Fsize <- binddata$SibSp + binddata$Parch + 1       # 新建变量“Fsize”，意思是家庭规模

binddata$Surname <- sapply(binddata$Name, FUN=function(x) {strsplit(x, split='[,.]')[[1]][1]})               #从Name中提取出Surname

binddata$FamilyID <- paste(as.character(binddata$FSize), binddata$Surname, sep="")                           #形成新变量”FamilyID“,

binddata$FamilyID[binddata$Fsize <= 2] <- 'Small'        #对”FamilyID“赋值，对于Fsize小于等于2的标记为Small

famIDs <- data.frame(table(binddata$FamilyID))                          #删除错误的famIDs

famIDs <- famIDs[famIDs$Freq <= 2,]

FamilyID[binddata$FamilyID %in% famIDs$Var1] <- 'Small'

4.3  新建TicketCount变量，并赋值

binddatat <- binddata %>%                              #通过票号进行分组，保存为单独的数据框binddatat

         group_by(Ticket) %>%

         count()

table(binddatat$n)

说明1309个人中，713种票号是不重复的，132种票号出现了2次，占264人，以此类推……

binddatat <- as.data.frame(binddatat)

binddata$TicketCount <- apply(binddata, 1, function(x)binddatat[which(binddatat['Ticket'] == x['Ticket']), 2])      #对binddata数据集的TicketCount赋值

binddata$TicketCount[binddata$TicketCount != 1] <-'share'    

binddata$TicketCount[binddata$TicketCount == 1] <-'unique'   #根据标识不为1的赋值为share，否则赋值为unique

4.4  填补缺失值，空白值

先观测缺失值，空白值

colSums(sapply(binddata,is.na))

sapply(binddata,function(x)sum(x==""))

which(is.na(binddata$Fare))

结果发现Age有263个缺失值，Fare中NA的行号是1044

binddata[1044,]$Fare <- 8.05     #通过binddata[1044,]观察信息，可得到他的Pclass和Embarked，汇总分析并赋值

binddata$Embarked[c(62, 830)] <- 'S'             #Embarked也同样，得到基本信息，找到大类，汇总分析并赋值

然后就是通过mice函数对变量Age进行插补

library('mice')

library('lattice')

newdata <- bind_rows(train,test)

imp <- mice(newdata[,-2],m=5,method = 'rf',maxit = 500,seed = 5514)

miceout <- complete(imp)

binddata$Age <- miceout$Age

4.5  对变量进行筛选

（1）从第二节可知，票价（Fare）、船舱等级（Pclass）、性别（Sex）等变量确实在这场的逃生预测中起到了关键作用。

（2）另外，为了简化模型变量，避免过度拟合，需要减少一些预测能力较低或者重复的变量。

         从Name中提取了Title，所以Name这个变量去掉。

         SibSp、Parch我们进行重构成Fsize、FamilyID，所以去掉变量 SibSp、Parch。

         从Ticket 中提取了 TicketCount，所以 Ticket 这个变量去掉。

（3）Cabin空白缺失值太多不予考虑

  这样，入选的变量就是

  Pclass 船舱等级 +Sex 性别+ Age 年龄+ Fare 票价+ Embarked 登船港口+ 

  Title 称呼+ Fsize 家庭规模+ FamilyID 家族+ TicketCount 是否共票

五、建立模型并预测

library(randomForest)

library('party')

library('zoo')

binddata$Age <- factor(binddata$Age)                        #将变量转化为factor格式，下同

binddata$Embarked <- factor(binddata$Embarked)

binddata$Title <- factor(binddata$Title)

binddata$Fsize <- factor(binddata$Fsize)

binddata$FamilyID <- factor(binddata$FamilyID)

binddata$TicketCount <- factor(binddata$TicketCount)

先把合并的数据再分开

train1 <- binddata[1:891,]

test1 <- binddata[892:1309,]

然后建立随机森林模型

model <- cforest(Survived ~ Pclass +Sex + Age + Fare + Embarked + Title + Fsize +

        FamilyID + TicketCount, data =  train1,controls = cforest_unbiased(ntree=2000,mtry=3))

Prediction <- predict(model, test1, OOB=TRUE, type = "response")

submit <- data.frame(PassengerId = test$PassengerId, Survived = Prediction)

write.csv(submit,file = "G:/forest.csv",row.names = FALSE)

在kaggle中上传submission，看看预测准确率

得分0.81568，9千多参赛作品中排名263名

六、模型心得

随机森林是一种多功能的机器学习算法，能够执行回归和分类的任务。优点是能处理很高维度（feature很多）的数据，它可以处理成千上万的输入变量，并确定最重要的变量。在训练过程中，能够检测到feature间的互相影响。