Titanic数据集分析

2020-03-03 12:36:06 来源：范文大全收藏下载本文

泰坦尼克数据集探索

1.简介：

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

整篇文章分为三步： 1.特征选择 2.缺失数据处理 3.预测

1.1 导入软件包并检查数据 > library(\'ggplot2\') # 可视化 > library(\'ggthemes\') # 可视化 > library(\'scales\') # 可视化 > library(\'dplyr\') # 数据处理 > library(\'mice\') # 填充缺失数据 > library(\'randomForest\') # 分类算法

> #数据的导入

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

> train

> test

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

> full # check data > str(full)

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

2.特征工程头衔

># 从名称中挖掘

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

> #R中的grep、grepl、sub、gsub、regexpr、gregexpr等函数都使用正则表达式的规则进行匹配。默认是egrep的规则，sub函数只实现第一个位置的替换，gsub函数实现全局的替换。 > full$Title > # 查看按照性别划分的头衔数量 > table(full$Sex, full$Title)

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

> rare_title # 重命名称呼

> full$Title[full$Title == \'Mlle\'] full$Title[full$Title == \'Ms\'] full$Title[full$Title == \'Mme\'] full$Title[full$Title %in% rare_title] > # 再次查看按照性别划分的头衔数量 > table(full$Sex, full$Title)

\'Rare

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

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

> full$Surname

家庭人数

既然我们已经根据乘客的名字划分成一些新的变量,我们可以把它进一步做一些新的家庭变量。首先我们要做一个基于兄弟姐妹/配偶数量(s)和儿童/父母数量的家庭规模变量。

> # Create a family size variable including the paenger themselves > full$Fsize > # Create a family variable > full$Family

> #为了直观显示，我们可以用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() 300count200factor(Survived)0110001234567891011Family Size > full$FsizeD[full$Fsize == 1] full$FsizeD[full$Fsize 1] full$FsizeD[full$Fsize > 4] # Show family size by survival using a mosaic plot > mosaicplot(table(full$FsizeD, full$Survived), main=\'Family Size by largeFamily Size by SurvivalsingletonsmallSurvival\',

2:4>4shade=TRUE)

0StandardizedResiduals:1

> # This variable appears to have a lot of miing values > full$Cabin[1:28]

> # Create a Deck variable.Get paenger deck A - F: > full$Deck

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

3.缺失数据的处理

观察文件中的数据，我们会发现有些乘客的信息参数并不完整，由于所给的数据集并不大，我们不能通过删除一行或者一列来处理缺失值，因而对于我们关注的一些字段参数，我们需要根据统计学的描述数据（平均值、中位数等等）来合理给出缺失值。我们可以通过函数查看缺失数据的变量在第几条数据出现缺失和总共缺失的个数。

我们将根据我们想象可能相关的现有数据，推测他们的登机价值：乘客等级和票价。我们看到他们分别支付了80美元和$ NA，他们的班级是1和NA。那么他们从哪里开始呢？

> # Use ggplot2 to visualize embarkment, paenger cla, & median fare > ggplot(embark_fare, aes(x = Embarked, y = Fare, fill = factor(Pcla))) + + geom_boxplot() + + geom_hline(aes(yintercept=80), + colour=\'red\', linetype=\'dashed\', lwd=2) + + scale_y_continuous(labels=dollar_format()) + + theme_few()

$500$400$300factor(Pcla)123Fare$200$100$0CQSEmbarked 可以看到出发的一级乘客的中位票价与我们的登机手续费乘客支付的80美元相当。

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

> # Since their fare was $80 for 1st cla, they most likely embarked from \'C\' > full$Embarked[c(62, 830)] # Show row 1044 > full[1044, ] 这是从南安普敦（\'S\'）出发的三级乘客。让所有其他人分享他们的班级和登机牌（n = 494）可视化票价。

> ggplot(full[full$Pcla == \'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()

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

> # Replace miing fare value with median fare for cla/embarkment > full$Fare[1044]

我们可以使用rpart（递归分区回归）来预测缺少的年龄，但是我将使用MICE来完成这个任务，只是为了不同的东西。您可以在这里阅读更多关于使用链接方程的多重插补（PDF）。由于我们还没有完成，我将首先对因子变量进行因子分解，然后使用mice插补。 > # Show number of miing Age values > sum(is.na(full$Age))

> # Make variables factors into factors > factor_vars > full[factor_vars] > # Set a random seed > set.seed(129) > > # Perform

mice

imputation,

excluding

certain le-than-useful variables: > mice_mod

mice(full[,

!names(full)

%in% c(\'PaengerId\',\'Name\',\'Ticket\',\'Cabin\',\'Family\',\'Surname\',\'Survived\')], method=\'rf\')

> # Save the complete output > mice_output

> # 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 miing Age values > sum(is.na(full$Age))

第二次特征工程

现在我们知道每个人的年龄，我们可以创造几个新的年龄变量：儿童和母亲。一个孩子只会是18岁以下的人，母亲是 1）女性 2）18岁以上 3）有超过0个孩子 4）没有头衔 \'Mi\'

> # First we\'ll look at the relationship between age & survival > ggplot(full[1:891,], aes(Age, fill = factor(Survived))) + + geom_histogram() + + # I include Sex since we know (a priori) it\'s a significant predictor + facet_grid(.~Sex) + + theme_few()

> # Create the column child, and indicate whether child or adult > full$Child[full$Age full$Child[full$Age >= 18] > # Show counts > table(full$Child, full$Survived)

> # Adding Mother variable > full$Mother full$Mother[full$Sex == \'female\' & full$Parch > 0 & full$Age > 18 & full$Title != \'Mi\'] > # Show counts > table(full$Mother, full$Survived)

> # Finish by factorizing our two new factor variables > full$Child full$Mother md.pattern(full)

预测

最后，我们准备根据我们精心策划和处理缺失值的变量，预测在泰坦尼克号的乘客中谁能幸存下来。为此，我们将依靠随机森林分类算法; 毕竟，我们花了所有的时间来进行数据处理。拆分测试与训练

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

> # Set a random seed > set.seed(754) > > # Build the model (note: not all poible variables are used) > rf_model # Show model error > plot(rf_model, ylim=c(0,0.36)) > legend(\'topright\', colnames(rf_model$err.rate), col=1:3, fill=1:3)

黑线显示总体错误率低于20％。红线和绿线分别显示“死亡”和“幸存”的错误率。我们可以看到，现在我们比预测死亡更成功，而不是生存。变量重要性 > # Get importance > importance varImportance

data.frame(Variables

= row.names(importance), +

Importance = round(importance[ ,\'MeanDecreaseGini\'],2)) > > # Create a rank variable based on importance > rankImportance % + mutate(Rank = paste0(\'#\',dense_rank(desc(Importance)))) > > # Use ggplot2 to visualize the relative importance of variables > 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()

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

Titanic的悲剧分析

Review on Titanic

Impreion on the Titanic