導語：

1912年4月10日，號稱 “世界工業(yè)史上的奇跡”的豪華客輪泰坦尼克號開始了自己的處女航篷帅，從英國的南安普頓出發(fā)駛往美國紐約，4月14日晚，泰坦尼克號在北大西洋撞上冰山而傾覆左胞，1502人葬生海底，705人得救举户。造成了當時在和平時期最嚴重的一次航海事故烤宙，也是迄今為止最著名的一次海難。38歲的查爾斯·萊特勒是泰坦尼克二副俭嘁，他是最后一個從冰冷的海水中被拖上救生船躺枕、職位最高的生還者。在他寫的回憶錄中供填，列舉幾個讓人震撼的情景：

• 在第一艘救生艇下水后拐云，我對甲板上一名姓斯特勞的女人說：你能隨我一起到那只救生艇上去嗎？沒想到她搖了搖頭：不近她，我想還是呆在船上好叉瘩。她的丈夫問：你為什么不愿意上救生艇呢？這名女人竟笑著回答：不粘捎，我還是陪著你薇缅。此后，我再也沒有見到過這對夫婦...
• 亞斯特四世（當時世界第一首富）把懷著五個月身孕的妻子瑪德琳送上4號救生艇后攒磨，站在甲板上泳桦，帶著他的狗，點燃一根雪茄煙咧纠，對劃向遠處的小艇最后呼喊：我愛你們蓬痒！一副默多克曾命令亞斯特上船，被亞斯特憤怒的拒絕：我喜歡最初的說法（保護弱者）漆羔！然后梧奢，把唯一的位置讓給三等艙的一個愛爾蘭婦女......
• 斯特勞斯是世界第二巨富，美國梅西百貨公司創(chuàng)始人演痒。他無論用什么辦法亲轨，他的太太羅莎莉始終拒絕上八號救生艇，她說：多少年來鸟顺，你去哪我去哪惦蚊，我會陪你去你要去的任何地方器虾。八號艇救生員對67歲的斯特勞斯先生提議：我保證不會有人反對像您這樣的老先生上小艇。斯特勞斯堅定地回答：我絕不會在別的男人之前上救生艇蹦锋。然后挽著63歲羅莎莉的手臂兆沙，一對老夫婦蹣姍地走到甲板的藤椅上坐下，等待著最后的時刻...
• 新婚燕爾的麗德帕絲同丈夫去美國渡蜜月莉掂，她死死抱住丈夫不愿獨自逃生葛圃，丈夫在萬 般無奈中一拳將她打昏，麗德帕絲醒來時憎妙，她已在一條海上救生艇上了库正。此后，她終生未再嫁厘唾，以此懷念亡夫...

在這種生死存亡的緊要關頭褥符，我們常常認為社會等級越高、影響力越大抚垃，公眾認可度越高的人物喷楣，生存的概率應該越大，其次鹤树，乘客家庭成員多抡蛙，成員間的協作和對求生的渴望度越高，生存的概率越高魂迄。然而，很多時候惋耙，事情產生這樣的結果的原因并非我們主觀臆測的那樣捣炬，我們需要通過對真實數據進行科學的分析，才能發(fā)現很多事情并非我們想象的那樣簡單绽榛，事情產生的本質湿酸，往往隱藏在數據之中

下面我們就使用R語言根據已知存活情況的數據建立分析模型來預測其他一部分乘客的存活情況，其中灭美，訓練數據和測試數據均來源于：https://www.kaggle.com/c/titanic
本文的代碼和分析過程除部分修改外主體參考自Megan L. Risdal的文章：https://www.kaggle.com/mrisdal/exploring-survival-on-the-titanic
===========================第二次更新==============================
更新內容:添加變量是否可以用于判斷存活預測的依據
1.乘客等級對生存率的影響
更新時間：2017年6月1號

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

一.數據的導入和查看

#有些包需要安裝,我們專門建立一個packagemanger.R文件來管理它門,在工程主入口文件中先進行編譯后導入進行使用

source('D:/R/RStudioWorkspace/titanic_test/utils/packageManager.R',encoding = 'UTF-8')

library(readr) # File read / write
library(ggplot2) # Data visualization
library(ggthemes) # Data visualization
library(scales) # Data visualization
library(plyr)
library(stringr) # String manipulation
library(InformationValue) # IV / WOE calculation
library(MLmetrics) # Mache learning metrics.e.g. Recall, Precision, Accuracy, AUC
library(rpart) # Decision tree utils
library(randomForest) # Random Forest
library(dplyr) # Data manipulation
library(e1071) # SVM
library(Amelia) # Missing value utils
library(party) # Conditional inference trees
library(gbm) # AdaBoost
library(class) # KNN
library(scales)


train <- read.csv('D:/R/RStudioWorkspace/Titanic dataset from Kaggle/train.csv',stringsAsFactors= FALSE)
test <- read.csv('D:/R/RStudioWorkspace/Titanic dataset from Kaggle/test.csv',stringsAsFactors= FALSE)

# 合并兩個數據框,查看相關變量名稱
total_data <- bind_rows(train,test)
str(total_data)

查看的數據結果如下:

'data.frame':   1309 obs. of  12 variables:
 $ PassengerId: int  1 2 3 4 5 6 7 8 9 10 ...
 $ Survived   : int  0 1 1 1 0 0 0 0 1 1 ...
 $ Pclass     : int  3 1 3 1 3 3 1 3 3 2 ...
 $ Name       : chr  "Braund, Mr. Owen Harris" "Cumings, Mrs. John Bradley (Florence Briggs Thayer)" "Heikkinen" ...
 $ Sex        : chr  "male" "female" "female" "female" ...
 $ Age        : num  22 38 26 35 35 NA 54 2 27 14 ...
 $ SibSp      : int  1 1 0 1 0 0 0 3 0 1 ...
 $ Parch      : int  0 0 0 0 0 0 0 1 2 0 ...
 $ Ticket     : chr  "A/5 21171" "PC 17599" "STON/O2. 3101282" "113803" ...
 $ Fare       : num  7.25 71.28 7.92 53.1 8.05 ...
 $ Cabin      : chr  "" "C85" "" "C123" ...
 $ Embarked   : chr  "S" "C" "S" "S" ...

我們觀察到一共有1309條數據推溃，每一條數據有12個相關變量

 $ PassengerId: 乘客編號
 $ Survived   :存活情況（存活：1 ; 死亡：0）
 $ Pclass      : 客場等級
 $ Name       : 乘客姓名
 $ Sex          : 性別
 $ Age          : 年齡
 $ SibSp      : 同乘的兄弟姐妹/配偶數
 $ Parch      : 同乘的父母/小孩數
 $ Ticket      : 船票編號
 $ Fare        : 船票價格
 $ Cabin       :客艙號
 $ Embarked   : 登船港口

二.特征工程

特征工程: 為了達到預測模型性能更佳，不僅要選取最好的算法届腐，還要盡可能的從原始數據中獲取更多的信息铁坎。挖掘出更好的訓練數據，就是特征工程建立的過程

2.1乘客社會等級越高,存活率越高

ggplot(total_data[!is.na(total_data$Survived),],aes(Pclass,fill=as.factor(Survived)))+
  geom_bar(stat = 'count',position = 'dodge')+
  xlab('Pclass')+ylab('Count')+
  ggtitle(' how Pclass impact Survivor')+
  scale_fill_manual(values=c("#FF6600", "#00C5CD")) +
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

結果如下：

不同客艙與乘客生存的關系

可以看到隨著乘客等級越低犁苏，在同一等級中的存活率越低硬萍，通過定量的計算Pclass的WOE（全稱是“Weight of Evidence”，即證據權重）和IV(Information Value围详，信息量,一個變量的IV 是一個可以定量衡量變量預測能力的指標,類似的指標還有信息增益朴乖、基尼系數等等祖屏，可以參考這篇博客,詳細介紹了WOE和IV:http://blog.csdn.net/kevin7658/article/details/50780391)
可以算出Pclass的WOE和IV如下

WOETable(X=factor(total_data$Pclass[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])
IV(X=factor(total_data$Pclass[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])
#[1] 0.5009497
#attr(,"howgood")
#[1] "Highly Predictive"

從結果可以看出，Pclass的IV為0.5买羞，且“Highly Predictive”袁勺，可以將Pclass 作為預測模型的特征變量

2.2 乘客頭銜Title 對生存率的影響

注意到在乘客名字（Name）中，有一個非常顯著的特點：乘客頭銜每個名字當中都包含了具體的稱謂或者說是頭銜畜普，將這部分信息提取出來后可以作為非常有用一個新變量期丰，可以幫助我們進行預測。此外也可以用乘客的姓代替家庭漠嵌，生成家庭變量咐汞。

# 從名稱中挖掘
# 從乘客名字中提取頭銜
#R中的grep、grepl儒鹿、sub化撕、gsub、regexpr约炎、gregexpr等函數都使用正則表達式的規(guī)則進行匹配植阴。默認是egrep的規(guī)則，sub函數只實現第一個位置的替換圾浅，gsub函數實現全局的替換掠手。
total_data$Title <- gsub('(.*, )|(\\..*)', '', total_data$Name)

# 查看按照性別劃分的頭銜數量
table(total_data$Sex, total_data$Title)

結果如下:

         Capt Col Don Dona  Dr Jonkheer Lady Major Master Miss Mlle Mme  Mr Mrs  Ms Rev Sir the Countess
  female    0   0   0    1   1        0    1     0      0  260    2   1   0 197   2   0   0            1
  male      1   4   1    0   7        1    0     2     61    0    0   0 757   0   0   8   1            0

我們發(fā)現頭銜的類別太多，并且好多出現的頻次是很低的狸捕，我們可以將這些類別進行合并

# 合并低頻頭銜為一類
rare_title <- c('Dona', 'Lady', 'the Countess','Capt', 'Col', 'Don', 
                'Dr', 'Major', 'Rev', 'Sir', 'Jonkheer')

# 重命名稱呼
total_data$Title[total_data$Title == 'Mlle']        <- 'Miss' 
total_data$Title[total_data$Title == 'Ms']          <- 'Miss'
total_data$Title[total_data$Title == 'Mme']         <- 'Mrs' 
total_data$Title[total_data$Title %in% rare_title]  <- 'Rare Title'

# 再次查看按照性別劃分的頭銜數量
table(total_data$Sex, total_data$Title)

得到如下結果：

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

下面來看看title 對生存率的影響喷鸽，同樣的，使用圖形ggplot繪制

ggplot(total_data[!is.na(total_data$Survived),],aes(Title,fill=as.factor(Survived)))+
  geom_bar(stat = 'count',position = 'dodge')+
  ggtitle('how title impact survived')+
  scale_fill_manual(values=c("#FF6600", "#00C5CD")) +
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

得到如下結果

title 對生存率的影響

#查看Title 對Survived 的預測能力評估
WOETable(X=factor(total_data$Title[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])
IV(X=factor(total_data$Title[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])

#[1] 1.522418
#attr(,"howgood")
#[1] "Highly Predictive"

我們可以得出結論灸拍，Title 對survived有很好的預測效果做祝，也需要把Title 添加到預測模型的特征變量中
最后，從名稱中獲取到姓氏

#sapply()函數：根據傳入參數規(guī)則重新構建一個合理的數據類型返回
total_data$Surname <- sapply(total_data$Name,  function(x) strsplit(x, split = '[,.]')[[1]][1])

2.3女性和小孩幸存概率應該更大

作為弱者鸡岗，女性和小孩在這種時刻應該得到更好的照顧混槐，生存率應該會更高,

#性別對生存率的影響
ggplot(total_data[!is.na(total_data$Survived),],aes(Sex,fill=as.factor(Survived)))+
  geom_bar(stat = 'count',position = 'dodge')+
  ggtitle('how Sex impact survived')+
  scale_fill_manual(values=c("#FF6600", "#00C5CD")) +
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

得到如下結果：

性別的影響

同理我們可以得到性別的IV值為：1.341681 同樣也是“Highly Predictive”

#年齡對生存率的影響
#將年齡劃分成2個階段 
total_data$AgeGroup[total_data$Age < 18] <- 'child'
total_data$AgeGroup[total_data$Age >= 18] <- 'adult'
table(total_data$AgeGroup,total_data$Survived)

ggplot(total_data[!is.na(total_data$Survived),],aes(x= AgeGroup,fill = as.factor(Survived)))+
  geom_bar(stat = 'count',position = 'dodge')+
  ggtitle('how AgeGroup impact survived')+
  scale_fill_manual(values=c("#FF6600", "#00C5CD")) +
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

得到如下結果

年齡對生存率的影響

暫且不管NA （缺失數據）的存活情況，我們可以發(fā)現轩性，小孩的成活概率是大于50%的
同樣的我們計算年齡組的IV值

WOETable(X=factor(total_data$AgeGroup[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])
IV(X=factor(total_data$AgeGroup[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])
#[1] 0.05655127
#attr(,"howgood")
#[1] "Somewhat Predictive"

發(fā)現預測能力為somewhat Predictive ：有些預測效果声登，暫且保留這個特征變量，到最后預測模型中對比加入和不加入這個變量對預測結果的影響大小再做結論

2.4 配偶及兄弟姐妹數適中的乘客更易幸存

我們來看看SibSp 這個變量對生存率的影響情況

#配偶及兄弟姐妹數適中的乘客更易幸存

ggplot(total_data[!is.na(total_data$Survived),],aes(x= SibSp,fill = as.factor(Survived)))+
  geom_bar(stat = 'count',position = 'dodge')+
  ggtitle('how sibsp impact survived')+
  scale_fill_manual(values=c("#FF6600", "#00C5CD")) +
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

得到如下結果

配偶及 兄弟姐妹數對生存率的影響

我們發(fā)現揣苏，配偶及兄弟姐妹數為1 或者2的生存率還是很高的悯嗓，下面看看SibSp的IV值

WOETable(X=factor(total_data$SibSp[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])
IV(X=factor(total_data$SibSp[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])
#[1] 0.1448994
#attr(,"howgood")
#[1] "Highly Predictive"

高預測性，可以作為特征模型的一個預測變量

2.5 家庭成員數量的影響

既然我們已經根據乘客的名字劃分成一些新的變量,我們可以把它進一步做一些新的家庭變量舒岸。首先我們要做一個基于兄弟姐妹/配偶數量(s)和兒童/父母數量的家庭規(guī)模變量绅作。

# 創(chuàng)建一個包含乘客自己的家庭規(guī)模變量
total_data$Fsize <- total_data$SibSp + total_data$Parch + 1

# Create a family variable 
total_data$Family <- paste(total_data$Surname, total_data$Fsize, sep='_')

# 為了直觀顯示，我們可以用ggplot2 畫出家庭成員數量和生存家庭數情況的圖形

ggplot(total_data[!is.na(total_data$Survived),],aes(x= Fsize,fill = as.factor(Survived)))+
  geom_bar(stat = 'count',position = 'dodge')+
  ggtitle('how family size impact survived')+
  scale_fill_manual(values=c("#FF6600", "#00C5CD")) +
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1),  vjust=-0.5) + 
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

結果如下：

家庭成員數量和生存數量的關系

再來看看家庭成員數量對生存率的預測值IV

WOETable(X=factor(total_data$Fsize[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])
IV(X=factor(total_data$Fsize[1:nrow(train)]),Y=total_data$Survived[1:nrow(train)])

[1] 0.3497672
attr(,"howgood")
[1] "Highly Predictive"

為高預測性

2.6支出船票價格對生存率的影響

船票價格是連續(xù)的蛾派，采用ggplot中 geom_line()進行模擬顯示

#支出船票價格對生存率的影響
ggplot(total_data[1:nrow(train), ], aes(x = Fare, fill= as.factor(Survived),color = Survived)) + 
  geom_line(aes(label=..count..), stat = 'bin', binwidth=10)  + 
  scale_fill_manual(values=c("#FF6600", "#00C5CD")) +
  labs(title = "How Fare impact survivor", x = "Fare", y = "Count", fill = "Survived")

結果如下

船票價格對生存率的影響

觀察藍色存活數量的線條俄认，我們可以發(fā)現个少，船票價格越高，生存率越高眯杏，我們再來看看船票價格的IV值夜焦，結果為高預測性

#[1] 0.6123083
#attr(,"howgood")
#[1] "Highly Predictive"

2.7 客艙位置的影響

可以發(fā)現在乘客客艙變量 passenger cabin 也存在一些有價值的信息如客艙層數 deck,但是這個變量的缺失值太多，無法做出新的有效的變量岂贩，暫時放棄這個變量的挖掘

三.缺失數據的處理

觀察文件中的數據茫经，我們會發(fā)現有些乘客的信息參數并不完整，由于所給的數據集并不大萎津，我們不能通過刪除一行或者一列來處理缺失值卸伞，因而對于我們關注的一些字段參數，我們需要根據統計學的描述數據（平均值锉屈、中位數等等）來合理給出缺失值

3.1 列出所有缺失值

我們可以通過函數查看缺失數據的變量在第幾條數據出現缺失和總共缺失的個數

3.1 年齡的缺失和填補

#統計年齡的缺失個數
age_null_count <- sum(is.na(total_data$Age))
#age_null_count = 263

通常我們會使用 rpart (recursive partitioning for regression) 包來做缺失值預測 在這里我將使用 mice 包進行處理荤傲。我們先要對因子變量（factor variables）因子化，然后再進行多重插補法颈渊。

#統計年齡的缺失處理
age_null_count <- sum(is.na(total_data$Age))

# 使自變量因子化
factor_vars <- c('PassengerId','Pclass','Sex','Embarked',
                 'Title','Surname','Family','Fsize')
#lapply()返回一個長度與X一致的列表遂黍，每個元素為FUN計算出的結果，且分別對應到X中的每個元素俊嗽。
total_data[factor_vars] <- lapply(total_data[factor_vars],function(x) as.factor(x))

# 設置隨機值
set.seed(129)

# 執(zhí)行多重插補法雾家，剔除一些沒什么用的變量:
mice_mod <- mice(total_data[, !names(total_data) %in% c('PassengerId','Name','Ticket','Cabin','Family','Surname','Survived')], method='rf') 
# 保存完成的輸出 
mice_output <- complete(mice_mod)

讓我們來比較一下我們得到的結果與原來的乘客的年齡分布以確保沒有明顯的偏差

# 繪制直方圖
par(mfrow=c(1,2))
hist(total_data$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))
# 0

3.2票價的缺失處理

#查看票價的缺失值
getFareNullID <- function(total_data){
  count <- 0
  for(i in 1:nrow(total_data))
    if(is.na(total_data$Fare[i])){
      #打印缺失票價的具體行數
      print(i);
      count <- count+1
    }
  
  return(count)
  
}
fare_null_count <- getFareNullID(total_data)
#fare_null_count  = 1

得到票價缺失個數為1 芯咧，缺失行數為第1044行
查看這一行我們會發(fā)現

total_data[1044,]
      PassengerId Survived  Pclass       Name    Sex   Age    SibSp Parch Ticket Fare Cabin
1044   1044          NA     3 Storey, Mr. Thomas   male  60.5     0     0   3701   NA      
      Embarked    Title     Surname      Fsize   Family
1044     S           Mr     Storey         1     Storey_1

我們發(fā)現港口和艙位是完整的，我們可以根據相同的港口和相同的艙位來大致估計該乘客的票價竹揍，我們取這些類似乘客的中位數來替換缺失的值

#從港口Southampton ('S')出發(fā)的三等艙乘客唬党。 從相同港口出發(fā)且處于相同艙位的乘客數目
same_farenull <- sum(total_data$Pclass == '3' & total_data$Embarked == 'S')
# 基于出發(fā)港口和客艙等級，替換票價缺失值
total_data$Fare[1044] <- median(total_data[total_data$Pclass == '3' & total_data$Embarked == 'S', ]$Fare, na.rm = TRUE)

3.3登船港口號的缺失

#登船港口號的缺失值函數
getEmbarkedNullCount <- function(total_data) {
  count0 <- 0
  count <- 0
  for(i in 1:nrow(total_data))
    if(total_data$Embarked[i] == ""){
#可以打印出缺失的所在行數
      print(i);
      count <- count +1
    } 
  return(count)
}
#登船港口號的缺失個數
embarked_null_count <- getEmbarkedNullCount(total_data)
#embarked_null_count =2

得到登船港口號缺失的個數為2 鬼佣，分別為 62 、830霜浴，我估計對于有相同艙位等級（passenger class）和票價（Fare）的乘客也許有著相同的 登船港口位置embarkment .我們可以看到他們支付的票價分別為: $ 80 和 $ 80 同時他們的艙位等級分別是： 1 和 1 . 我們可以用箱線圖繪制出這三者之間關系圖

從港口 ('C')出發(fā)的頭等艙支付的票價的中位數正好為80晶衷。因此我們可以放心的把處于頭等艙且票價在$80的乘客62和830 的出發(fā)港口缺失值替換為'C'

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

我們基本上完成了重要參數缺失值的處理，我們的數據集變得更加完整了呢阴孟，接下來晌纫，需要根據新的數據集創(chuàng)建出新的特征工程

四.新特征工程的建立

通過上面缺失值填補的完成，我們試著在新的數據集中挖掘出對乘客的存活有影響的一些因素永丝，根據文章剛開始的幾段真實場景預測锹漱，我們考慮在這種災難性的時刻，小孩和老人相對于青年或者中年人應該會得到更好的照顧慕嚷，生存的概率應該更高哥牍，其次毕泌，如果你是一位母親，你相比于其他成年女性是否會有更高的存活可能嗅辣？其實我還有一個想法撼泛，那就是乘客的社會地位或者說階層 和當時的收入水平層次可能對生存有一定的影響，當然這兩個因素對于現在的我們來說非常難以獲取澡谭，畢竟事情發(fā)生在100多年前愿题，或許當時的政府，也需要很長時間才能準確的獲取到覺大部分人的這些側面信息蛙奖。

4.1年齡的劃分

我們考慮將年齡劃分成三個階段潘酗，小于18歲算小孩，18歲及以上至50歲為青壯年雁仲，50歲以上為老年人

#將年齡劃分成3個階段 
total_data$AgeGroup[total_data$Age < 18] <- 'child'
total_data$AgeGroup[total_data$Age >= 18 & total_data$Age <= 50] <- 'young'
total_data$AgeGroup[total_data$Age > 50] <- 'old'

table(total_data$AgeGroup,total_data$Survived)
#得到如下結果
           0   1
  child   70  63
  old     51  24
  young  428 255

相比于成人仔夺，小孩的生存概率接近50%，小孩得到的照顧比成年高的多

4.2是否為母親

我們從性別和頭銜中提煉出一位成年女性是否為一位母親伯顶，看看她的生存概率如何

# Adding Mother variable
total_data$IsMother <- 'Not'
total_data$IsMother[total_data$Sex == 'female' & total_data$Parch > 0 & total_data$Age > 18 & total_data$Title != 'Miss'] <- 'Yes'

# Show counts
table(total_data$IsMother, total_data$Survived)
#結果如下：
       0   1
  Not 534 303
  Yes  15  39

我們發(fā)現囚灼，如果是一位母親，那么你生存下來的概率高達70%,之后祭衩，我們整合上面兩個新變量到原數據集

# 完成因子化
total_data$AgeGroup  <- factor(total_data$AgeGroup)
total_data$IsMother <- factor(total_data$IsMother)
#mice 包中顯示缺失數據的一種模式灶体。
md.pattern(total_data)

五.預測

到了最激動人心的時刻了有沒有，前面四個步驟都是為了預測在做前期準備掐暮，如何進行預測呢蝎抽？

5.1.拆分測試和訓練數據集

#拆分數據集
train <- total_data[1:891,]
test <- total_data[892:1309,]

5.2 構建訓練模型

我們使用隨機森林法則作用于訓練數據集來構建我們需要的預測模型

#拆分數據集
train <- total_data[1:891,]
test <- total_data[892:1309,]

set.seed(754)
# 構建預測模型
rf_model <- randomForest(factor(Survived) ~ Pclass + Sex + Age + Fare+ Embarked + Title + Fsize,data = train)

交叉驗證

一般情況下，應該將訓練數據分為兩部分路克，一部分用于訓練樟结，另一部分用于驗證【悖或者使用k-fold交叉驗證瓢宦。本文將所有訓練數據都用于訓練，然后隨機選取30%數據集用于驗證灰羽。

cv.summarize <- function(data.true, data.predict) {
  print(paste('Recall:', Recall(data.true, data.predict)))
  print(paste('Precision:', Precision(data.true, data.predict)))
  print(paste('Accuracy:', Accuracy(data.predict, data.true)))
  print(paste('AUC:', AUC(data.predict, data.true)))
}
set.seed(415)
cv.test.sample <- sample(1:nrow(train), as.integer(0.3 * nrow(train)), replace = TRUE)
cv.test <- total_data[cv.test.sample,]
cv.prediction <- predict(rf_model, cv.test, OOB=TRUE, type = "response")
cv.summarize(cv.test$Survived, cv.prediction)
#"Recall: 0.982658959537572"
#[1] "Precision: 0.904255319148936"
#[1] "Accuracy: 0.921348314606742"
#[1] "AUC: 0.895584798917722"

5.3 相關性檢測

通過隨機森林中所有決策樹的Gini 計算出其他變量相對于生存變量的相關性排行驮履，我們可以看出那些因素對生存率影響較大

# 重要性系數
importance    <- importance(rf_model)
varImportance <- data.frame(Variables = row.names(importance), 
                            Importance = round(importance[ ,'MeanDecreaseGini'],2))

# 創(chuàng)建基于重要性系數排列的變量
rankImportance <- varImportance %>%
  mutate(Rank = paste0('#',dense_rank(desc(Importance))))

# 使用 ggplot2  繪出重要系數的排名
ggplot(rankImportance, aes(x = reorder(Variables, Importance), 
                           y = Importance, total_data = 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()

結果如下：

圖片.png

5.4 預測

最后，我們使用訓練好的特征模型作用于測試數據上廉嚼，得到我們的預測結果

prediction <- predict(rf_model, test)
# 保存數據結果passagerId 和survived參數
solution <- data.frame(PassengerID = test$PassengerId, Survived = prediction)
# 保存到文件
write.csv(solution, file = 'D:/R/RStudioWorkspace/titanic_test/output/predict_Solution.csv', row.names = F)

得到預測結果文件玫镐，我們可以上傳到Kaggle,查看自己的排名情況，

圖片.png

第二次預測進行了特征變量的刪減怠噪，刪了 AgeGroup 和 IsMother,SibSp,恐似，我們第一次選擇特征變量的時候認為的小孩、老人和是否為母親 這幾個特征應該有很大的生存幾率傍念，但是結果并不是這樣矫夷，現實還是比較殘酷葛闷！
就先分析到這吧，感謝你的時間口四，后面靈感涌現挖掘到新的特征變量再添加到特征工程中孵运，這樣預測結果應該會更加準確。排名也會更加靠前蔓彩，加油治笨！