CHAPTER4-2 : KAGGLE經典練習項目-Titanic

www.kaggle.com

機器學習系列(3)_邏輯回歸應用之Kaggle泰坦尼克之災 - CSDN博客?

blog.csdn.net機器學習（二） 如何做到Kaggle排名前2%?

www.jasongj.comKevinMeng：【Kaggle實例分析】Titanic Machine Learning from Disaster?

zhuanlan.zhihu.com數據挖掘模型中的IV和WOE詳解 - CSDN博客?

blog.csdn.net

關於KAGGLE

Your Home for Data Science?

kaggle.com

KAGGLE是一個是數據分析建模的應用競賽平台。正如首頁所寫的"Your Home for Data Science"。

關於Titanic: Machine Learning from Disaster

Kaggle首頁就可以找到這個項目，這個被無數先驅推薦的入門Kaggle練習項目，Kaggle上最受關注的題目之一了。跟著各路大神的思路學習完之後，或許不僅僅是電影故事加分，Kaggle提供的數據集也會讓你感受數據科學項目的樂趣。

這就是項目的背景頁，這個項目主要還是為了讓我們熟悉Kaggle項目的大致流程、ML基礎以及基本技能：二元分類和Python/R的基礎。

在Public Leaderboard裡面可以看到小夥伴們的提交，第一次看的時候被前12的1.00000驚呆了。

問題的背景就是那部暴露年齡的電影了，提供的訓練集（train.csv）和測試集（test.csv）是船上乘客的個人信息以及是否獲救，titanic需要我們根據手上的數據生成模型並預測其他人是否獲救。下面進入大致的流程。

數據準備

換了台電腦，環境都需要重新部署，許多package也要重新安裝。

#安裝載入相關圖形等相關package，rstudio的更新源實在是太慢了，建議大家更換國內的更新源。library(ggplot2)install.packages(ggplot2)library(ggthemes)install.packages(ggthemes)library(readr)install.packages(readr)library(scales)library(plyr)library(stringr)library(MLmetrics)install.packages(MLmetrics)library(InformationValue)install.packages(InformationValue)library(rpart)library(randomForest)install.packages(randomForest)library(dplyr)install.packages(dplyr)library(e1071)library(Amelia)library(party)library(gbm)library(class)library(woe)install.packages(woe)library(riv)install.packages(riv)install.packages(rrcov)install.packages(robustbase)install.packages(pcaPP)library(rrcov)library(robustbase)install.packages(bindrcpp)library(bindrcpp)install.packages(mice)library(mice)install.packages(lattice)library(lattice)install.packages(party)#導入訓練集train.csv和測試集test.csvtrain <- read.csv(C:/Kaggle/Titanic/train.csv , stringsAsFactors = F)test <- read.csv(C:/Kaggle/Titanic/test.csv, stringsAsFactors = F)head(train)

在RStudio的Console中可以看到：

訓練集：

測試集：

Enviorment中可以看到測試集共有11個變數，訓練集有12個變數，其中訓練集中多出的Survived代表乘客是否獲救，其他欄位均為相同的乘客信息。後續統一對訓練集和測試集操作，為了避免重複操作和出現不一致的情況，將兩個數據集合併，並觀察合併後的數據集。

#文章提到了可能碰到的Categorical類型新level的問題???隨機森林——二元分類的利器之Kaggle初體驗Titanic: Machine Learning from Disaster

data <- bind_rows(train, test)train.row <- 1:nrow(train)test.row <- (1 + nrow(train)):(nrow(train)+nrow(test))str(test)str(train)str(data)summary(data)

可見合併後的data中共有1309個觀測，其中包含測試集418個，訓練集891個。Survived變數NA有418個，Age中NA有263個，Fare中NA有1個。其中：

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, Miss. Laina" "Futrelle, Mrs. Jacques Heath (Lily May Peel)" ... $ 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" ...

分析的目標是根據這些數據預測訓練集中的乘客是否存活。下面就觀察屬性與是否存活之間的關聯統計。

數據特徵

• 獲救情況和屬性之間的關係

按照電影中大副喊的：」lady and kid first！「，猜測性別以及年齡將會對倖存的概率有所印象，下面先來看性別與獲救情況的關係。

• 獲救情況與性別的關係

#因子化data$Sex <- as.factor(data$Sex)data$Survived <- as.factor(data$Survived)#可視化ggplot(data = data[1:nrow(train),], mapping = aes(x = Sex, y = ..count.., fill=Survived)) + geom_bar(stat = "count", position=dodge) + xlab(性別) + ylab(獲救人數) + ggtitle(獲救情況與性別分布) + geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width_=0.5), , vjust=-0.5) + theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

從以上圖標可以看到：女性的存活率為233/（233+81）遠高於男性存活率（109/（109+468））。因此性別將作為最終模型中的一個特徵。

WOE的全稱是「Weight of Evidence」，即證據權重。WOE是對原始自變數的一種編碼形式。IV的全稱是Information Value，中文意思是信息價值，或者信息量。

# IV / WOE 計算library(InformationValue)install.packages(InformationValue)WOETable(X=data$Sex[1:nrow(train)], Y=data$Survived[1:nrow(train)])IV(X=data$Sex[1:nrow(train)], Y=data$Survived[1:nrow(train)])

從以上圖標可以看到：女性的存活率為233/（233+81）遠高於男性存活率（109/（109+468））。可以通過WOE和IV來定量的計算屬性的預測價值，Sex屬性的IV為1.34並Highly Predictive，因此Sex將作為最終模型中的一個特徵。

• 獲救情況與年齡的關係

結合電影與現實生活，猜測未成年人與成年人相比，具有更高的倖存概率，下面先分析下16歲以下與16歲以上的乘客的存活率。

ggplot(data = data[(!is.na(data$Age)) & row(data[Age]) <= 891, ], aes(x = Age, color=Survived)) + geom_line(aes(label=..count..), stat = bin, binwidth_=5) + labs(title = "獲救情況與年齡之間的關係", x = "年齡", y = "獲救人數", fill = "Survived")

• 獲救情況與乘客社會等級的關係

ggplot(data = data[1:nrow(train),], mapping = aes(x = Pclass, y = ..count.., fill=Survived)) + geom_bar(stat = "count", position=dodge) + xlab(乘客社會等級) + ylab(存活人數) + ggtitle(獲救情況與乘客社會等級之間的關係) + scale_fill_manual(values=c("#FF0000", "#00FF00")) + 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")

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)])

屬性的IV為0.5並Highly Predictive，因此Pclass將作為最終模型中的一個特徵。

• 獲救情況與船票價格之間的關係

ggplot(data = data[(!is.na(data$Fare))&row(data[Fare]) <= 891, ], aes(x = Fare, color=Survived)) + geom_line(aes(label=..count..), stat = bin, binwidth_=10) + labs(title = "獲救情況與船票價格之間的關係", x = "船票價格", y = "獲救人數", fill = "Survived")

通過上圖可以看到，對於Fare船票價格變數，Fare越大，存活概率越高，因此將船票價格作為最終模型的一個特徵。

• 獲救情況與Title之間的關係

據觀察姓名中包含了Mr. Mrs. Dr.等title，猜測這裡也類似Pclass屬性，文化水平較高的title與倖存幾率可能相關。

#按照對data的觀察，將以下的一些title進行了提取，並歸類data$Title <- sapply(data$Name, FUN=function(x) {strsplit(x, split=[,.])[[1]][2]})data$Title <- sub( , , data$Title)data$Title[data$Title %in% c(Mme, Mlle)] <- Mlledata$Title[data$Title %in% c(Capt, Don, Major, Sir)] <- Sirdata$Title[data$Title %in% c(Dona, Lady, the Countess, Jonkheer)] <- Lady#因子化data$Title <- factor(data$Title)#可視化ggplot(data = data[1:nrow(train),], mapping = aes(x = Title, y = ..count.., fill=Survived)) + geom_bar(stat = "count", position=stack) + xlab(Title) + ylab(獲救人數) + ggtitle(獲救情況與Title之間的關係) + scale_fill_discrete(name="Survived", breaks=c(0, 1), labels=c("Perish", "Survived")) + geom_text(stat = "count", aes(label = ..count..), position=position_stack(vjust = 0.5)) + theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

WOETable(X=data$Title[1:nrow(train)], Y=data$Survived[1:nrow(train)])IV(X=data$Title[1:nrow(train)], Y=data$Survived[1:nrow(train)])

猜測大部分的男性，如Title為Mr.的乘客倖存比例非常小(81/(81+436))，而Title為Mrs和Miss的乘客倖存比例非常大，分別為23/（17+23）和127/（127+55）。繼續定量計算Title這一變數對於最終的預測的印象。從WOE和IV結果可見，IV為1.520702，Highly Predictive。因此，將提取的Title作為最終模型中的一個特徵。

• 獲救情況與所處倉位的關係

按照電影最後的描述，倖存者中不乏社會上層人士，對比乘客的社會等級Pclass與獲救情況的關係，猜測Carbin屬性會與獲救情況有類似的關係。

#這裡使用sapply(data$Cabin[1:nrow(train)], function(x) str_sub(x, start = 1, end = 1))#來提取Cabin屬性的首字母，並按照不同首字母統計獲救情況。ggplot(data[1:nrow(train), ], mapping = 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) + xlab(Cabin) + ylab(Count) + ggtitle(How Cabin impact survivor) + 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")

如上圖所示，按照首字母進行提取後，人然後481的倉位屬性為NA，其餘Cabin對應的首字母中的B/C/D/E/F的乘客獲救概率高於50%，但是數量相對較受，後面要考慮如何填充相應的缺失值。

缺失值處理

• 羅列所有缺失數據

#這段有點問題 我再想想attach(data) missing <- list(Pclass=nrow(data[is.na(Pclass), ])) missing$Name <- nrow(data[is.na(Name), ]) missing$Sex <- nrow(data[is.na(Sex), ]) missing$Age <- nrow(data[is.na(Age), ]) missing$SibSp <- nrow(data[is.na(SibSp), ]) missing$Parch <- nrow(data[is.na(Parch), ]) missing$Ticket <- nrow(data[is.na(Ticket), ]) missing$Fare <- nrow(data[is.na(Fare), ]) missing$Cabin <- nrow(data[is.na(Cabin), ]) missing$Embarked <- nrow(data[is.na(Embarked), ]) for (name in names(missing)) { if (missing[[name]][1] > 0) { print(paste(, name, miss , missing[[name]][1], values, sep = )) } }detach(data)

完成對特徵的分析後，開始填補缺失值的過程。具體方法可以通過用最高頻率來填補缺失值，通過變數的相關關係填補缺失值，通過探索案例之間的相似性來填補等方式。在這裡通過以下方式進行填充。

• 均值中位數模型填充Embarked、Fare屬性

通過對data中的各個屬性進行分析，Embarked屬性或許與Pclass和Fare屬性相關聯。

# 去除缺失值對應的PassengerIDembark_fare <- data%>%filter(PassengerId != 62 & PassengerId != 830)#可視化ggplot(data[!is.na(data$Embarked),], aes(x=Embarked, y=Fare, fill=factor(Pclass))) + geom_boxplot() + xlab(港口) + ylab(船票價格) + ggtitle(船票價格與港口的關係) + geom_hline(aes(yintercept=80), color=red, linetype=dashed, lwd=2) + scale_y_continuous(labels=dollar_format()) + theme_few()

根據上圖可以看出中位數為$80，港口C的頭等艙支付的票價的中位數為80。因此可以將處於頭等艙且票價為$80的乘客62和830 的出發港口缺失值替換為C。

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

Fare屬性缺失的乘客PassengerID為1044，同樣按照中位數模型進行填充試試看。

#這個可視化是啥關係？怎麼在圖上標記中位數對應的x軸數值？ggplot(full[full$Pclass == 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()

類似的，使用$8.05對缺失的Fare進行替換

data$Fare[1044] <- median(data[data$Pclass == 3 & data$Embarked == S, ]$Fare, na.rm = TRUE)

• 預測模型填充年齡Age缺失值

通過缺失值統計可以看到：

#知乎的這個編輯模式，為什麼剪切會跳轉到頁面頂端？？？[1] "Age miss 263 values"

本文將基於年齡和其他屬性構建預測模型來對年齡缺失值進行預測填充。

通常我們會使用 rpart(recursive partitioning for regression) 包來做缺失值預測 在這裡我將使用 mice 包進行處理。具體理由，你可以通過閱讀關於基於鏈式方程 Chained Equations的多重插補法Multiple Imputation（MICE）的內容MICE(PDF). 在這之前我們先要對因子變數（factor variables）因子化，然後再進行多重插補法。

# 使因子變數因子化factor_vars <- c(PassengerId,Pclass,Sex,Embarked, Title,Surname,Family,FsizeD)full[factor_vars] <- lapply(full[factor_vars],function(x) as.factor(x))# 設置隨機種子set.seed(129)# 執行多重插補法，剔除一些沒有影響的變數:mice_mod <- mice(full[, !names(full) %in% c(PassengerId,Name,Ticket,Cabin,Family,Surname,Survived)], method=rf) # 保存完整輸出 mice_output <- complete(mice_mod)# 繪製年齡分布圖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))

• # MICE模型結果替換年齡變數.
  data$Age <- mice_output$Age

  # 檢查缺失值是否被完全替換了

  sum(is.na(data$Age))
• 默認值填充Cabin屬性

缺失Cabin信息的記錄數較多，不適合使用中位數或者平均值填補，一般通過使用其它變數預測或者直接將缺失值設置為默認值的方法填補。由於Cabin信息不太容易從其它變數預測，因此這裡直接將缺失的Cabin設置為一個默認值。

data$Cabin <- as.factor(sapply(data$Cabin, function(x) ifelse(is.na(x), X, str_sub(x, start = 1, end = 1))))

模型設計與預測

在完成上面的工作之後，進入到最後環節：預測泰坦尼克號上乘客的生存狀況。在這裡使用隨機森林分類演算法(The RandomForest Classification Algorithm) 。

• 拆分訓練集與測試集

train_pre <- full[1:nrow(train),]test_pre <- full[nrow(train) + 1:nrow(data),]

• 建立rForest模型

# 設置隨機種子set.seed(666)# 建立模型l，Pclass + Sex + Age + SibSp + Fare + Embarked + Title + Cabinrf_model <- randomForest(factor(Survived) ~ Pclass + Sex + SibSp + Age + Fare + Embarked + Title + Cabin, data = train_pre)# 顯示模型誤差plot(rf_model, ylim=c(0,0.36))legend(topright, colnames(rf_model$err.rate), col=1:3, fill=1:3)

• 使用測試集test_pre進行預測，保存預測結果並生成預測文件

# 使用測試數據集進行預測prediction <- predict(rf_model, test_pre)# 保存測試ID和測試結果生存與否solution <- data.frame(PassengerID = test_pre$PassengerId, Survived = prediction)# 寫出結果文件write.csv(solution, file = rf_Solution.csv, row.names = F)

• 提交

Kaggle的提交蠻有趣的，需要生成用戶的TOKEN之後提交，然後就可以在Leaderboard頁面查看自己的成績了。

AT LAST

根據項目的Data頁面的提示：

Variable Notespclass: A proxy for socio-economic status (SES)1st = Upper2nd = Middle3rd = Lowerage: Age is fractional if less than 1. If the age is estimated, is it in the form of xx.5sibsp: The dataset defines family relations in this way...Sibling = brother, sister, stepbrother, stepsisterSpouse = husband, wife (mistresses and fiancés were ignored)parch: The dataset defines family relations in this way...Parent = mother, fatherChild = daughter, son, stepdaughter, stepsonSome children travelled only with a nanny, therefore parch=0 for them.

本文裡面在使用rf預測的時候使用的變數有：Pclass/Sex/Age/ SibSp(原始的SibSp數據)/Fare/Embarked/Title/Cabin，下一步計劃根據parch和sibsp繼續優化。

題圖Titanic 3D Artwork, Zain Khan

YWSZ

代碼調試到吐 要好好學習下ggplot

推薦閱讀：