泰坦尼克號生存預測(kaggle排名129前2%)

1、數據來源及說明

(1)數據來源

來自kaggle的數據集Titanic:Titanic: Machine Learning from Disaster

(2)數據說明

下載的數據包含test.csv和train.csv兩個文件,分析時可以將兩個文檔合併。train文檔數據是用來分析和建模,包含有生存情況信息;test數據是用來最終預測其生存情況並生成結果文件。

2、分析目的和思路

本文主要根據train數據的分析並建立模型,預測test數據中乘客在沉船事件中的生存情況。思路主要分為以下幾個過程:

(1)讀入train和test數據併合並;(2)查看缺失值並對缺失值進行處理;(3)不同變數跟生存情況的關係分析;(4)建立模型並預測;(5)提交預測結果,查看網站排名。

3、數據分析和建模

3.1前期準備

3.1.1 載入數據包

#載入相關的數據包library(ggplot2)library(ggthemes)library(scales)library(plyr)library(dplyr)library(mice)library(randomForest)library(party)library(corrplot)

3.1.2 數據載入和查閱

載入數據並查看,了解數據量和相關變數含義,並將train和test數據合併。

使用read.csv函數時會自動把字元串string的列辨認成因子(factor), 「stringsAsFactors = F」表示不默認成factor。

#讀入數據並查看train <- read.csv("G:/大數據作業實踐和有用資料/第五關作業實踐/泰坦尼克存活預測案例/data/train.csv")test <- read.csv("G:/大數據作業實踐和有用資料/第五關作業實踐/泰坦尼克存活預測案例/data/test.csv")str(train)str(test)data <- bind_rows(train,test)summary(data)

3.1.3理解各數據變數含義

3.2 數據預處理

3.2.1查看缺失值

#數據預處理#第一步,查看缺失值sapply(data,function(x) sum(is.na(x)))sapply(data,function(x) sum(x == ""))

所有變數的缺失值信息如下

3.2.2 補充缺失值

(1)補充Embarked的2個空值

首先,查看Embarked的2個空值位置和相關信息

########查看2個空值的位置和相關信息Embarked.na <- data$Embarkedwhich(Embarked.na %in% "")data_62 <- data[data$PassengerId == 62,]data_830 <- data[data$PassengerId == 830,]data_62data_830

上圖信息顯示,62號乘客和830號乘客的票價Fare都是80, Pclass都是1,那麼先假設票價、客艙和等級相同的乘客是在同一個登船港口登船。

其次,用ggplot2繪製Embarked,fare,pclass的箱線圖(Boxplot)。

########用ggplot2繪製Embarked,fare,pclass的箱線圖ggplot(data[!is.na(data$Embarked),],aes(x=Embarked, y=Fare, fill=factor(Pclass))) + geom_boxplot() + geom_hline(aes(yintercept=80), color=red, linetype=dashed, lwd=2) + scale_y_continuous(labels=dollar_format()) + theme_few()

由上圖所見,Embarked為C且Pclass為1的乘客的Fare中位數為80。因此可以將缺失的Embarked值設置為「C」。

#######定義Embarked空白值為「C"data$Embarked[c(62,830)] <- "C"sapply(data,function(x) sum(x == ""))

再次查看Embarked值,顯示空白值為「0」,缺失數據已補齊。

(2)補充Fare的缺失值

首先,還是查看缺失值的位置和相關信息

########查看缺失值位置和相關信息Fare.na <- is.na(data$Fare)which(Fare.na %in% TRUE)data_1044 <- data[data$PassengerId == 1044,]data_1044

可以看出該乘客是在S登船港口上船,且客艙等級Pclass為3。提取都是從S登船港口上船且Pclass為3的乘客信息,然後用ggplot2繪圖用中位數補充缺失數據。

########用ggplot2繪製Embarked,fare,pclass的箱線圖ggplot(data[data$Embarked==S & data$Pclass == 3,],aes(x=Embarked, y=Fare, fill=factor(Pclass))) + geom_boxplot() + geom_hline(aes(yintercept=80), color=red, linetype=dashed, lwd=2) + scale_y_continuous(labels=dollar_format()) + theme_few() ########用中位數填充缺失值b <- median(data$Fare[data$Embarked == S & data$Pclass == 3],na.rm = T)data$Fare[1044] <- 8.05sapply(data,function(x) sum(is.na(x)))

S登船港口上船且Pclass為3的乘客費用Fare的中位數為8.05,因此Fare的空缺值補充為8.05。再次查看時Fare的空缺值為「0」,說明已填補。

(3)補充Age的缺失值

因為Survive的缺失值是合併test數據造成的,因此只剩下Age的空缺數據。

缺失Age的數據為263個,數據量比較大,採用多重插補法用MICE預測填補Age的缺失數據。

########查看年齡缺失值相關信息data[is.na(data$Age),]########設置隨機種子set.seed(129)########執行多重插補法並輸出ss <- c(PassengerId,Name,Ticket,Cabin,family,Surname,Survived)mice_age <- mice(data[,!names(data) %in% ss],method = rf)mice_output <- complete(mice_age)

繪製Age預測結果與Age原始數據的分布圖,對比其年齡分布情況,檢驗預測結果準確性。

########繪製年齡分布圖par(mfrow=c(1,2))hist(data$Age,freq = F,main = Age:ORiginal Data,col=darkblue,ylim = c(0,0.04))hist(mice_output$Age,freq = F,main = Age:MICE Output,col = skyblue,ylim = c(0,0.04))########使用預測結果的年齡替換原始數據中的年齡data$Age <- mice_output$Age

從上圖可以看出,Age預測結果和原始數據的分布狀態基本相似,因此可以用Age的預測結果代替原始數據中的Age。

至此,所有的缺失數據都已經補齊,數據預處理工作完成。

3.3 數據分析

這部分主要是分析各變數對生存率的影響,PassengerID不在分析之列。

3.3.1 變數Pclass對生存率的影響

用ggplot繪製不同客艙等級Pclass的存活和死亡的柱狀分布圖。

###(1)Pclass對存活率的影響data$Survived <- factor(data$Survived)ggplot(data = data[1:nrow(train),], mapping = aes(x = Pclass, y = ..count.., fill=Survived)) + geom_bar(stat = "count", position=dodge) + xlab(Pclass) + ylab(Count) + ggtitle(Different Pclass impact survived) + 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")

由上圖可知,等級越高,存活率越高。即Pclass為1的乘客存活率最高,Pclass為2的乘客存活率次之,Pclass為3的乘客存活率最低。

3.3.2 變數Name對生存率的影響

Name的重複度較低,通過提取特徵值Title進行分類,一共有18種不同Title。分析時將人數較少的「Capt,Col,Don,Dona,Jonkheer,Lady,Major,Mlle,Mme,Ms,Sir,the Countess」的統歸為Others並將「Mlle,Mme,Ms」進行重新定義。

###(2)Name對存活率的影響########提取姓名中的titledata$Title <- sapply(data$Name, FUN=function(x) {strsplit(x, split=[,.])[[1]][2]})data$Title <- sub(" ","",data$Title)table(data$Title) ##查看Title的種類###將數量較少的Title歸類為Others,並重新定義一些稱呼Others <- c(Capt,Col,Don,Dona,Jonkheer,Lady,Major,Sir,the Countess)data$Title[data$Title==Mlle] <- Missdata$Title[data$Title==Mme] <- Mrsdata$Title[data$Title==Ms] <- Missdata$Title[data$Title %in% Others] <- Otherstable(data$Title)

原始Title和重新編譯後的Title顯示如下:

用ggplot繪製不同Title乘客的遇難和存活情況。

###用ggplot2繪製不同Title乘客的遇難和存活數ggplot(data = data[1:891,], mapping = aes(x = Title, y = ..count.., fill=Survived)) + geom_bar(stat = "count", position=stack) + xlab(Title) + ylab(Count) + ggtitle(Different Title impact survivor) + scale_fill_discrete(name="Survived", breaks=c(0, 1), labels=c("0", "1")) + geom_text(stat = "count", aes(label = ..count..), position=position_stack(vjust = 0.5)) + theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

由上圖可看出,Title為Mr的乘客倖存比例非常小,而Title為Mrs和Miss的乘客倖存比例非常大。

3.3.3 變數Sex對生存率的影響

用ggplot繪製不同Title乘客的遇難和存活情況

###(3)Sex對存活率的影響data$Sex <- as.factor(data$Sex)ggplot(data = data[1:891,], mapping = aes(x = Sex, y = ..count.., fill=Survived)) + geom_bar(stat = count, position=dodge) + xlab(Sex) + ylab(Count) + ggtitle(Different Sex 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")

由上圖可以看出,女性的存活比例遠大於男性。

3.3.4 家庭人口數FamilySize對生存率的影響

(1)分別查看不同SibSp和Parch對生存率的影響

#####先看SibSp對存活率的影響ggplot(data = data[1:891,], mapping = aes(x = SibSp, y = ..count.., fill=Survived)) + geom_bar(stat = count, position=dodge) + labs(title = "Different SibSp impact survivor", x = "Sibsp", y = "Count", fill = "Survived") + geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width_=1), , vjust=-0.5) + scale_x_continuous(breaks = c(0:8)) + theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")#####再看Parch對存活率的影響ggplot(data = data[1:891,], mapping = aes(x = Parch, y = ..count.., fill=Survived)) + geom_bar(stat = count, position=dodge) + labs(title = "Different Parch impact survivor", x = "Parch", y = "Count", fill = "Survived") + geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width_=1), , vjust=-0.5) + scale_x_continuous(breaks = c(0:6)) + theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

由上面兩圖可以看出,配偶及兄弟姐妹數SibSp和父母與子女數Parch在1-3之間時,存活率最高。而SibSp和Parch為0或大於4時,存活率明顯下降。

因此,分析時引入新的變數家庭人口數FamilySize代替原始數據中的SibSp和Parch變數。

(2)查看不同新變數FamilySize對生存率的影響

首先,新生成一列家庭人口數FamilySize的數據,然後用ggplot2繪製家庭人口數FamilySize與存活情況的關係圖。

#####新變數FamilySize對存活率的影響data$FamilySize <- data$SibSp + data$Parch + 1data$FamilySizeggplot(data = data[1:891,], mapping = aes(x = FamilySize, y = ..count.., fill=Survived)) + geom_bar(stat = count, position=dodge) + xlab(FamilySize) + ylab(Count) + ggtitle(Different FamilySize impact survivor) + geom_text(stat = "count", aes(label = ..count..), position=position_dodge(width_=1), , vjust=-0.5) + scale_x_continuous(breaks = c(0:11)) + theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

由上圖可知,FamilySize在2-4時,存活率最高。

3.3.5 變數Age對生存率的影響

(1)分析Age和生存情況的關係

用ggplot繪製不同年齡的生存情況曲線圖。

ggplot(data[!is.na(data$Survived),],aes(Age,color=Survived))+ geom_line(aes(label=..count..), stat = bin, binwidth_=5) + labs(title = "Different Age impact survivor", x = "Age", y = "Count", fill = "Survived")+ theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

由上圖可知,年輕人(20歲以下)的存活率較高。參考別人文章,分析時按照成年人和未成年人生成新變數Age_New進行分析,即把不同年齡Age劃分為兩組,即成年人(Age>=18)和小孩(Age<18)。

(2)分析新變數Age_New和生存情況的關係

#####生成新變數Age_New並進行分析data$Age_New[data$Age < 18] <- childdata$Age_New[data$Age >= 18] <- adultdata$Age_Newtable(data$Age_New,data$Survived)#####用ggplot2繪製成年人和兒童的存活情況ggplot(data[!is.na(data$Survived),],aes(Age_New,fill=Survived))+ geom_bar(stat = count,position = dodge)+ ggtitle(Adult and Child 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")

由上圖可知,未成年人的存戶率明顯偏高。後期建模時採用新變數Age_New。

3.3.6 變數Ticket對生存率的影響

變數Ticket的重複度較低,通常每個Ticket編號對應一個乘客,通俗理解為每張票對應一人。出現相同Ticket對應多人時,可理解為是家庭成員。

先統計每張票對應的乘客數,然後按相同Ticket對應乘客數進行分組查看。

###(6)ticket對存活率的影響ticket.count <- aggregate(data$Ticket, by = list(data$Ticket), function(x) sum(!is.na(x)))ticket.counttable(ticket.count$x)

由分組統計結果可知,每個Ticket編號對應1個乘客的比例為54.5%,每個Ticket編號對應2-4個乘客的比例為36.3%,每個Ticket編號對應大於4個乘客的比例僅為9.2%。

前期已經對家庭人數進行存活情況進行分析,因此,該變數對存活情況的影響建模時不考慮。

3.3.7 變數Fare對生存率的影響

用ggplot繪製變數Fare與存活情況的曲線圖。

###(7)票價Fare對存活率的影響ggplot(data = data[!is.na(data$Survived) ,], aes(x = Fare, color=Survived)) + geom_line(aes(label=..count..), stat = bin, binwidth_=10) + labs(title = "Different Fare impact survivor", x = "Fare", y = "Count", fill = "Survived")+ theme(plot.title = element_text(hjust = 0.5), legend.position="bottom")

由上圖可知,票價Fare越高,存活率越大。

3.3.8 變數Cabin對生存率的影響

客艙號Cabin共有1014個空缺值,佔比為77.5%。因此本次分析建模時沒考慮變數Cabin對存活率的影響。

3.3.9 變數Embarked對生存率的影響

用ggplot繪製登船港口Embarked跟存活情況的關係圖。

###(8)登船港口Embarked對存活率的影響ggplot(data[1:891, ], mapping = aes(x = Embarked, y = ..count.., fill = Survived)) + geom_bar(stat = count, position=dodge) + xlab(Embarked) + ylab(Count) + ggtitle(Different Embarked 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")

由上圖可知,Embarked為C的乘客倖存率最高,Embarked為Q的乘客存活率次之,Embarked為S的乘客倖存率最低。

3.3.10 數據分析小結

至此,各變數對存活情況影響的數據分析已經完成,進而確定變數Plcass、Title、Sex、Age_New、FamilySize、Fare、Embarked都對生存率有著一定的影響。但究竟哪個影響更大,目前尚不清楚。

3.4 建模預測

這部分主要包括三大內容:建立決策樹模型、結果預測以及對預測結果改進的幾點建議。

3.4.1 建立模型

#建模預測###(1)建立模型data$Pclass <- factor(data$Pclass)data$Title <- factor(data$Title)data$Sex <- factor(data$Sex)data$Age_New <- factor(data$Age_New)data$FamilySize <- factor(data$FamilySize)data$Fare <- factor(data$Fare)data$Embarked <- factor(data$Embarked)train <- data[1:891,]test <- data[892:1309,]set.seed(102)model <- cforest(Survived ~ Pclass + Title + Sex + Age_New + FamilySize + Fare + Embarked, data = train,controls = cforest_unbiased(ntree=2000,mtry=3))

3.4.2 結果預測

###(2)生成預測結果prediction<-predict(model,test,OOB=TRUE,type = "response") output<-data.frame(PassengerId=test$PassengerId,Survived=prediction)outputwrite.csv(output,file = "G:/大數據作業實踐和有用資料/第五關作業實踐/da/output/Prediction1.csv",row.names = FALSE)

生成預測的Prediction1.csv文件,馬上去網站提交看排名。激動人心的時刻終於到了,排名129,進入Top2%。這個結果自己還是比較滿意的。

另補充一點,對影響模型的因子重要性進行分析,可以明確哪些變數對建立模型的影響較大,針對不同權重的影響因子相信能夠把預測結果準確性進一步提高。嘗試很多次後未成實現,水平有限,暫時沒做這塊內容。一點點小缺憾啊!!

3.4.4 預測結果改進的建議

(1)選用不同的建模方法,會對預測結果有影響。建議參考排名靠前的高手的方法。

(2)變數Age只是參考別人方法簡單以18歲為分界線劃分為成年人和小孩,根據數據分布進行更精確的劃分可能減小誤差,改進預測結果。

(3)客艙號Cabin對應船上的不同位置,肯定會對存活情況有影響。但由於缺失數據太多,本次建模時沒考慮這個變數。

(4)建模後對影響模型因子重要性進行分析,把影響大的因子進行優化和再分析提煉,相信也會對預測結果有影響。這部分工作本來準備做的,查閱相關方法後沒能實現,只好作罷。

(4)本次預測只是單獨對每個變數進行簡單分析後當做建立模型的因子進行預測。通過對不同變數數據的深入分析整理,進而提煉出新的影響因子(如在甲板上人數等等),應該會對預測結果有進一步的提升。

4、總結和思考

(1)這次泰坦尼克生存預測還是照貓畫虎地模仿別人方法進行,變數處理和預測方法還有很多改進之處。但自己寫代碼預測完成後,對R的建模等實踐有了初步了解。再結合前期的簡單數據處理和複雜數據處理學習,感覺對R語言的基本應用有了全面的了解和認識。

(2)對預測過程中遇到的概率統計知識發現極為匱乏。後續需加強這方面的學習,當初學的已經都還給高校老師了。

(3)本次預測參考了幾篇自己認為很有價值的文章,很多思路和代碼也是借鑒別人而來的,下面把參考的相關文獻羅列出來,供大家參考。

參考文獻

[1] 機器學習(二) 如何做到Kaggle排名前2%

[2] 泰坦尼克號生存預測——kaggle排名403

[3] Titanic: Machine Learning from Disaster


推薦閱讀:

稀土· Meetup| 「碰撞最前沿的圖像識別技術」活動總結
【乾貨】Kaggle 數據挖掘比賽經驗分享
數據分析師什麼時候能不寫SQL了?
數據研究所:「妖怪」屬性卡製作手冊——LPL全上單全屬性綜述

TAG:R编程语言 | Kaggle | 大数据 |