对泰坦尼克号沉没事件幸存者数据分析和预测

一、分析目的

探究决定泰坦尼克号沉没事件中什么因素决定着船上人的生死，并对实例进行判别和预测。

二、数据介绍

Titanic.csv数据中包含了891个样本，记录了泰坦尼克号遇难时的891个乘客的基本信息，其中包括以下信息：

PassengerId: 乘客编号

Survived: 生还情况，生还为1，死亡为0

Pclass: 舱位，分为1，2，3等，1为最高的，3为最低等

Name: 姓名

Sex: 性别

Age: 年龄

SibSp: 同船的兄弟姐妹或配偶

Parch: 同船的父母或子女

Ticket: 船票信息

Fare: 乘客票价

Cabin: 客舱编号

Embarked: 登船地点，C,S,Q分别代表三个不同的地点

数据集：
链接: https://pan.baidu.com/s/1YpT8Pjg35fe_0lrpl7wClw 提取码: 9uq2http://通过网盘分享的文件：泰坦尼克号链接: https://pan.baidu.com/s/1YpT8Pjg35fe_0lrpl7wClw 提取码: 9uq2

三、实现与结果解读

1.数据处理

先导入数据，对其进行缺失值情况的查看：

R 复制代码

d1<-read.csv('D:/R Course/data/Titanic.csv')

d1

str(d1)

install.packages(c('VIM','mice'))

library('VIM')

library('mice')

map<-matrixplot(d1)

map

运行结果：

颜色代表变量值大小，浅色值小，深色值大，而红色代表缺失值，由此发现年龄缺失值较多，在进行数据分析前需要先进行数据缺失值处理，这里我们直接将缺失数据的行剔除，得到新的数据集进行接下来的分析。

R 复制代码

d2<-na.omit(d1) #数据处理

d2

接下来采用两种方法实现对上述处理过的数据集的分析和预测。

2. 多元逻辑回归分析

先对数据进行全变量逻辑回归分析：

R 复制代码

多元逻辑回归

logit.glm<-glm(factor(Survived)~factor(Pclass)

               +factor(Sex)+Age,family=binomial,data=d2)

summary(logit.glm)

可以看出，船舱等级（Pclass）、性别（Sex）、年龄（Age）、同船的兄弟姐妹或配偶（SibSp）四个因素对生还情况的影响较为显著。选取这四个特征进行分析绘图，观察生还情况和这四个因素的具体关系。

（1）舱位等级因素：

R 复制代码

#船舱等级------存活图

Pclass_S<-table(d2$Survived,d2$Pclass)

Pclass_S

Pclass_S_prop<-prop.table(Pclass_S,2)

Pclass_S_prop

ggplot(data=d2,aes(x=Pclass,fill=factor(Survived)))+geom_bar(stat = 'count',position = 'dodge')+

  scale_x_continuous(breaks=(1:3))+

  labs(x='Pclass')

运行结果：

在三个不同等级的船舱中，3等船舱的人数最多，并且可以明显看出随着船舱等级升高，乘客的生还率上升，推断船舱等级越高，救生措施可能完善，且乘客地位高，分配到的救生资源多，乘客生还的可能性越大。

（2）性别因素：

R 复制代码

#性别------存活图

Sex_S <- table(d2$Survived, d2$Sex)

Sex_S

Sex_S_prop <- prop.table(Sex_S, 2)

Sex_S_prop

ggplot(data = d2, aes(x = Sex, fill = factor(Survived)))+geom_bar(stat='count', position='dodge')

运行结果：

进入现代社会后，女士优先已经不再是男士们表现绅士的行为，而是已经成为了一种类似于道德标准的社会行为准则，在百年前的泰坦尼克号上是否也一样呢？从以上数据可看出，女性生还率要大于男性，推断可能是男士们把更多的生存机会给了女性，也可能是与救援时女性优先的原则有关，且查阅资料可知，女性在寒冷环境中体温下降较慢，当时多数人从船上跳入海中逃生，在海水低温条件下，女性在保存体温生存下去等待救援方面有天然优势，以上生还结果与此也应有关联。

（3）年龄因素：

R 复制代码

#年龄------存活图

Agedata <- as.numeric(unlist(d2$Age))

Age_S <- table(d2$Survived, cut(Agedata, breaks = c(0, 15, 30, 45, 60, 75, 90),

labels = c('kids', 'teenagers', 'prime', 'middle', 'agedness', 'senium' )))

Age_S

Age_S_prop <- prop.table(Age_S, 2)

Age_S_prop

ggplot(data = data.frame(d2$Survived, Agedata), aes(x = cut(Agedata, breaks = c(0, 15, 30, 45, 60, 75, 90)),

  fill = factor(d2.Survived)))+geom_bar(stat='count', position='dodge') +

  labs(x = 'Age') + 

  scale_x_discrete(labels = c('kids', 'teenagers', 'prime', 'middle', 'agedness', 'senium'))

运行结果：

可见儿童生还率较高，与救援时妇幼优先原则应该有关，且在危难关头，父母为了保全孩子，可能会让出紧缺的救援名额，因此儿童生还率较其他年龄段高出不少。

（4）同船的兄弟姐妹或配偶数因素

R 复制代码

#家庭人数------存活图

Fsize<-data$SibSp +data$Parch#家庭人数=兄弟姐妹或配偶+父母儿女

ggplot(data, aes(x = Fsize, fill = factor(Survived))) +

  geom_bar(stat='count', position='dodge')+   #stat='count'表示统计出现次数，position='dodge'表示柱状图分开摆放

  scale_x_continuous(breaks=c(1:11)) +#坐标轴刻度

  labs(x = '家庭人数',y='数量')

运行结果：

可见大致情况为配偶数量越少，生还率越高，但不绝对影响，推测遇难时同行人数多并不会增大生还的可能。

3. 判别分析：

（1）Fisher判别法

R 复制代码

#Fisher判别法

library(MASS)

ld=lda(Survived~Sex+Pclass+SibSp+Parch);ld

lp=predict(ld)

Survived1=lp$class

tab1=table(Survived,Survived1);tab1

sum(diag(prop.table(tab1)))

对于Fisher判别法的结果图，乘客遇难的先验概率为0.616，生还的先验概率为0.384，这证明在此次事故中遇难人数是生还人数的两倍；观察判别矩阵可以看出，遇难的有472人被判对，生还的有233人被判对，判对率为0.787，概率较高。

（2）距离判别法

R 复制代码

#距离判别法

qd=qda(Survived~Sex+Pclass+SibSp+Parch);ld

qp=predict(qd)

Survived2=qp$class

tab2=table(Survived,Survived2);tab2

sum(diag(prop.table(tab2)))

对于距离判别法的结果图，乘客遇难的先验概率为0.616，生还的先验概率为0.384，观察判别矩阵可以看出，遇难的有473人被判对，生还的有231人被判对，判对率为0.79，概率较高。

因为距离判别法的判对率略大于Fisher判别法，因此对新样本预测时采用距离判别法。

（3）对新样本进行预测

R 复制代码

#预测

predict(qd,data.frame(Pclass=1,sex='female',Sibsp=0,Parch=0))

输入新样本对其是否可以生还进行判断，通过结果可以看出生还的概率为0.996，因此判别结果为"生还"。