(完整版)Titanic数据集分析.doc

泰坦尼克数据集探索

1.简介：

从泰塔尼克数据集中，根据每个乘客的信息，建立模型并进行预

测。

整篇文章分为三步：

1.特征选择

2.缺失数据处理

3.预测

1.1导入软件包并检查数据

> library('ggplot2') # 可视化

> library('ggthemes') # 可视化

> library('scales') # 可视化

> library('dplyr') # 数据处理

> library('mice') # 填充缺失数据

> library('randomForest') # 分类算法

> # 数据的导入

> setwd('D:/Titanic')# 设置默认功过路径

> train <- read.csv('train.csv',stringsAsFactors= FALSE)# 训

练集

> test <- read.csv('test.csv',stringsAsFactors= FALSE)#测试集

#进行数据拼接，一同进行特征选择和缺失数据处理

>full <- bind_rows(train, test) # bind training & test data

># check data

>str(full)

我们观察到一共有1309 条数据，每一条数据有12 个相关变量。

2.特征工程

头衔

># 从名称中挖掘

># 从乘客名字中提取头衔

>#R 中的 grep 、grepl 、sub、gsub、regexpr 、gregexpr 等函数都使用正则表达式的规则进行匹配。默认是egrep 的规则， sub 函数只实现第一个位置的替换，gsub 函数实现全局的替换。

> 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')#

合并低频头衔为一类

> # 重命名称呼

> 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)

可以看到头衔的个数得到了大量的缩减

>#sapply() 函数：根据传入参数规则重新构建一个合理的数据类型

返回

>full$Surname <- sapply(full$Name,

+function(x) strsplit(x, split =

'[,.]')[[1]][1])

家庭人数

既然我们已经根据乘客的名字划分成一些新的变量, 我们可以把它进一步做一些新的家庭变量。首先我们要做一个基于兄弟姐妹/ 配

偶数量 (s) 和儿童 / 父母数量的家庭规模变量。

># Create a family size variable including the passenger themselves

>full$Fsize <- full$SibSp + full$Parch + 1

>

># Create a family variable

>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()

t n u o c 300

200

100

factor(Survived)

1

12345678910 11

Family Size

>full$FsizeD[full$Fsize == 1] <- 'singleton'

>full$FsizeD[full$Fsize < 5 & full$Fsize > 1] <- 'small'

>full$FsizeD[full$Fsize > 4] <- 'large'

># Show family size by survival using a mosaic plot

>mosaicplot(table(full$FsizeD, full$Survived), main='Family

Size by Family Size by Survival Survival',

large singleton small

shade=TRUE) 4 >

4

2

2

0 2

-

2

-

4

-

4

<

d

e :

z

i s

d l

r a

a u

d d

1 n i

a s

t e

S R

尝试创建一些新的特征

># This variable appears to have a lot of missing values

>full$Cabin[1:28]

># Create a Deck variable. Get passenger deck A - F:

>full$Deck<-factor(sapply(full$Cabin, function(x) strsplit(x, NULL)[[1]][1]))

还有更多可能的变量在这里完成，比如在乘客客舱变量passenger cabin 也存在一些有价值的信息如客舱层数 deck, 但是这个变量的缺失值太多，无法做出新的有效的变量，暂时放弃这个变量的挖掘。

3.缺失数据的处理

观察文件中的数据，我们会发现有些乘客的信息参数并不完整，由

于所给的数据集并不大，我们不能通过删除一行或者一列来处理缺失值，因而对于我们关注的一些字段参数，我们需要根据统计学的描述

数据（平均值、中位数等等）来合理给出缺失值。我们可以通过函数查看缺失数据的变量在第几条数据出现缺失和总共缺失的个数。

我们将根据我们想象可能相关的现有数据，推测他们的登机价值：乘客等级和票价。我们看到他们分别支付了80 美元和 $ NA，他们的

班级是 1 和 NA。那么他们从哪里开始呢？

># Use ggplot2 to visualize 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()

$500

$400

$300 factor(Pclass) e

1

r

a

F 2

3

$200

$100

$0

C Q S

Embarked

可以看到出发的一级乘客的中位票价与我们的登机手续费乘

客支付的 80 美元相当。

我们接近在这里和那里确定了几个缺失值的位置。1044 行上的乘客的票价是缺失值。

> # Since their fare was $80 for 1st class, they most likely embarked from 'C'

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

># Show row 1044

>full[1044, ]

这是从南安普敦（ 'S' ）出发的三级乘客。让所有其他人分享他们的班级和登机牌（ n = 494 ）可视化票价。

> ggplot(full[full$Pclass== '3'& full$Embarked

+aes(x = Fare)) +

+geom_density(fill = '#99d6ff', alpha=0.4) +

== 'S', ],

+geom_vline(aes(xintercept=median(Fare, na.rm=T)),

+colour='red', linetype='dashed', lwd=1) +

+scale_x_continuous(labels=dollar_format()) +

+theme_few()

从这个可视化的角度来看，将NA票价值替换为上课时间为8.05 美元的中位数似乎是相当合理的。

># Replace missing fare value with median fare for

class/embarkment

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

插补

我们可以使用rpart （递归分区回归）来预测缺少的年龄，但是

我将使用 MICE来完成这个任务，只是为了不同的东西。您可以在这

里阅读更多关于使用链接方程的多重插补（PDF）。由于我们还没有完成，我将首先对因子变量进行因子分解，然后使用mice 插补。

># Show number of missing Age values

>sum(is.na(full$Age))

># Make variables factors into factors

>factor_vars <- c('PassengerId','Pclass','Sex','Embarked',

+'Title','Surname','Family','FsizeD')

>

>full[factor_vars] <- lapply(full[factor_vars], function(x)

as.factor(x))

>

># Set a random seed

>set.seed(129)

>

>#Perform mice imputation,excluding less-than-useful variables:

>mice_mod<-mice(full[,!names(full) c('PassengerId','Name','Ticket','Cabin','Family','Surname', 'Survived')], method='rf') certain

%in%

># Save the complete output

>mice_output <- complete(mice_mod)

为保证结果没有失真，我们将比较我们得到的结果与原始的乘客年龄分布。

># Plot age distributions

>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))

># Show new number of missing Age values

>sum(is.na(full$Age))

第二次特征工程

现在我们知道每个人的年龄，我们可以创造几个新的年龄变量：儿童和母亲。一个孩子只会是18 岁以下的人，母亲是1）女性

2）18 岁以上

3）有超过 0 个孩子

4）没有头衔 'Miss'

> # First we'll look at the relationship between age & survival >ggplot(full[1:891,], aes(Age, fill = factor(Survived))) +

+ geom_histogram() +

a significant + # I include Sex since we know (a priori)it's

predictor

+facet_grid(.~Sex) +

+theme_few()

> # Create the column child, and indicate whether child or adult >full$Child[full$Age < 18] <- 'Child'

>full$Child[full$Age >= 18] <- 'Adult'

>

># Show counts

>table(full$Child, full$Survived)

> # Adding Mother variable

> full$Mother <- 'Not Mother'

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

>

># Show counts

>table(full$Mother, full$Survived)

># Finish by factorizing our two new factor variables

>full$Child <- factor(full$Child)

>full$Mother <- factor(full$Mother)

>md.pattern(full)

预测

最后，我们准备根据我们精心策划和处理缺失值的变量，预测在泰坦尼克号的乘客中谁能幸存下来。为此，我们将依靠随机森林分类算

法 ; 毕竟，我们花了所有的时间来进行数据处理。

拆分测试与训练

># Split the data back into a train set and a test set

>train <- full[1:891,]

>test <- full[892:1309,]

建模

># Set a random seed

>set.seed(754)

>

> # Build the model (note: not all possible variables are used) >rf_model <- randomForest(factor(Survived) ~ Pclass + Sex +

Age + SibSp + Parch +

+Fare +

Embarked + Title +

+ Child +FsizeD

+ Mother,

+data = train)

># Show model error

>plot(rf_model, ylim=c(0,0.36))

>legend('topright', colnames(rf_model$err.rate), col=1:3, fill=1:3) Array黑线显示总体错误率低于20％。红线和绿线分别显示“死亡”

和“幸存”的错误率。我们可以看到，现在我们比预测死亡更成功，

而不是生存。

变量重要性

># Get importance

>importance <- importance(rf_model)

>varImportance<-data.frame(Variables

https://www.360docs.net/doc/f610088055.html,s(importance),

+Importance = =

round(importance[ ,'MeanDecreaseGini'],2))

>

># Create a rank variable based on importance

>rankImportance <- varImportance %>%

+mutate(Rank = paste0('#',dense_rank(desc(Importance))))

>

> # Use ggplot2 to visualize the relative importance variables

>ggplot(rankImportance,aes(x=reorder(Variables, Importance),

+ y = Importance, fill = Importance)) +

+geom_bar(stat='identity') +

of

+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()

我们发现，头衔称号和船票价格及性别年龄对生存率的影响比较大，我们刚刚认为的小孩、老人和是否为母亲这几个特征应该有很大的生存几率，但是结果并不是这样，现实还是比较残酷！