【Kaggle实例分析】Titanic Machine Learning from Disaster

【Kaggle实例分析】Titanic Machine Learning from Disaster

你是不是也学了很久R语言的却还没有完完整整的把数据分析的整个流程走一遍。

跟着本文操作练习也许会是个不错的开始。

看完本文你将了解到:

1. 如何用R语言进行数据分析

2. 数据分析师的主要工作流程

3. 如何参加Kaggle比赛


======================


引言

本文采用Kaggle中比较知名的数据集Titanic Machine Learning from Disaster作为分析数据源。分析目的是根据训练集预测部分乘客在沉船事件中是否会存活?

当然不是问你Jack &Rose ^_^

该数据集被评为五大最适合数据分析练手项目之一。Five data science projects to learn data science

说明:本文除了细微处有所改动外,主体部分翻译借鉴自Megan L. Risdal文章。

本文的基本按照数据分析的整个流程进行:


  • 数据清洗
  • 特征工程
  • 缺失值
  • 模型设计与预测

下面具体看来

=======================

数据导入与概览

# 加载相应包
library('ggplot2') # 可视化
library('ggthemes') # 可视化
library('scales') # 可视化
library('dplyr') # 数据处理
library('mice') # 缺失值填补
library('randomForest') # 建模 

加载完毕后,先将数据导入

【为了保证文章的可读性,部分代码运行结果以图片形式贴出】

train <- read.csv('train.csv', stringsAsFactors = F)
test  <- read.csv('test.csv', stringsAsFactors = F)
#初步观察数据
# 检查数据
str(train)
str(test)
head(train)
head(test)
#可以看到,除了Survived字段不同外,其他字段均相同。合并训练集与测试集,为下一步数据清洗做准备
full  <- bind_rows(train, test) 
str(full)
summary(full)

合并后的数据除了生存情况(Survived)中缺失值NA有418个(需要预测的),年龄(Age)中缺失值有263个,船票费用(Fare)中缺失值有1个。

目前,我们已经对变量,变量类型,及其前几个取值情况有了初步的了解。 我们知道:我们有1309 个观测,其中训练集891个,测试集418个。 我们的目标是要预测生存情况(Survived)——因变量 可供使用的自变量11个

其各个变量对应的含义列示如下

-------------------------------

数据清洗

a. 观察姓名变量

首先,我注意到在乘客名字(Name)中,有一个非常显著的特点:乘客头衔每个名字当中都包含了具体的称谓或者说是头衔,将这部分信息提取出来后可以作为非常有用一个新变量,可以帮助我们预测。此外也可以用乘客的姓代替家庭,生成家庭变量。下面开始着手操作!

# 从乘客名字中提取头衔
full$Title <- gsub('(.*, )|(\\..*)', '', full$Name)

# 查看按照性别划分的头衔数量?
table(full$Sex, full$Title)
# 对于那些出现频率较低的头衔合并为一类  
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'

# 重新查看替换后的情况
table(full$Sex, full$Title)
# 最后从乘客姓名中,提取姓氏
full$Surname <- sapply(full$Name, function(x) strsplit(x, split = '[,.]')[[1]][1])

我们有 875 唯一姓氏. 有时间的话可以通过发掘乘客姓氏之间的联系,也许会有意外发现,这里就先不做深入探讨了.

b.家庭情况是否会影响生存结果?

目前为止我们已经处理完乘客姓名这一变量,并从其中提取了一些新的变量。 下一步考虑衍生一些家庭相关的变量 首先,生成家庭人数family size 这一变量。可以基于已有变量SubSp和Parch(具体含义参照上面)

# 生成家庭人数变量,包括自己在内
full$Fsize <- full$SibSp + full$Parch + 1

# 生成一个家庭变量:以姓_家庭人数 格式
full$Family <- paste(full$Surname, full$Fsize, sep='_')

# 使用 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') +
  theme_few()
通过图形我们可以明显发现以下特点:

- 1 个人上船和家庭人数>4人的家庭的存活人数小于死亡人数

- 2 家庭人数size在[2:4]的存活人数要高于死亡人数

因此我们可以将家庭人数变量进行分段合并,明显的可以分为3段:个人,小家庭,大家庭,由此生成新变量.

# 离散化
full$FsizeD[full$Fsize == 1] <- 'singleton'
full$FsizeD[full$Fsize < 5 & full$Fsize > 1]<- 'small'
full$FsizeD[full$Fsize > 4] <- 'large'

# 通过马赛克图(mosaic plot)查看家庭规模与生存情况之间关系
mosaicplot(table(full$FsizeD,full$Survived), main='Family Size by Survival', shade=TRUE)

从图上也可以显而易见的观察出来,个人与大家庭不利于生存下来,而相对的小家庭当中生存率相对较高

c. 试着生成更多变量

可以发现在乘客客舱变量 passenger cabin 也存在一些有价值的信息如客舱层数 deck. .

# 可以看出这一变量有很多缺失值
full$Cabin[1:28]
# 第一个字母即为客舱层数.如:
strsplit(full$Cabin[2], NULL)[[1]]

## [1]
"C" "8" "5"

# 建立一个层数变量(Deck)变化取值从 A - F:
full$Deck<-factor(sapply(full$Cabin, function(x) strsplit(x, NULL)[[1]][1]))
summary(full$Deck)

这里有很多可以进一步操作的地方,如有些乘客名下包含很多间房 (e.g., row 28: "C23 C25 C27"), 但是考虑到这一变量数值的稀疏性(sparseness),有1014 个缺失值。 后面就不再进一步考虑。

------------------------

缺失值

现在我们开始对原始数据当中的缺失值进行处理(填补)。

具体做法有很多种,考虑到数据集本身较小,样本数也不多,因而不能直接整行或者整列删除缺失值样本。那么只能通过现有数据和变量对缺失值进行预估填补 例如:可以用均值中位数模型 填补缺失值,这里使用后面两种方式进行。

a. 登船港口缺失——中位数

# 乘客 62 and 830 缺少登船港口信息。
full[c(62, 830), 'Embarked']
## [1] "" ""

我估计对于有相同舱位等级(passenger class票价(Fare的乘客也许有着相同的 登船港口位置embarkment .我们可以看到他们支付的票价分别为: $ 80 和 $ 80 同时他们的舱位等级分别是: 1 和 1 . 那么他们最有可能是在哪个港口登船的呢?

# 去除缺失值乘客的ID
embark_fare <- full %>%   filter(PassengerId != 62 & PassengerId != 830)

# 用 ggplot2 绘制embarkment, passenger class, & median fare 三者关系图
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()
很明显!

从港口 ('C')出发的头等舱支付的票价的中位数为80。因此我们可以放心的把处于头等舱且票价在$80的乘客62和830 的出发港口缺失值替换为'C'.

 # 因为他们票价为80且处于头等舱,因而他们很有可能都是从港口C登船的。
full$Embarked[c(62, 830)] <- 'C'

b. 票价缺失 ——中位数

这里发现1044行的乘客票价为空值

# 提取1044行数据
full[1044, ]

这是从港口Southampton ('S')出发的三等舱乘客。 从相同港口出发且处于相同舱位的乘客数目为 (n = 494).

ggplot(full[full$Pclass == '3' & full$Embarked == 'S', ], 
  aes(x = Fare)) +
  geom_density(fill = '#99d6ff', alpha=0.4) +  geom_vline(aes(xintercept=median(Fare, na.rm=T)),colour='red', linetype='dashed', lwd=1) +scale_x_continuous(labels=dollar_format()) + theme_few()

从得到的图形上看,将缺失值用中位数进行替换是合理的。替换数值为$8.05.

# 基于出发港口和客舱等级,替换票价缺失值
full$Fare[1044] <- median(full[full$Pclass == '3' & full$Embarked == 'S', ]$Fare, na.rm = TRUE)

c. 年龄缺失——预测填补

最后,正如我们之前观察到的,在用户年龄(Age 中有大量的缺失存在。 这里我们将基于年龄和其他变量构建一个预测模型对年龄缺失值进行预测

# S统计缺失数量
sum(is.na(full$Age))
## [1] 263

通常我们会使用 rpart (recursive partitioning for regression) 包来做缺失值预测 在这里我将使用 mice 包进行处理。具体理由,你可以通过阅读关于基于链式方程 Chained Equations多重插补法Multiple Imputation(MICE)的内容MICE (PDF). 在这之前我们先要对因子变量(factor variables)因子化,然后再进行多重插补法。

# 使因子变量因子化
factor_vars <- c('PassengerId','Pclass','Sex','Embarked',
                 'Title','Surname','Family','FsizeD')

full[factor_vars] <- lapply(full[factor_vars],function(x) as.factor(x))

# 设置随机种子
set.seed(129)

# 执行多重插补法,剔除一些没什么用的变量:
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模型的结果对原年龄数据进行替换。

# MICE模型结果替换年龄变量.
full$Age <- mice_output$Age

# 检查缺失值是否被完全替换了
sum(is.na(full$Age))

## [1] 0

现在,我们已经完成了对所有重要变量的缺失值的替换工作。 但是这一切还没结束,我们可以对年龄变量进一步对的划分 ..

-----------------------------------

特征工程2

现在我们知道每一位乘客的年龄,那么我们可以基于年龄生成一些变量如儿童(Child)和 母亲(Mother).

划分标准:

- 儿童 : 年龄Age < 18

- 母亲 : 1 女性; 2 年龄 > 18; 3 拥有超过1个子女 4 头衔不是'Miss'.

# 首先我们来看年龄与生存情况之间的关系
ggplot(full[1:891,], aes(Age, fill = factor(Survived))) + 
  geom_histogram() + 
  # 分性别来看,因为前面我们知道 性别对于生存情况有重要影响
  facet_grid(.~Sex) + 
  theme_few()
# 生成儿童(child)变量, 并且基于此划分儿童child与成人adult
full$Child[full$Age < 18] <- 'Child'
full$Child[full$Age >= 18] <- 'Adult'

# 展示对应人数
table(full$Child, full$Survived)
##        
##           0   1
##   Adult 484 274
##   Child  65  68

从结果看,儿童的生存率要高于成人但是这并不意味着作为儿童就一定可以生还。正如我们当年看《泰坦尼克号》电影时,最后船员要求母亲和儿童先上船一样。

下面来生成母亲这个变量.

# 生成母亲变量
full$Mother <- 'NotMother'

full$Mother[full$Sex =='female' & full$Parch > 0 & full$Age > 18 & full$Title != 'Miss'] <- 'Mother'

# 统计对于数量
table(full$Mother, full$Survived)

##             
##                  0   1
##   Mother        16   39
##   Not Mother    533 303

# 对新生成的两个变量完成因子化。
full$Child  <- factor(full$Child)
full$Mother <- factor(full$Mother)

至此,所有我们需要的变量都已经生成,并且其中没有缺失值。 为了保险起见,我们进行二次确认。

#这个起到什么作用?
md.pattern(full)

现在我们终于完成对泰坦尼克数据集(the Titanic dataset)中所有的变量缺失值的填补,并基于原有变量构建了一些新变量,希望这些可以在最终的生存情况预测时起到帮助。

----------------------

模型设定与预测

在完成上面的工作之后,我们进入到最后一步:预测泰坦尼克号上乘客的生存状况。 在这里我们使用随机森林分类算法(The RandomForest Classification Algorithm) 我们前期那么多工作都是为了这一步服务的。

a. 拆分训练集与测试集

我们第一步需要将数据变回原先的训练集与测试集.

# 将数据拆分为训练集与测试集
train <- full[1:891,]
test <- full[892:1309,]

b. 建立模型

我们利用训练集训练建立随机森林 randomForest 模型.

# 设置随机种子
set.seed(754)

# 建立模型l (注意: 不是所有可用变量全部加入)
rf_model <- randomForest(factor(Survived) ~ Pclass + Sex + Age + SibSp + Sex*Parch + Fare + Embarked + Title + FsizeD + Child + Mother, data = train)

# 显示模型误差
plot(rf_model, ylim=c(0,0.36))
legend('topright', colnames(rf_model$err.rate), col=1:3, fill=1:3)

黑色那条线表示:整体误差率(the overall error rate)低于20% 红色和绿色分别表示:遇难与生还的误差率 至此相对于生还来说,我们可以更准确的预测出死亡。

c.变量重要性

通过计算Gini系数得到相应变量的重要性排序

# 获取重要性系数
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, fill = 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()

我们从图上可以看出哪些变量才是对我们预测最重要的变量 从图上看头衔和性别对于生存情况影响最大,其次是船票价格和年龄。而相应的乘客舱位排第五。 而最出乎我意料的是母亲和孩子对于生存与否的影响最小排在11和10. 这个我小时候看泰坦尼克号的印象相差甚远。

d.预测

下面到了最后一步了----预测结果! 在这里可以把刚才建立的模型直接应用在测试集上。 但为了达到最佳的预测结果,我们也可以重新构建不同的模型,或者用不同的变量进行组合。

# 基于测试集进行预测
prediction <- predict(rf_model, test)

# 将结果保存为数据框,按照Kaggle提交文档的格式要求。[两列:PassengerId and Survived (prediction)]
solution <- data.frame(PassengerID = test$PassengerId, Survived = prediction)

# 将结果写入文件
write.csv(solution, file = 'rf_mod_Solution1.csv', row.names = F)

得到的文件大家就可以上传Kaggle获取自己的排名情况啦~

当然前提你得有个Kaggle账号。注册kaggle

比赛页面:Titanic: Machine Learning from Disaster

Ps:Kaggle上不光可以参加比赛,还可以学习其他优秀选手分享的经验、以及一些代码等。

借此机会,好好逛逛吧~
-----------------------------

总结

本次案例讲解到这里就全部结束了。 后面大家想要继续提高排名,提高预测的准确率,则需要构建一些新的变量或是构建新的模型,大家可以自由探索和发挥。

感谢你花时间阅读这样一篇基于Kaggle 数据集的数据分析流程的介绍,希望对你有帮助~

【如果你有提高预测准确率的方法请留言或者私信告诉我~】


参考资料:

Titanic: Machine Learning from Disaster -by Megan L. Risdal

编辑于 2017-02-11

文章被以下专栏收录