機(jī)器學(xué)習(xí)的步驟：先擼一個baseline的model出來，再進(jìn)行后續(xù)的分析步驟，一步步提高，所謂后續(xù)步驟可能包括『分析model現(xiàn)在的狀態(tài)(欠/過擬合)，分析我們使用的feature的作用大小，進(jìn)行feature selection，以及我們模型下的bad case和產(chǎn)生的原因』等等。

kaggle大神說過：
對數(shù)據(jù)的認(rèn)識太重要了！
數(shù)據(jù)中的特殊點(diǎn)、離群點(diǎn)的分析和處理太重要了！
特征工程太重要了！
要做模型融合！

本案例中使用泰坦尼克號乘客數(shù)據(jù)（姓名，年齡，性別，社會經(jīng)濟(jì)階層等）來預(yù)測誰將生存以及誰將死亡。

有兩個文件，train.csv和test.csv。Train.csv將包含船上一部分乘客的詳細(xì)信息（確切地說是891），并將告訴您他們的詳細(xì)信息以及他們是否幸存。使用您在train.csv數(shù)據(jù)中找到的模式，您將必須預(yù)測其他418名乘客（在test.csv中找到）是否幸免于難。訓(xùn)練和測試數(shù)據(jù)是一些乘客的個人信息以及存活狀況，要嘗試根據(jù)它生成合適的模型并預(yù)測其他人的存活狀況。

這是一個二分類問題，是logistic regression所能處理的范疇。
首先通過EXCEL篩選功能可得出近75％的女性幸免于難！然而，只有19％的男性活著告訴它。這是一個非常有前途的猜測！再添加if語句對年齡分類，成年女性（18歲以上）有78％的生存機(jī)會，而男性成年人僅有18％的生存機(jī)會。您可以看到這與原始比例相比沒有太大變化。這告訴我們年齡變量中沒有太多額外信息。再來看一個變量：乘客類。比例現(xiàn)在已經(jīng)發(fā)生了巨大變化，這意味著這個變量有一些預(yù)測價值。然而，這仍然沒有超過男/女分歧?，F(xiàn)在讓我們了解人們?yōu)樗麄兊臋C(jī)票支付的費(fèi)用，以便每個類別分為以下付款：（i）少于10美元，（ii）介于10美元至20美元之間，（iii）介于20美元至30美元之間，以及（iv）大于$ 30。所有男性仍然無法生存; 然而現(xiàn)在支付超過20美元的三等女性也無法生存。這個小改進(jìn)應(yīng)該在排行榜上有所作為！

本例我們使用隨機(jī)森林方法，隨機(jī)森林是一種組成式的有監(jiān)督學(xué)習(xí)方法，集成學(xué)習(xí)的基本思想：由多個學(xué)習(xí)器組合成一個性能更好的學(xué)習(xí)器（結(jié)合幾個模型降低泛化誤差），集成學(xué)習(xí)為什么有效？不同的模型通常會在測試集上產(chǎn)生不同的誤差。平均上，集成模型至少能與其一成員表現(xiàn)一致；并且如果成員的誤差是獨(dú)立的，集成模型將顯著地比其成員表現(xiàn)更好。

集成學(xué)習(xí)（ensemble learning）通過構(gòu)建并組合多個學(xué)習(xí)器來完成學(xué)習(xí)任務(wù)。集成學(xué)習(xí)通過將多個學(xué)習(xí)器進(jìn)行結(jié)合，常獲得比單一學(xué)習(xí)器顯著優(yōu)越的泛化性能。

根據(jù)個體學(xué)習(xí)器是否是同類型的學(xué)習(xí)器（由同一個算法生成，比如C4.5,BP等），分為同質(zhì)和異質(zhì)。同質(zhì)的個體學(xué)習(xí)器又叫做基學(xué)習(xí)器，而異質(zhì)的個體學(xué)習(xí)器則直接成為個體學(xué)習(xí)器。

原則：要獲得比單一學(xué)習(xí)器更好的性能，個體學(xué)習(xí)器應(yīng)該好而不同。即個體學(xué)習(xí)器應(yīng)該具有一定的準(zhǔn)確性，不能差于弱學(xué)習(xí)器，并且具有多樣性，即學(xué)習(xí)器之間有差異。

根據(jù)個體學(xué)習(xí)器的生成方式，目前集成學(xué)習(xí)分為兩大類：
一般是基于個體學(xué)習(xí)器之間的依賴關(guān)系，若個體學(xué)習(xí)器之間有著強(qiáng)依賴關(guān)系、必須串連生成的序列化方法，一般指boosting方法；而個體學(xué)習(xí)器之間不存在強(qiáng)依賴關(guān)系，可以同時生成的并行化方法，有bagging和隨機(jī)森林等；

隨機(jī)森林就是用隨機(jī)的方式建立一個森林，森林里面有很多的決策樹，并且每棵樹之間是沒有關(guān)聯(lián)的。得到一個森林后，當(dāng)有一個新的樣本輸入，森林中的每一棵決策樹會分別進(jìn)行一下判斷，進(jìn)行類別歸類（針對分類算法），最后比較一下被判定哪一類最多，就預(yù)測該樣本為哪一類。 即所有決策樹預(yù)測類別中的眾數(shù)類別是隨機(jī)森林所預(yù)測的這一樣本單元的類別。隨機(jī)森林算法有兩個主要環(huán)節(jié)：決策樹的生長和投票過程。

隨機(jī)森林實際上是一種特殊的bagging方法，它將決策樹用作bagging中的模型。首先，用bootstrap方法生成m個訓(xùn)練集，然后，對于每個訓(xùn)練集，構(gòu)造一顆決策樹，在節(jié)點(diǎn)找特征進(jìn)行分裂的時候，并不是對所有特征找到能使得指標(biāo)（如信息增益）最大的，而是在特征中隨機(jī)抽取一部分特征，在抽到的特征中間找到最優(yōu)解，應(yīng)用于節(jié)點(diǎn)，進(jìn)行分裂。隨機(jī)森林的方法由于有了bagging，也就是集成的思想在，實際上相當(dāng)于對于樣本和特征都進(jìn)行了采樣（如果把訓(xùn)練數(shù)據(jù)看成矩陣，就像實際中常見的那樣，那么就是一個行和列都進(jìn)行采樣的過程），所以可以避免過擬合。

Bagging是Bootstrap AggregatING的縮寫，是并行式集成學(xué)習(xí)方法的代表，采樣方法是自助采樣法，用的是有放回的采樣。初始訓(xùn)練集中大約有63.2%的數(shù)據(jù)出現(xiàn)在采樣集中。
Bagging在預(yù)測輸出進(jìn)行結(jié)合時，對于分類問題，采用簡單投票法；對于回歸問題，采用簡單平均法。

Bagging優(yōu)點(diǎn)：
高效。Bagging集成與直接訓(xùn)練基學(xué)習(xí)器的復(fù)雜度同階。
Bagging能不經(jīng)修改的適用于多分類、回歸任務(wù)。
包外估計。使用剩下的樣本作為驗證集進(jìn)行包外估計（out-of-bag estimate）

隨機(jī)森林（Random Forest）是Bagging的一個變體。Ramdon Forest在以決策樹為基學(xué)習(xí)器構(gòu)建Bagging集成的基礎(chǔ)上，進(jìn)一步在決策樹的訓(xùn)練過程中引入隨機(jī)屬性選擇。

隨機(jī)森林優(yōu)點(diǎn)：
由于每次不再考慮全部的屬性，而是一個屬性子集，所以相比于Bagging計算開銷更小，訓(xùn)練效率更高。
由于增加了屬性的擾動，隨機(jī)森林中基學(xué)習(xí)器的性能降低，使得在隨機(jī)森林在起始時候性能較差，但是隨著基學(xué)習(xí)器的增多，隨機(jī)森林通常會收斂于更低的泛化誤差，相比于Bagging。

兩個隨機(jī)性的引入，使得隨機(jī)森林不容易陷入過擬合，具有很好的抗噪聲能力
對數(shù)據(jù)的適應(yīng)能力強(qiáng)，可以處理離散和連續(xù)的，無需要規(guī)范化
可以得到變量的重要性， 基于oob誤分類率和基于Gini系數(shù)的變化

缺點(diǎn)：
在噪聲較大的時候容易過擬合

一、獲取數(shù)據(jù)

train<-read.csv("F:\\kaggle\\泰坦尼克號：災(zāi)難中的機(jī)器學(xué)習(xí)\\train.csv",header=T,stringsAsFactors=FALSE)
test<-read.csv("F:\\kaggle\\泰坦尼克號：災(zāi)難中的機(jī)器學(xué)習(xí)\\test.csv",header=T,stringsAsFactors=FALSE)
#為了處理方便，所以這里要把這兩個數(shù)據(jù)集合并起來
library(dplyr) # 用于加載bind_rows
data<-bind_rows(train,test)#不同于rbind，可以將列數(shù)不相等的行合并，test中沒有survival一列，自動補(bǔ)為NA
#然后再把同一個數(shù)據(jù)中分出兩個部分來，一個用了訓(xùn)練，一個用來測試
train.row<-1:nrow(train)
test.row<-(1+nrow(train)):(nrow(train)+nrow(test))
attach(data)
str(data)

head(data,3)

數(shù)據(jù)集包含12個變量，1309條數(shù)據(jù)，其中891條為訓(xùn)練數(shù)據(jù)，418條為測試數(shù)據(jù)
其中：
PassengerId 整型變量，標(biāo)識乘客的ID，遞增變量，對預(yù)測無幫助
Survived 整型變量，標(biāo)識該乘客是否幸存。0表示遇難，1表示幸存。將其轉(zhuǎn)換為factor變量比較方便處理
Pclass 整型變量，標(biāo)識乘客的社會-經(jīng)濟(jì)狀態(tài)，1代表Upper，2代表Middle，3代表Lower
Name 字符型變量，除包含姓和名以外，還包含Mr. Mrs. Dr.這樣的具有西方文化特點(diǎn)的信息
Sex 字符型變量，標(biāo)識乘客性別，適合轉(zhuǎn)換為factor類型變量
Age 整型變量，標(biāo)識乘客年齡，有缺失值
SibSp 整型變量，代表兄弟姐妹及配偶的個數(shù)。其中Sib代表Sibling也即兄弟姐妹，Sp代表Spouse也即配偶
Parch 整型變量，代表父母或子女的個數(shù)。其中Par代表Parent也即父母，Ch代表Child也即子女
Ticket 字符型變量，代表乘客的船票號
Fare 數(shù)值型，代表乘客的船票價
Cabin 字符型，代表乘客所在的艙位，有缺失值
Embarked 字符型，代表乘客登船口岸，適合轉(zhuǎn)換為factor型變量（數(shù)據(jù)模型（隨機(jī)森林）不支持字符型）

二、特征工程

為了達(dá)到預(yù)測模型性能更佳，不僅要選取最好的算法，還要盡可能的從原始數(shù)據(jù)中獲取更多的信息。挖掘出更好的訓(xùn)練數(shù)據(jù)，就是特征工程建立的過程

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

library(ggplot2) # Data visualization
library(ggthemes) # Data visualization
library(scales) # 把圖形弄的更漂亮的,并提供用于自動地確定用于軸和圖例符和標(biāo)簽的方法
#首先將Survived因子化,要指出是data中的，否則最后條形圖不按0,1分層
data$Survived<-factor(data$Survived)
#用ggplot統(tǒng)計出Pclass的幸存和遇難人數(shù)
ggplot(data[1:nrow(train),], aes(x = Pclass, y = ..count.., fill=Survived))+
  geom_bar(stat = "count", position='dodge') + 
  #標(biāo)題設(shè)置
  labs(title="How Pclass impact survivor",y='Count',x='Pclass')+ 
  #文本設(shè)置
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1), vjust=-0.5)+ 
  #小題目設(shè)置
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

第一二階層（上層和中層階級）的幸存率（差不多50%）要遠(yuǎn)遠(yuǎn)高于第三階層的幸存率（25%）。即隨著乘客等級越低，在同一等級中的存活率越低

注：關(guān)于預(yù)測能力的量化指標(biāo)：
一些具體的量化指標(biāo)來衡量每自變量的預(yù)測能力，并根據(jù)這些量化指標(biāo)的大小，來確定哪些變量進(jìn)入模型。IV就是這樣一種指標(biāo)，他可以用來衡量自變量的預(yù)測能力。類似的指標(biāo)還有信息增益、基尼系數(shù)。

IV的直觀解釋：假設(shè)這個信息總量是I，而這些所需要的信息，就蘊(yùn)含在所有的自變量C1，C2，C3，……，Cn中，那么，對于其中的一個變量Ci來說，其蘊(yùn)含的信息越多，那么它對于判斷A屬于Y1還是Y2的貢獻(xiàn)就越大，Ci的信息價值就越大，Ci的IV就越大，它就越應(yīng)該進(jìn)入到入模變量列表中。

首先需要認(rèn)識和理解另一個概念——WOE，因為IV的計算是以WOE為基礎(chǔ)的。

WOE的全稱是“Weight of Evidence”，即證據(jù)權(quán)重。WOE是對原始自變量的一種編碼形式。

要對一個變量進(jìn)行WOE編碼，需要首先把這個變量進(jìn)行分組處理（也叫離散化、分箱等等，說的都是一個意思）。分組后，對于第i組，WOE的計算公式如下：

其中，pyi是這個組中響應(yīng)客戶（風(fēng)險模型中，對應(yīng)的是違約客戶，總之，指的是模型中預(yù)測變量取值為“是”或者說1的個體）占所有樣本中所有響應(yīng)客戶的比例，pni是這個組中未響應(yīng)客戶占樣本中所有未響應(yīng)客戶的比例，#yi是這個組中響應(yīng)客戶的數(shù)量，#ni是這個組中未響應(yīng)客戶的數(shù)量，#yT是樣本中所有響應(yīng)客戶的數(shù)量，#nT是樣本中所有未響應(yīng)客戶的數(shù)量。

從這個公式中我們可以體會到，WOE表示的實際上是“當(dāng)前分組中響應(yīng)客戶占所有響應(yīng)客戶的比例”和“當(dāng)前分組中沒有響應(yīng)的客戶占所有沒有響應(yīng)的客戶的比例”的差異。

對這個公式做一個簡單變換，可以得到對于一個分組后的變量，第i 組的WOE為：

變換以后我們可以看出，WOE也可以這么理解，他表示的是當(dāng)前這個組中響應(yīng)的客戶和未響應(yīng)客戶的比值，和所有樣本中這個比值的差異。這個差異是用這兩個比值的比值，再取對數(shù)來表示的。WOE越大，這種差異越大，這個分組里的樣本響應(yīng)的可能性就越大，WOE越小，差異越小，這個分組里的樣本響應(yīng)的可能性就越小。WOE其實描述了變量當(dāng)前這個分組，對判斷個體是否會響應(yīng)（或者說屬于哪個類）所起到影響方向和大小，當(dāng)WOE為正時，變量當(dāng)前取值對判斷個體是否會響應(yīng)起到的正向的影響，當(dāng)WOE為負(fù)時，起到了負(fù)向影響。而WOE值的大小，則是這個影響的大小的體現(xiàn)。

同樣，對于分組i，也會有一個對應(yīng)的IV值，計算公式如下：

有了一個變量各分組的IV值，我們就可以計算整個變量的IV值，方法很簡單，就是把各分組的IV相加：

對于變量的一個分組，這個分組的響應(yīng)和未響應(yīng)的比例與樣本整體響應(yīng)和未響應(yīng)的比例相差越大，IV值越大，否則，IV值越小；IV值越高，預(yù)測能力最高。

可以算出Pclass的WOE和IV如下:

library(InformationValue) # 算IV跟WOV用的,即高價值數(shù)據(jù)
WOETable(X=factor(data$Pclass[1:nrow(train)]),Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Pclass[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
library(plyr) #可以進(jìn)行類似于數(shù)據(jù)透視表的操作，將數(shù)據(jù)分割成更小的數(shù)據(jù)，
#對分割后的數(shù)據(jù)進(jìn)行些操作，最后把操作的結(jié)果匯總。比如提取首字母,提取姓氏.等等
library(stringr) # String manipulation

從結(jié)果可以看出，Pclass的IV為0.5，且“Highly Predictive”，可以將Pclass 作為預(yù)測模型的特征變量。

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

我們觀察名字這一個變量，發(fā)現(xiàn)幾乎每一個都有Mr. Mrs.
Dr.將這部分信息提取出來后可以作為非常有用一個新變量，可以幫助我們進(jìn)行預(yù)測。此外也可以用乘客的姓代替
家庭，生成家庭變量。

# 從乘客名字中提取頭銜
#R中的grep、grepl、sub、gsub、regexpr、gregexpr等函數(shù)都使用正則表達(dá)式的規(guī)則進(jìn)行匹配。默認(rèn)是egrep的規(guī)則，sub函數(shù)只實現(xiàn)第一個位置的替換，gsub函數(shù)實現(xiàn)全局的替換。
data$Title <- gsub('(.*, )|(\\..*)', '', data$Name)

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

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

# 合并低頻頭銜為一類
rareTitle <- c('Dona', 'Lady', 'the Countess','Capt', 'Col', 'Don', 
                'Dr', 'Major', 'Rev', 'Sir', 'Jonkheer')
#重編碼變量，將女性以M開頭的頭銜合并到普通頭銜里
data$Title[data$Title=='Mlle']<-'Miss'
data$Title[data$Title=='Ms']<-'Miss'
data$Title[data$Title=='Mme']<-'Mrs'
#把稀有頭銜一起放到Rare Title里
data$Title[data$Title %in% rareTitle]<-'Rare Title'
#再次查看按照性別劃分的頭銜數(shù)量
table(data$Sex, data$Title)

下面來看看Title 對生存率的影響

#首先將Title因子化
data$Title<-factor(data$Title)
#用ggplot統(tǒng)計出Title的幸存和遇難人數(shù)
ggplot(data[1:nrow(train),], aes(x = Title, y = ..count.., fill=Survived))+
  geom_bar(stat = "count", position='dodge') + 
  #標(biāo)題設(shè)置
  labs(title="How Title impact survivor",y='Count',x='Title')+ 
  scale_fill_discrete(name="Survived", breaks=c(0, 1)) + 
  #文本設(shè)置
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1), vjust=-0.5)+ 
  #小題目設(shè)置
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

發(fā)現(xiàn)不同頭銜的幸存率也是不同的。

#算IV和WOV
WOETable(X=factor(data$Title[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Title[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

Title 對survived有很好的預(yù)測效果，也需要把Title 添加到預(yù)測模型的特征變量中

#最后，從名稱中獲取到姓氏
#sapply()函數(shù)：根據(jù)傳入?yún)?shù)規(guī)則重新構(gòu)建一個合理的數(shù)據(jù)類型返回
data$Surname <- sapply(data$Name,  function(x) strsplit(x, split = '[,.]')[[1]][1])

3.乘客性別Sex 對生存率的影響

#首先將Sex因子化
data$Sex<-factor(data$Sex)
#用ggplot統(tǒng)計出Sex的幸存和遇難人數(shù)
ggplot(data[1:nrow(train),], aes(x = Sex, y = ..count.., fill=Survived))+
  geom_bar(stat = "count", position='dodge') + 
  #標(biāo)題設(shè)置
  labs(title="How Sex impact survivor",y='Count',x='Sex')+ 
  scale_fill_discrete(name="Survived", breaks=c(0, 1)) + 
  #文本設(shè)置
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1), vjust=-0.5)+ 
  #小題目設(shè)置
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

女性的幸存率要遠(yuǎn)遠(yuǎn)高于男性

#算IV和WOV
WOETable(X=factor(data$Sex[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Sex[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

Sex 對survived有很好的預(yù)測效果，也需要把Sex 添加到預(yù)測模型的特征變量中

4.乘客年齡Age 對生存率的影響

#將年齡劃分成2個階段 
data$AgeGroup[data$Age < 18] <- 'child'
data$AgeGroup[data$Age >= 18] <- 'adult'
table(data$AgeGroup,data$Survived)

下面分析年齡對生存率的影響

#首先將AgeGroup因子化
data$AgeGroup<-factor(data$AgeGroup)
#用ggplot統(tǒng)計出Sex的幸存和遇難人數(shù)
ggplot(data[1:nrow(train),], aes(x = AgeGroup, y = ..count.., fill=Survived))+
  geom_bar(stat = "count", position='dodge') + 
  #標(biāo)題設(shè)置
  labs(title="How AgeGroup impact survivor",y='Count',x='AgeGroup')+ 
  scale_fill_discrete(name="Survived", breaks=c(0, 1)) + 
  #文本設(shè)置
  geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width=1), vjust=-0.5)+ 
  #小題目設(shè)置
  theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

暫且不管NA （缺失數(shù)據(jù)）的存活情況，我們可以發(fā)現(xiàn)，小孩的成活概率是大于50%的

#算IV和WOV
WOETable(X=factor(data$AgeGroup[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$AgeGroup[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

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

雖然電影如實的演示了，“讓女性和小孩先走”的這一人道主義原則。但第一條數(shù)據(jù)就給我們展示出的冰冷的現(xiàn)實。階層越高，幸存率越高。即在救生船有限的情況下，先讓上層階級的家人（老婆孩子）上救生船。等排到最后的時候才輪到平民階層的家人（老婆孩子）。

ftable(xtabs(~ Pclass+Sex+Survived, data=data))

第一階層女性91/94 存活率是0.9680851;第二階層女性70/76 存活率是0.9210526;第三階層女性72/144 存活率是0.5

5.配偶及兄弟姐妹數(shù)適中的乘客更易幸存

ggplot(data[1:nrow(train),], aes(x = SibSp, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How SibSp impact survivor", x = "SibSp", y = "Count", fill = "Survived") + 
  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")

配偶及兄弟姐妹數(shù)在1的時候幸存率是大于50%的，到了2的時候就成了46.4%。但是高于或者低于1或者2的幸存率就大大降低了

#算IV和WOV
WOETable(X=factor(data$SibSp[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$SibSp[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

SibSp 對survived有很好的預(yù)測效果，也需要把SibSp 添加到預(yù)測模型的特征變量中

6.父母及子女?dāng)?shù)適中的乘客更易幸存

ggplot(data[1:nrow(train),], aes(x = Parch, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How Parch impact survivor", x = "Parch", y = "Count", fill = "Survived") + 
  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")

父母與子女?dāng)?shù)數(shù)目大于等于4或者小于1的幸存率都小于50%

#算IV和WOV
WOETable(X=factor(data$Parch[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Parch[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

Parch 對survived有很好的預(yù)測效果，也需要把Parch 添加到預(yù)測模型的特征變量中

觀察上述兩個變量，發(fā)現(xiàn)不管是SibSp(配偶及兄弟姐妹數(shù))還是Parch(父母與子女?dāng)?shù))其實都是家人的數(shù)目，那可以把這倆變量合并到一起

7.家庭規(guī)模數(shù)量Fsize 對生存率的影響(綜合5、6)

# 創(chuàng)建一個包含乘客自己的家庭規(guī)模變量
data$Fsize <- data$SibSp + data$Parch + 1
ggplot(data[1:nrow(train),], aes(x = Fsize, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How Fsize impact survivor", x = "Fsize", y = "Count", fill = "Survived") + 
  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")

家庭成員數(shù)在2~4之間的話，個體存活率都會大于50%，而數(shù)目為1或者太多的話存活率小

#算IV和WOV
WOETable(X=factor(data$Fsize[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Fsize[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

比前兩個因素的IV信息價值高，F(xiàn)size 對survived有很好的預(yù)測效果，也需要把Fsize添加到預(yù)測模型的特征變量中

8.共票號乘客幸存率高

#首先統(tǒng)計出每張票對應(yīng)的乘客數(shù)
ticket.count <- aggregate(data$Ticket, by = list(data$Ticket),
                          function(x) sum(!is.na(x)))
#現(xiàn)將所有乘客按照Ticket分為兩組，一組是使用單獨(dú)票號，另一組是與他人共享票號，并統(tǒng)計出各組的幸存與遇難人數(shù)
data$TicketCount <- apply(data, 1, function(x) ticket.count[which(ticket.count[, 1] == x['Ticket']), 2])
#把data里等于1的和大于1的標(biāo)注成Unique和share
data$TicketCount <- factor(sapply(data$TicketCount, function(x) ifelse(x > 1, 'Share', 'Unique')))
ggplot(data[1:nrow(train),], aes(x = TicketCount, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How TicketCount impact survivor", x = "TicketCount", y = "Count", fill = "Survived")+
  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和WOV
WOETable(X=factor(data$TicketCount[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$TicketCount[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

Ticketcount對survived有很好的預(yù)測效果，也需要把Ticketcount添加到預(yù)測模型的特征變量中

9.支出船票價格對生存率的影響
價格是連續(xù)的，采用ggplot中 geom_line()進(jìn)行模擬

ggplot(data[1:nrow(train), ], aes(x = Fare, fill= as.factor(Survived),color = Survived)) + 
  geom_line(aes(label=..count..), stat = 'bin', binwidth=10)  + 
  labs(title = "How Fare impact survivor", x = "Fare", y = "Count", fill = "Survived")

觀察藍(lán)色存活數(shù)量的線條，我們可以發(fā)現(xiàn)，船票價格越高，生存率越高

#算IV和WOV
WOETable(X=factor(data$Fare[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Fare[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

Fare對survived有很好的預(yù)測效果，也需要把Fare添加到預(yù)測模型的特征變量中

10.船艙位置Cabin對生存率的影響
Cabin（船艙）這一變量可以看出第一個數(shù)值基本上都是一個字母，然后才是一連串?dāng)?shù)字，其實可以猜到不同的字母表示的就是不同的船艙。所以可以通過字母表示不同船艙的生存率

data$Cabin<-factor(data$Cabin)
ggplot(data[1:nrow(train), ], aes(x = as.factor(sapply(data$Cabin[1:nrow(train)], function(x) str_sub(x, start = 1, end = 1))), y = ..count.., fill = Survived)) +
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How Cabin impact survivor", x = "Cabin", y = "Count", fill = "Survived")+
  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")

不同船艙的生存率不同

#將首字母提出
data$Cabin <- sapply(data$Cabin, function(x) str_sub(x, start = 1, end = 1))
#算IV和WOV
WOETable(X=factor(data$Cabin[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Cabin[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

0.1866526,雖然高價值但是缺失值太多,不太能做一個合格的預(yù)測

11.登船位置Embarked對生存率的影響

data$Embarked<-factor(data$Embarked)
ggplot(data[1:nrow(train),], aes(x = Embarked, y = ..count.., fill=Survived)) + 
  geom_bar(stat = 'count', position='dodge') + 
  labs(title = "How Embarked impact survivor", x = "Embarked", y = "Count", fill = "Survived") + 
  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")

可以看出字母為S的幸存率比較低，而字母為C的幸存率大于50%

#算IV和WOV
WOETable(X=factor(data$Embarked[1:nrow(train)]), Y=data$Survived[1:nrow(train)])
IV(X=factor(data$Embarked[1:nrow(train)]), Y=data$Survived[1:nrow(train)])

Embarked 對survived有很好的預(yù)測效果，也需要把Embarked添加到預(yù)測模型的特征變量中

三、缺失值處理

由于所給的數(shù)據(jù)集并不大，我們不能通過刪除一行或者一列來處理缺失值，因而對于我們關(guān)注的一些字段參數(shù)，我們需要根據(jù)統(tǒng)計學(xué)的描述數(shù)據(jù)（平均值、中位數(shù)等等）來合理給出缺失值

summary(data)
library(mice)
md.pattern(data)

Cabin缺失值過多，直接刪除，Age有263個缺失，和Fare有1個缺失

1.Age的缺失和填補(bǔ)

#統(tǒng)計年齡的缺失個數(shù)
Age_null_count <- sum(is.na(data$Age))

通常我們會使用 rpart (recursive partitioning for regression) 包來做缺失值預(yù)測。插值思路是利用rpart（決策樹）替代knn來預(yù)測缺失值。對于因子類變量而言，我們在調(diào)用rpart函數(shù)式可以把method設(shè)為class（譯者注：即用分類樹)，數(shù)值型變量就設(shè)定method=anova（回歸樹）。當(dāng)然，我們也要避免把響應(yīng)變量傳入函數(shù)。

library(rpart) # 回歸樹的方法，用來預(yù)測缺失的數(shù)據(jù)
age.model <- rpart(Age ~ Pclass + Sex + SibSp + Parch + Fare + Embarked + Title + Fsize, data=data[!is.na(dataAge[is.na(dataAge), ])
在這里使用 mice 包進(jìn)行處理

# 使自變量因子化
factor_vars <- c('PassengerId','Pclass','Sex','Embarked',
                 'Title','Surname','Fsize')
#lapply()返回一個長度與X一致的列表，每個元素為FUN計算出的結(jié)果，且分別對應(yīng)到X中的每個元素。
data[factor_vars] <- lapply(data[factor_vars],function(x) as.factor(x))
# 設(shè)置隨機(jī)值
set.seed(129)
# 執(zhí)行多重插補(bǔ)法，剔除一些沒什么用的變量:
mice_mod <- mice(data[, !names(data) %in% c('PassengerId','Name','Ticket','Cabin','Family','Surname','Survived')], method='rf') 

# 保存完成的輸出 
mice_output <- complete(mice_mod)
#讓我們來比較一下我們得到的結(jié)果與原來的乘客的年齡分布以確保沒有明顯的偏差
# 繪制直方圖
par(mfrow=c(1,2))
hist(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模型的結(jié)果對原年齡數(shù)據(jù)進(jìn)行替換

# 用mice模型數(shù)據(jù)替換原始數(shù)據(jù)
data$Age <- mice_output$Age
# 再次查看年齡的缺失值數(shù)據(jù)
sum(is.na(data$Age))

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

得到票價缺失個數(shù)為1 ，缺失行數(shù)為第1044行

data[1044,]

查看這一行我們會發(fā)現(xiàn),港口和艙位是完整的，我們可以根據(jù)相同的港口和相同的艙位來大致估計該乘客的票價，我們?nèi)∵@些類似乘客的中位數(shù)來替換缺失的值

#從港口Southampton ('S')出發(fā)的三等艙乘客。 從相同港口出發(fā)且處于相同艙位的乘客數(shù)目
sum(data$Pclass == '3' & data$Embarked == 'S')

# 基于出發(fā)港口和客艙等級，替換票價缺失值
data$Fare[1044] <-8.05#8.05為中位數(shù)median(data[data$Pclass == '3' & data$Embarked == 'S', ]$Fare, na.rm = TRUE)

四、訓(xùn)練模型

randomForest函數(shù)默認(rèn)生成500棵樹，并且默認(rèn)在每個節(jié)點(diǎn)處抽取的變量數(shù)，即指定節(jié)點(diǎn)中用于二叉樹的變量個數(shù)，默認(rèn)情況下數(shù)據(jù)集變量個數(shù)的二次方根（分類模型）或三分之一（預(yù)測模型）

#拆分?jǐn)?shù)據(jù)集
train <- data[1:891,]
test <- data[892:1309,]
# 構(gòu)建預(yù)測模型
library(randomForest) # 隨機(jī)森林
library(e1071) # 在機(jī)器學(xué)習(xí)領(lǐng)域，支持向量機(jī)SVM(Support Vector Machine)是一個有監(jiān)督的學(xué)習(xí)模型， 
#通常用來進(jìn)行模式識別、分類以及回歸分析,文中predict就是這個包的
library(party) # 遞歸分區(qū)的計算工具箱。包的核心是ctree（），這是一個條件推理樹的實現(xiàn)，它將樹結(jié)構(gòu)的回歸模型嵌入到一個明確的條件推理過程理論中。這種非參數(shù)類的回歸樹適用于各種回歸問題，包括名義，序數(shù)，數(shù)字，檢查以及多變量響應(yīng)變量和協(xié)變量的任意測量量表。
#基于條件推理樹，cforest（）提供了布里曼隨機(jī)森林的實現(xiàn)。
library(class) # 各種分類功能。包括KNN，學(xué)習(xí)向量量化和自組織圖
rf_model <- randomForest(factor(Survived) ~ Pclass + Sex + Age + Fare+ Embarked + Title + Fsize,data = train,na.action=na.roughfix,importance=TRUE)
rf_model

在每棵樹的每個節(jié)點(diǎn)隨機(jī)抽取2個變量，從而生成了500棵傳統(tǒng)決策樹，na.action=na.roughfix參數(shù)可將數(shù)值變量中的缺失值替換為對應(yīng)列的中位數(shù)，類別變量中的缺失值替換成對應(yīng)列的眾數(shù)類（若有多個眾數(shù)則隨機(jī)選一個）

注：randomForest包根據(jù)傳統(tǒng)決策樹生成隨機(jī)森林，而party包中的cforest函數(shù)則可基于條件推斷樹生成隨機(jī)森林，當(dāng)預(yù)測變量間高度相關(guān)時，基于條件推斷樹的隨機(jī)森林可能效果更好。

五、交叉驗證

一般情況下，應(yīng)該將訓(xùn)練數(shù)據(jù)分為兩部分，一部分用于訓(xùn)練，另一部分用于驗證?；蛘呤褂胟-fold交叉驗證。本文將所有訓(xùn)練數(shù)據(jù)都用于訓(xùn)練，然后隨機(jī)選取30%數(shù)據(jù)集用于驗證。

library(MLmetrics) # 衡量回歸，分類和排名表現(xiàn)的評估指標(biāo)的集合,交叉驗證的時候用
cv.summarize <- function(data.true, data.predict) {
  print(paste('Recall:', Recall(data.true, data.predict)))  #recall:召回值
  print(paste('Precision:', Precision(data.true, data.predict)))   #precision:精度
  print(paste('Accuracy:', Accuracy(data.predict, data.true)))   #Accuracy:準(zhǔn)確性
  print(paste('AUC:', AUC(data.predict, data.true)))  #AUC:Area Under Curve(曲線下面積)
}
set.seed(415)
cv.test.sample <- sample(1:nrow(train), as.integer(0.3 * nrow(train)), replace = TRUE)
cv.test <- data[cv.test.sample,]
#OOB（out-of-bag）即袋外預(yù)測誤差，是生成樹時沒有用到的樣本點(diǎn)所對應(yīng)的類別可由生成的樹估計時，與其真實類別比較所得的誤差
cv.prediction <- predict(rf_model, cv.test, OOB=TRUE, type = "response")
cv.summarize(cv.test$Survived, cv.prediction)

六、重要性排行

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

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

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

最后，我們使用訓(xùn)練好的特征模型作用于測試數(shù)據(jù)上，得到我們的預(yù)測結(jié)果

# 對訓(xùn)練集外樣本點(diǎn)分類
prediction <- predict(rf_model, test)
# 保存數(shù)據(jù)結(jié)果passagerId 和survived參數(shù)
solution <- data.frame(PassengerID = test$PassengerId, Survived = prediction)
# 保存到文件
write.csv(solution, file = 'F:/kaggle/泰坦尼克號：災(zāi)難中的機(jī)器學(xué)習(xí)/predict_Solution.csv')