泰坦尼克號倖存預測n ——Kaggle排名321名（前4%）

01-31

這次我選擇使用R及Rstudio為工具，來對Titanic: Machine

Learning from Disaster進行數據分析並預測，本文使用了隨機森林演算法，隨機森林演算法相比於決策樹演算法的優點之一就是可以避免決策樹演算法的過度擬合。最後的得到的結果在Kaggle排名前4%。關於泰坦尼克號生存預測競賽的詳情在前面的文章已經說過了，這裡就略過這部分介紹直接進入正題。

一、數據整理

1、導入併合並數據集。

train<-read.csv("train.csv") #讀取train集ntest <- read.csv("test.csv") #讀取test集nlibrary(dplyr)ntitanic<-bind_rows(train,test) #合併train集和test集n

2、查看數據結構

str(titanic) #查看數據結構ndata.frame:t1309 obs. of 12 variables:n $ PassengerId: int 1 2 3 4 5 6 7 8 9 10 ...n $ Survived : int 0 1 1 1 0 0 0 0 1 1 ...n $ Pclass : int 3 1 3 1 3 3 1 3 3 2 ...n $ Name : chr "Braund, Mr. Owen Harris" "Cumings, Mrs. John Bradley (Florence Briggs Thayer)" "Heikkinen, Miss. Laina" "Futrelle, Mrs. Jacques Heath (Lily May Peel)" ...n $ Sex : Factor w/ 2 levels "female","male": 2 1 1 1 2 2 2 2 1 1 ...n $ Age : num 22 38 26 35 35 NA 54 2 27 14 ...n $ SibSp : int 1 1 0 1 0 0 0 3 0 1 ...n $ Parch : int 0 0 0 0 0 0 0 1 2 0 ...n $ Ticket : chr "A/5 21171" "PC 17599" "STON/O2. 3101282" "113803" ...n $ Fare : num 7.25 71.28 7.92 53.1 8.05 ...n $ Cabin : chr "" "C85" "" "C123" ...n $ Embarked : chr "S" "C" "S" "S" ...n

了解到到所有變數的數據類型，方便之後使用時進行適當轉換。

> sapply(titanic,function(x) sum(is.na(x)))#查看缺失值nPassengerId Survived Pclass Name Sex Age SibSp Parch n 0 418 0 0 0 263 0 0 n Ticket Fare Cabin Embarked n 0 1 0 0 n> sapply(titanic,function(x) sum(x==""))#查看空值nPassengerId Survived Pclass Name Sex Age SibSp Parch n 0 NA 0 0 0 NA 0 0 n Ticket Fare Cabin Embarked n 0 NA 1014 2 n

由以上代碼可以得出，變數Survived存在418個缺失值，變數Age存在263個缺失值，變數Fare存在1個缺失值。此外，變數Embarked存在2空值，Cabin存在1014個空值。

3、查看數據總結

summary(titanic) #查看數據總結n PassengerId Survived Pclass Name n Min. : 1 Min. :0.0000 Min. :1.000 Length:1309 n 1st Qu.: 328 1st Qu.:0.0000 1st Qu.:2.000 Class :character n Median : 655 Median :0.0000 Median :3.000 Mode :character n Mean : 655 Mean :0.3838 Mean :2.295 n 3rd Qu.: 982 3rd Qu.:1.0000 3rd Qu.:3.000 n Max. :1309 Max. :1.0000 Max. :3.000 n NAs :418 n Sex Age SibSp Parch n female:466 Min. : 0.17 Min. :0.0000 Min. :0.000 n male :843 1st Qu.:21.00 1st Qu.:0.0000 1st Qu.:0.000 n Median :28.00 Median :0.0000 Median :0.000 n Mean :29.88 Mean :0.4989 Mean :0.385 n 3rd Qu.:39.00 3rd Qu.:1.0000 3rd Qu.:0.000 n Max. :80.00 Max. :8.0000 Max. :9.000 n NAs :263 n Ticket Fare Cabin n Length:1309 Min. : 0.000 Length:1309 n Class :character 1st Qu.: 7.896 Class :character n Mode :character Median : 14.454 Mode :character n Mean : 33.295 n 3rd Qu.: 31.275 n Max. :512.329 n NAs :1 n Embarked n Length:1309 n Class :character n Mode :character n n

二、數據分析

1、性別與存活情況的關係

library(ggplot2)n> titanic$Survived<-as.factor(titanic$Survived) #轉變為名義型變數n> ggplot(data = titanic[1:891,],mapping = aes(x = Sex,fill=Survived))+ n+ geom_bar(stat = "count",position = "dodge")+ n+ xlab("性別")+n+ ylab("人數")+n+ ggtitle("性別和存活情況的關係")+n+ theme_classic(base_size = 12)+ n+ scale_fill_manual(values = c("red1","green2"))+ n+ geom_text(mapping = aes(label=..count..,vjust=-0.1),stat = "count",position = position_jitterdodge(jitter.width = 0,jitter.height = 0.75,dodge.width =1 ))n

很顯然，女性的存活率大大高於男性。

為了確定變數Sex的信息價值，使用函數WOETable和IV進行分析。

> library(InformationValue)n> WOETable(X=titanic$Sex[1:891], Y=titanic$Survived[1:891])n CAT GOODS BADS TOTAL PCT_G PCT_B WOE IVn1 female 233 81 314 0.6812865 0.147541 1.5298770 0.8165651n2 male 109 468 577 0.3187135 0.852459 -0.9838327 0.5251163n> IV(X=titanic$Sex[1:891], Y=titanic$Survived[1:891])n[1] 1.341681nattr(,"howgood")n[1] "Highly Predictive"n

確定了變數Sex為"Highly Predictive"，IV為1.341681，對Survived的影響很大。

2、客艙等級與存活情況的關係

> titanic$Pclass<-as.factor(titanic$Pclass)n> ggplot(data = titanic[1:891,],mapping = aes(x = Pclass,fill=Survived))+ #客艙等級與存活情況的關係n+ geom_bar(stat = "count",position = "dodge")+n+ xlab("客艙等級")+n+ ylab("人數")+n+ ggtitle("客艙等級和存活情況的關係")+n+ theme_classic(base_size = 12)+n+ scale_fill_manual(values = c("skyblue","brown2"))+ #填充顏色n+ geom_text(mapping = aes(label=..count..,vjust=-0.1),stat = "count",position = position_dodge(width = 1))n

可見，客艙等級越高，存活率越高。

> IV(X=titanic$Pclass[1:891], Y=titanic$Survived[1:891])n[1] 0.5009497nattr(,"howgood")n[1] "Highly Predictive"n

變數Pclass是 "Highly Predictive"，IV為0.5009497影響比重較高。

3、船上父母及子女數量與存活情況的關係

> ggplot(data=titanic[1:891,],mapping = aes(x=SibSp,fill=Survived))+n+ geom_bar(stat = "count",position = "dodge")+n+ xlab("船上父母及子女數量")+n+ ylab("人數")+n+ ggtitle("船上父母及子女數與存活情況的關係")+n+ theme_classic(base_size = 12)+n+ scale_fill_manual(values=c("red2","green2"))+n+ geom_text(aes(label=..count..,vjust=-0.1),stat="count",position=position_dodge(width = 1))+n+ scale_x_continuous(breaks = seq(0,8,1))n

可見，當船上父母及子女數量為0或者大於2時，乘客的存活率較低；船上父母及子女數量等於1或2時，存活率較高。

4、船上兄弟姐妹數量與存活情況的關係

> ggplot(data=titanic[1:891,],mapping = aes(x=Parch,fill=Survived))+n+ geom_bar(stat = "count",position = "dodge")+n+ xlab("船上兄弟姐妹數量")+n+ ylab("人數")+n+ ggtitle("船上兄弟姐妹數量與存活情況的關係")+n+ theme_classic(base_size = 12)+n+ scale_fill_manual(values=c("tan","gray65"))+n+ geom_text(aes(label=..count..,vjust=-0.1),stat = "count",position = position_dodge(width = 1))+n+ scale_x_continuous(breaks = seq(0,6,1))n

類似的，當船上兄弟姐妹數量為0或者大於2時，乘客的存活率較低；船上兄弟姐妹數量等於1或2時，存活率較高。我們可以構造一個新的變數家庭規模HouseholdSize，HouseholdSize由變數SibSp和Parch只和再加上1（乘客本人）。

> titanic$SibSp<-as.numeric(titanic$SibSp)#轉變為數值型變數n> titanic$Parch<-as.numeric(titanic$Parch)n> titanic<-transform(titanic,HouseholdSize=SibSp+Parch+1)#構造新變數nggplot(data=titanic[1:891,],mapping = aes(x=HouseholdSize,fill=Survived))+n+ geom_bar(stat = "count",position = "dodge")+n+ xlab("家庭規模大小")+n+ ylab("人數")+n+ ggtitle(("家庭規模大小與存活情況的關係"))+n+ theme_classic(base_size = 12)+n+ scale_fill_manual(values = c("lightblue","lightgreen"))+n+ geom_text(aes(label=..count..,vjust=-0.1),stat = "count",position = position_dodge(width = 1))+n+ scale_x_continuous(breaks = seq(0,12,1))n

當家庭規模在2到4之間時，乘客的存活率高於50%，存活率很高，而家庭規模為1或者大於4時，乘客的存活率非常低。

> IV(X=factor(titanic$HouseholdSize[1:891]), Y=titanic$Survived[1:891])n[1] 0.3497672nattr(,"howgood")n[1] "Highly Predictive"n

同樣，變數HouseholdSize屬於"Highly Predictive"，IV值為0.3497672。

5、稱呼與存活情況的關係

由於數據集中的姓名中存在稱呼，不同身份的人會有不同的稱呼，我們猜測稱呼可能會對存活情況有一定影響。

利用正則表達式對變數Name進行截取。

> titanic$Title<-as.factor(gsub("(.+, )|(..+)","",titanic$Name))#Titlen> titanic$FamilyName<-as.factor(gsub("(.+.)","",titanic$Name))#Family Namen

性別與稱呼的列聯表

> table(titanic$Sex,titanic$Title)#列聯表n n Capt Col Don Dona Dr Jonkheer Lady Major Master Miss Mllen female 0 0 0 1 1 0 1 0 0 260 2n male 1 4 1 0 7 1 0 2 61 0 0n n Mme Mr Mrs Ms Rev Sir the Countessn female 1 0 197 2 0 0 1n male 0 757 0 0 8 1 0n

由此得出了不同性別的諸多不同的稱呼。

在這裡對一些稀少的稱呼進行合併。

titanic$Title[titanic$Title%in%c("Capt","Col","Don","Jonkheer","Major","Male","Rev","Sir")]<-"Sir"ntitanic$Title[titanic$Title%in%c("Dona","Lady","Mlle","Mme","Ms","the Countess")]<-"Lady"n> table(titanic$Sex,titanic$Title)#列聯表n n Capt Col Don Dona Dr Jonkheer Lady Major Master Miss Mllen female 0 0 0 0 1 0 8 0 0 260 0n male 0 0 0 0 7 0 0 0 61 0 0n n Mme Mr Mrs Ms Rev Sir the Countessn female 0 0 197 0 0 0 0n male 0 757 0 0 0 18 0n

稀少的稱呼已經合併完畢。

> ggplot(data = titanic[1:891,],mapping = aes(x=Title,y=..count..,fill=Survived))+n+ geom_bar(stat = "count",position = "dodge")+n+ xlab("稱呼")+n+ ylab("人數")+n+ ggtitle("稱呼與存活情況```````````````````````的關係")+n+ geom_text(aes(label=..count..,vjust=-0.1),stat="count",position = position_dodge(width = 1))n

有圖可知，稱呼Mr的死亡率非常高，稱呼Miss、Mrs、Marster的存活率較高。

> IV(X=titanic$Title[1:891], Y=titanic$Survived[1:891])n[1] 1.500843nattr(,"howgood")n[1] "Highly Predictive"n

變數Title為"Highly Predictive"，IV值為「 1.500843」，是影響比重較高的變數。

6、船票編號與存活情況的關係

船票編號比較複雜，不同的數值非常多，不過部分乘客的船票編號是相同的。從某種意義上我們可以假設船票編號相同的乘客共用同一張船票。我們可以試著分析有共票的乘客和單獨船票的乘客之間的存活情況是否存在差異。

對變數Ticket進行分組，得到新的變數TicketCount

TicketCount <- aggregate.data.frame(titanic$Ticket, by=list(titanic$Ticket),function(x) sum(!is.na(x)))n

查看變數TicketCount

summary(TicketCount)n Group.1 x n Length:929 Min. : 1.000 n Class :character 1st Qu.: 1.000 n Mode :character Median : 1.000 n Mean : 1.409 n 3rd Qu.: 1.000 n Max. :11.000 n

對變數TicketCount進行分類

> titanic$TicketCount <- apply(titanic, 1, function(x) TicketCount[which(TicketCount[, 1] == x[Ticket]), 2])n> titanic$TicketCount <- factor(sapply(titanic$TicketCount, function(x) ifelse(x > 1, 共用票號, 單獨票號)))n> ggplot(data = titanic[1:891,],mapping = aes(x=TicketCount,fill=Survived))+n+ geom_bar(stat = "count",position = "dodge")+n+ xlab("船票編號")+n+ ylab("人數")+n+ ggtitle("船票編號和存活情況的關係")+n+ geom_text(aes(label=..count..,vjust=-0.1),stat = "count",position = position_dodge(width = 1))n

可見，共用船票的乘客的存活於大大高於單獨船票的乘客。

> WOETable(X=factor(titanic$TicketCount[1:891]), Y=titanic$Survived[1:891])n CAT GOODS BADS TOTAL PCT_G PCT_B WOE IVn1 單獨票號 130 351 481 0.380117 0.6393443 -0.5199641 0.1347889n2 共用票號 212 198 410 0.619883 0.3606557 0.5416069 0.1403993n> IV(X=factor(titanic$TicketCount[1:891]), Y=titanic$Survived[1:891])n[1] 0.2751882nattr(,"howgood")n[1] "Highly Predictive"n

變數TicketCount屬於"Highly Predictive"，IV值為「0.2751882」。

7、年齡與存活情況的關係

在數據集titanic中，年齡存在263個缺失值。需要對缺失值進行插補。

首先查看缺失值的具體情況。

> library(VIM)n> aggr(titanic,prop=F,number=T) #缺失值圖n

查看當前的年齡分布。

> hist1<-hist(titanic$Age,main = "原數據年齡分布",col = "lightblue")n

因缺失值較多，使用中位數或平均數插補可能誤差較大，因此，這裡使用回歸樹模型對年齡進行插補。

> library(rpart)n> age_model <- rpart(Age~Pclass + Sex + Fare + Embarked + HouseholdSize, data =titanic[!is.na(titanic$Age), ],method = "anova", na.action = na.omit)n> titanic$Age[is.na(titanic$Age)] <- predict(age_model, titanic[is.na(titanic$Age), ])n

查看插補後的年齡分布

> hist2<-hist(titanic$Age,main="插補後年齡分布",col = "lightgreen")n

插補缺失值後，年齡的分布並未發生明顯變化。

> ggplot(data=titanic[1:891,],mapping = aes(x=Age,color=Survived))+#插補後年齡與存活情況的關係n+ geom_line(stat="bin",binwidth_=2)+ #設置組距n+ xlab("年齡")+n+ ylab("人數")+n+ ggtitle("年齡與存活情況的關係")+n+ theme_classic(base_size = 12)+n+ scale_color_manual(values=c("red","blue"))+n+ scale_x_continuous(breaks = seq(0,80,5)) #設置X軸坐標軸刻度範圍&間隔n

可見當年齡低於15歲時，乘客的存活率比較高，大於50%；18歲到35歲之間的乘客存活率很低，低於50%；年齡大於60歲的乘客的存活率也低與50%。

> IV(X=factor(titanic$Age[1:891]), Y=titanic$Survived[1:891])n[1] 0.329006nattr(,"howgood")n[1] "Highly Predictive"n

變數Age屬於"Highly Predictive"，IV值為0.329006。

8、船票價格與存活情況的關係

> ggplot(data=titanic[1:891,],mapping = aes(x=Fare,color=Survived))+n+ geom_line(stat="bin",binwidth_=10)+n+ xlab("船票價格")+n+ ylab("人數")+n+ ggtitle("船票價格與存活情況的關係")+n+ theme_classic(base_size = 12)+n+ scale_color_manual(values=c("tomato","blue"))+n+ scale_x_continuous(breaks = seq(0,520,25)) #設置X軸坐標軸刻度範圍&間隔n

可見大體上，票價越高，存活率越高。

變數Fare存在一個缺失值，查看該缺失值的相關信息。

> which(is.na(titanic$Fare))n[1] 1044n> titanic[1044,]n PassengerId Survived Pclass Name Sex Age SibSpn1044 1044 <NA> 3 Storey, Mr. Thomas male 60.5 0n Parch Ticket Fare Cabin Embarked HouseholdSize Titlen1044 0 3701 NA S 1 Mrn TicketCountn1044 單獨票號n

編號1044的乘客位於低級客艙，登船港口為S，船票編號為3701。

繪製低級客艙、登船港口為S的乘客的票價分布的核密度圖。

> ggplot(data=titanic[titanic$Pclass=="3"&titanic$Embarked=="S",],mapping=aes(x=Fare))+n+ geom_density(fill = "tomato")+#核密度圖n+ geom_vline(aes(xintercept=median(Fare,na.rm = T)))+#中位數n+ scale_x_continuous(breaks = seq(0,60,5))n

使用中位數進行插補。

> titanic$Fare[1044]<-median(titanic$Fare[titanic$Pclass=="3"&titanic$Embarked=="S"],na.rm = T)n

計算IV值。

> IV(X=factor(titanic$Fare[1:891]), Y=titanic$Survived[1:891])n[1] 0.6123083nattr(,"howgood")n[1] "Highly Predictive"n

變數Fare屬於"Highly Predictive"，IV值為0.6123083。

9、登船港口與存活情況的關係

前面查看缺失值和空值，變數Embarked有兩個空值。

首先把空值轉變為缺失值。

> titanic$Embarked[titanic$Embarked==""]<-NAn

查看缺失值。

> which(is.na(titanic$Embarked))n[1] 62 830n> titanic[c(62,830),]n PassengerId Survived Pclassn62 62 1 1n830 830 1 1n Name Sex Age SibSpn62 Icard, Miss. Amelie female 38 0n830 Stone, Mrs. George Nelson (Martha Evelyn) female 62 0n Parch Ticket Fare Cabin Embarked HouseholdSize Titlen62 0 113572 80 B28 <NA> 1 Missn830 0 113572 80 B28 <NA> 1 Mrsn TicketCountn62 共用票號n830 共用票號n

Embarked存在缺失值的乘客位於，高級客艙，票價80。

繪製客艙等級、票價和登船港口的箱線圖。

> ggplot(data = titanic[1:891,],mapping=aes(x=Pclass,y=Fare,fill=Embarked))+n+ geom_boxplot()+n+ geom_hline(yintercept = 80)#80為票價n

在客艙等級為低級時，票價80的乘客正好位於登船港口為S的乘客的中位數附近。因此，有理由認為這兩位乘客的登船港口為「C」。

> titanic$Embarked[is.na(titanic$Embarked)]<-"C"n

繪製登船港口與存活情況的條形圖。

> ggplot(data=titanic[1:891,],mapping=aes(x=factor(Embarked),y=..count..,fill=Survived))+n+ geom_bar(stat = "count",position = "dodge")+n+ xlab("登船港口")+n+ ylab("人數")+n+ ggtitle("登船港口和存活情況的關係")+n+ theme_classic(base_size = 12)+n+ scale_fill_manual(values = c("lightblue","lightgreen"))+n+ geom_text(aes(label=..count..,vjust=-0.1),stat = "count",position = position_dodge(width = 1))n

可見，登船港口為「C」的乘客存活率較高，大於50%；登船港口為「Q」的乘客略低於50%；登船港口為「S」的乘客的存活率在30%左右，存活率最低。

查看IV值。

> IV(X=factor(titanic$Embarked[1:891]), Y=titanic$Survived[1:891])n[1] 0.129404nattr(,"howgood")n[1] "Highly Predictive"n

變數Embarked為"Highly Predictive"，IV值為「0.129404」。

10、客艙區域與存活情況的關係

首先把變數Cabin的空值轉變為缺失值。

> titanic$Cabin[titanic$Cabin==""]<-NAn

由於變數Cabin的缺失值太多，有1014條，可利用的信息不足，不過觀察數據Cabin可以發現變數Cabin的第一個字元都是大寫的英文字母，如「A」、「C」等。可以大膽猜測，開頭的字母很可能是不同客艙區域的編號。

所以，可以截取變數Cabin的第一個字元構造新的變數來探究和存活情況是否有關聯。

> titanic$CabinArea<-as.factor(sapply(titanic$Cabin,function(x) substr(x,1,1)))n

接下來進行可視化。

> ggplot(data=titanic[1:891,],mapping = aes(x=CabinArea,y=..count..,fill=Survived))+n+ geom_bar(stat = "count",position = "dodge")+n+ xlab("客艙區域")+n+ ylab("人數")+n+ ggtitle("客艙區域與存活情況的關係")+n+ theme_classic(base_size = 12)+n+ geom_text(aes(label=..count..,vjust=-0.1),stat = "count",position = position_dodge(width = 1))n

忽略缺失值，可以看出不同的客艙區域的乘客的生存率是有明顯差異的。

計算WOE和IV值。

> WOETable(X=titanic$CabinArea[1:891], Y=titanic$Survived[1:891])n CAT GOODS BADS TOTAL PCT_G PCT_B WOE IVn1 A 7 8 15 0.05109489 0.11764706 -0.8340046 0.055504815n2 B 35 12 47 0.25547445 0.17647059 0.3699682 0.029228917n3 C 35 24 59 0.25547445 0.35294118 -0.3231790 0.031499197n4 D 25 8 33 0.18248175 0.11764706 0.4389611 0.028459906n5 E 24 8 32 0.17518248 0.11764706 0.3981391 0.022907100n6 F 8 5 13 0.05839416 0.07352941 -0.2304696 0.003488215n7 G 2 2 4 0.01459854 0.02941176 -0.7004732 0.010376267n8 T 1 1 1 0.00729927 0.01470588 -0.7004732 0.005188134n> IV(X=titanic$CabinArea[1:891], Y=titanic$Survived[1:891])n[1] 0.1866526nattr(,"howgood")n[1] "Highly Predictive"n

可見變數Cabin_Area屬於"Highly Predictive"，IV值為0.1866526。

三、建立模型與預測

R語言中的隨機森林函數有randomForest包中的randomForest函數和party中的cforest函數等。

1、使用randomForest函數

randomForest中的決策樹基於基尼指數構建，即CART分類決策樹。

該函數有兩個局限性，一是建立模型所用的數據集中不能存在缺失值；二是每個變數的分類屬性不能超過32個，如果超過32個，那麼在使用randomForest之前必須進行轉化。

由於變數Age、Fare的分類屬性都超過了32，所以我們必須對變數進行重構。而且，由於變數Cabin存在缺失值而且由於缺失值較多很難進行插補，只能捨棄這個變數。

下面對變數Age和Fare進行重構。

> titanic$Age_new[titanic$Age<16]<-"child"n> titanic$Age_new[titanic$Age>=16&titanic$Age<30]<-"young"n> titanic$Age_new[titanic$Age>=30&titanic$Age<40]<-"middle1"n> titanic$Age_new[titanic$Age>=40&titanic$Age<60]<-"middle2"n> titanic$Age_new[titanic$Age>=60]<-"elder"n> titanic$Fare_new[titanic$Fare<15]<-"Fare1"n> titanic$Fare_new[titanic$Fare>=15&titanic$Fare<25]<-"Fare2"n> titanic$Fare_new[titanic$Fare>=25&titanic$Fare<40]<-"Fare3"n> titanic$Fare_new[titanic$Fare>=40&titanic$Fare<75]<-"Fare4"n> titanic$Fare_new[titanic$Fare>=75]<-"Fare5"n> titanic$Fare_new[titanic$Fare>75]<-"Fare6"n

查看WOE和IV值。

> WOETable(X=factor(titanic$Age_new[1:891]), Y=titanic$Survived[1:891])n CAT GOODS BADS TOTAL PCT_G PCT_B WOEn1 child 49 34 83 0.14327485 0.06193078 0.83874748n2 elder 7 19 26 0.02046784 0.03460838 -0.52524113n3 middle1 77 101 178 0.22514620 0.18397086 0.20197261n4 middle2 68 99 167 0.19883041 0.18032787 0.09767556n5 young 141 296 437 0.41228070 0.53916211 -0.26831186n IVn1 0.068227134n2 0.007427195n3 0.008316291n4 0.001807246n5 0.034043787n> IV(X=factor(titanic$Age_new[1:891]), Y=titanic$Survived[1:891])n[1] 0.1198217nattr(,"howgood")n[1] "Highly Predictive"n> WOETable(X=factor(titanic$Fare_new[1:891]), Y=titanic$Survived[1:891])n CAT GOODS BADS TOTAL PCT_G PCT_B WOEn1 Fare1 114 343 457 0.3333333 0.62477231 -0.6282443n2 Fare2 46 54 100 0.1345029 0.09836066 0.3129451n3 Fare3 69 89 158 0.2017544 0.16211293 0.2187578n4 Fare4 39 40 79 0.1140351 0.07285974 0.4479699n5 Fare6 74 23 97 0.2163743 0.04189435 1.6418586n IVn1 0.183094876n2 0.011310544n3 0.008671879n4 0.018445314n5 0.286471347n> IV(X=factor(titanic$Fare_new[1:891]), Y=titanic$Survived[1:891])n[1] 0.507994nattr(,"howgood")n[1] "Highly Predictive"n

變數Age_new屬於"Highly Predictive"，IV值為0.1198217。因此該變數可以作為模型的預測因子。

變數Fare_new屬於"Highly Predictive"，IV值為0.507994。該變數也可以作為模型的預測因子。

轉變變數類型並重新建立數據集。

> titanic$Age_new<-as.factor(titanic$Age_new)n> titanic$Fare_new<-factor(titanic$Fare_new)n> titanic$HouseholdSize<-factor(titanic$HouseholdSize)n> titanic$Embarked<-factor(titanic$Embarked)n> train<-titanic[1:891,]n> test<-titanic[892:1309,]n

建立模型並預測

> library(randomForest)n> set.seed(754)n> model1<-randomForest(as.factor(Survived) ~ Sex + Pclass + HouseholdSize + Title + TicketCount + Embarked + Age_new + Fare_new,data = train,ntree=2000,ntry=3,proximity=T,importance=T)n

模型重要性檢測。

> importance(model1,type=1) #重要性評分 n MeanDecreaseAccuracynSex 25.52377nPclass 32.44370nHouseholdSize 25.58617nTitle 32.51083nTicketCount 14.27335nEmbarked 11.81593nAge_new 17.45803nFare_new 23.33845n> importance(model1,type=2) #Gini指數 n MeanDecreaseGininSex 55.71966nPclass 31.94038nHouseholdSize 30.67084nTitle 72.63808nTicketCount 6.93413nEmbarked 10.23839nAge_new 17.49366nFare_new 26.37954n> varImpPlot(model1) #可視化n

利用模型進行預測並輸出。

> prediction1 <-predict(model1,test)n> output1<-data.frame(PassengerId=test$PassengerId,Survived=prediction1 )n> write.csv(output1,file = "prediction1.csv",row.names = FALSE)n

將生成的CSV文件「prediction1.csv」上傳到Kaggle，得分如下。

2、使用cforest函數

cforest函數相較於randomForest可以處理缺失值，對變數的分類屬性也沒有要求。

轉變變數類型並重新建立數據集。

> titanic$Age<-as.factor(titanic$Age)n> titanic$Fare<-as.factor(titanic$Fare)n> titanic$HouseholdSize<-as.factor(titanic$HouseholdSize)n> titanic$Embarked<-as.factor(titanic$Embarked)n> titanic$CabinArea<-as.factor(titanic$CabinArea)n> train<-titanic[1:891,]n> test<-titanic[892:1309,]n

建立模型並預測

> library(party)n> set.seed(415)n> model2<-cforest(as.factor(Survived) ~ Sex + Pclass + HouseholdSize + CabinArea + Title + TicketCount + Embarked + Age + Fare,data = train, controls = cforest_unbiased(ntree=2000,mtry=3))n> prediction2 <-predict(model2,test, OOB=TRUE, type = "response")n> output2<-data.frame(PassengerId=test$PassengerId,Survived=prediction2 )n> write.csv(output2,file = "prediction2.csv",row.names = FALSE)n

不過要說的是，由於運算量較大，建立模型model2時，cforest函數運行了一個多小時。

將生成的CSV文件「prediction2.csv」(文件名被我修改了，標註的是ntree=2000)上傳到Kaggle，得分如下。

最終在Kaggle上的排名321名，前4%。