基于R语言的Kaggle案例分析-泰坦尼克号

背景

泰坦尼克号由位于北爱尔兰贝尔法斯特的哈兰·沃尔夫船厂兴建，是当时最大的客运轮船，由于其规模相当一艘现代航空母舰，因而号称“上帝也沉没不了的巨型邮轮”。在泰坦尼克号的处女航中，从英国南安普敦出发，途经法国瑟堡-奥克特维尔以及爱尔兰昆士敦，计划横渡大西洋前往美国纽约市。但因为人为错误，于1912年4月14日船上时间夜里11点40分撞上冰山；2小时40分钟后，即4月15日凌晨02点20分，船裂成两半后沉入大西洋，死亡人数超越1500人，堪称20世纪最大的海难事件，同时也是最广为人知的海难之一。

数据

变量名称	描述
Survived	幸存（1）或死亡（0）
Pclass	船舱等级
Name	姓名
Sex	性别
Age	年龄
sibsp:Sibling	兄弟姐妹
Sibsp:Spouse	配偶（包二奶和未婚夫被忽略）
Parch:Parent	母亲和父亲
Parch:Child	女儿,儿子,继女,继子,孩子只和保姆旅行，对他们来说PARCH= 0
Ticket	票号
Fare	票价
Cabin	船仓号
Embarked	起点港口,C = Cherbourg, Q = Queenstown, S =Southampton

载入包

library('ggplot2') #可视化
#library('ggthemes') #可视化
#library('scales') #可视化
library('dplyr') #数据处理
library('mice') #插补
library(rpart)#决策树算法
library(rpart.plot)#绘制决策树
library(randomForest) #随机森林算法

导入数据

bind_rows是dplyr包的函数，因为我拿到的数据中，train和test的字段顺序不一样，所以直接进行rbind会出问题，所以使用bind_rows

train <- read.csv('train.csv', stringsAsFactors = F)
test  <- read.csv('test.csv', stringsAsFactors = F)
full  <- bind_rows(train, test) 
summary(full)#存在缺失值，后面需要进行处理

特征工程

从乘客姓名中获取称谓
“ Cavendish, Mrs. Tyrell William (Julia Florence Siegel)" 实际上取得是第一个逗号后和第一个点号前的数据

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

#按性别显示统计数量
table(full$Title,full$Sex)

#数非常低的字段要合并到“rare“
rare_title <- c('Dona', 'Lady', 'the Countess','Capt', 'Col', 'Don', 
                'Dr', 'Major', 'Rev', 'Sir', 'Jonkheer')

# 同时重新分配mlle，ms和mme
full$Title[full$Title == 'Mlle']        <- 'Miss' 
full$Title[full$Title == 'Ms']          <- 'Miss'
full$Title[full$Title == 'Mme']         <- 'Mrs' 
full$Title[full$Title %in% rare_title]  <- 'Rare Title'
full$Title<-as.factor(full$Title)#将称谓置成因子型

#再按性别显示Title数量
table(full$Sex, full$Title)

Title	female	male
Master	0	61
Miss	264	0
Mr	0	757
Mrs	198	0
Rare Title	4	25

我们将根据兄弟姐妹/配偶的数量制作一个家庭大小变量,（可能有人有一个以上的配偶）和孩子/父母的数量。

#创建一个包括乘客本身的家庭大小变量
#家庭规模=兄弟姐妹+配偶+自己
full$Fsize <- full$SibSp + full$Parch + 1

#使用ggplot2可视化家庭规模与生存之间的关系
ggplot(full[1:891,], aes(x = Fsize, fill = factor(Survived))) +
  geom_bar(stat='count', position='dodge') +
  scale_x_continuous(breaks=c(1:11)) +
  labs(x = 'Family Size')

我们可以看到,对于单身人士和家庭人数超过4人的人来说，死亡的占比会较高。我们可以将这个变量分解为三个级别，创建一个家庭规模变量。

#家庭规模
full$FsizeD[full$Fsize == 1] <- 'singleton'
full$FsizeD[full$Fsize < 5 & full$Fsize > 1] <- 'small'
full$FsizeD[full$Fsize > 4] <- 'large'

library(sqldf)
full1<-sqldf('select FsizeD,Survived,count(1) as cnt from full where Survived>=0 group by FsizeD,Survived')
ggplot(full1,aes(x=FsizeD,y=cnt,fill=Survived))+geom_col(position="fill")

柱状图表明，单身人士和大家庭中存在幸存率较低，但小家庭的乘客幸存率占优势

62和830号乘客缺少出发港口的信息,接下来我们进行缺失值填补，我们将根据我们能够想象到的可能相关的当前数据：船舱登记和票价推断他们的出发港口。
#我们看到，他们分别支付80美元和NA，他们的船舱等级是1和NA。那么他们从哪里出发呢？

full[c(62, 830), 'Embarked']

#其他乘客信息
embark_fare <- full %>%
  filter(PassengerId != 62 & PassengerId != 830)

# 使用ggplot2可视化登船，乘客舱和中位数票价
ggplot(embark_fare, aes(x = Embarked, y = Fare, fill = factor(Pclass))) +
  geom_boxplot() +
  geom_hline(aes(yintercept=80), 
    colour='red', linetype='dashed', lwd=2) +
  scale_y_continuous(labels=dollar_format()) +
  theme_few()

从Charbourg（‘C’）起飞的头等舱乘客的中位数票价与我们的乘客缺货乘客支付的80美元相吻合。 由于他的头等舱票价是80美元，他们很可能从’C’出发

full$Embarked[c(62, 830)] <- 'C'

第1044行乘客缺失票价信息，这是一名南安普敦（‘S’）的三等乘客。 我们使用同样的南安普敦的三等座的有票价的票价的中位数替换缺失值

full$Fare[1044] <- median(full[full$Pclass == '3' & full$Embarked == 'S', ]$Fare, na.rm = TRUE)

最后，我们的数据中有一些缺失的Age值。 我们将基于其他变量对Age进行预测,我们使用rf（随机森林）来预测缺失的年龄，使用mice包来完成这项任务,你可以在 https://blog.csdn.net/sinat_26917383/article/details/51265213 中查看主要mice处理缺失值的方法

#显示缺少年龄值的数量
sum(is.na(full$Age))

#将变量因素纳入因子
factor_vars <- c('PassengerId','Pclass','Sex','Embarked',
                 'Title','Surname','FsizeD')
full[factor_vars] <- lapply(full[factor_vars], function(x)as.factor(x))
#设置随机种子
set.seed(129)
#执行mice插补，排除某些不太有用的变量：
mice_mod <- mice(full[, !names(full) %in% c('PassengerId','Name','Ticket','Cabin','Family','Surname','Survived')], method='rf') 

#输出
mice_output <- complete(mice_mod)
#绘制年龄分布
par(mfrow=c(1,2))
hist(full$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生成的值

# 将Age变量替换为mice模型。
full$Age <- mice_output$Age

# 显示缺少年龄值的新数量
sum(is.na(full$Age))

终于完成了对泰坦尼克数据集中所有相关缺失值的处理,还成功地创建了几个新变量，我们希望这些变量可以帮助我们建立一个可靠地预测生存的模型

建模

我们将依赖于randomForest分类算法

#分为训练和测试集
train <- full[1:891,]
test <- full[892:1309,]

#建立模型
#然后我们使用训练集上的`randomForest`构建我们的模型。
#构建模型（注意：并非使用所有可能的变量）
rf_model <- randomForest(factor(Survived) ~ Pclass + Sex + Age + SibSp + Parch + Fare + Embarked + Title + FsizeD,importance=T,data = train)

黑线表示整体错误率低于20％。 红线和绿线分别显示“死亡”和“幸存”的错误率。 我们可以看到，现在我们在预测死亡方面比预测生存的错误率更低

#变量的重要性
varImpPlot(rf_model)

我们以基尼系数的平均减少来看相对变量的重要性，其中最为重要的变量是Titel，而pclass变量相对而言不是那么的重要

预测

#预测使用测试集
prediction <- predict(rf_model, test)

#将解决方案保存到具有两列的数据框：
solution <- data.frame(PassengerID = test$PassengerId, Survived = prediction)
#写入csv文件
write.csv(solution, file = 'rf_mod_Solution.csv', row.names = F)

文章参考：
https://www.kaggle.com/nadintamer/titanic-survival-predictions-beginner
https://blog.csdn.net/yyxyyx10/article/details/78223196