天天看點

基于R語言的Kaggle案例分析-泰坦尼克号

背景

泰坦尼克号由位于北愛爾蘭貝爾法斯特的哈蘭·沃爾夫船廠興建,是當時最大的客運輪船,由于其規模相當一艘現代航空母艦,因而号稱“上帝也沉沒不了的巨型郵輪”。在泰坦尼克号的處女航中,從英國南安普敦出發,途經法國瑟堡-奧克特維爾以及愛爾蘭昆士敦,計劃橫渡大西洋前往美國紐約市。但因為人為錯誤,于1912年4月14日船上時間夜裡11點40分撞上冰山;2小時40分鐘後,即4月15日淩晨02點20分,船裂成兩半後沉入大西洋,死亡人數超越1500人,堪稱20世紀最大的海難事件,同時也是最廣為人知的海難之一。

資料

變量名稱 描述
Survived 幸存(1)或死亡(0)
Pclass 船艙等級
Name 姓名
Sex 性别
Age 年齡
sibsp:Sibling 兄弟姐妹
Sibsp:Spouse 配偶(包情婦和未婚夫被忽略)
Parch:Parent 母親和父親
Parch:Child 女兒,兒子,繼女,繼子,孩子隻和保姆旅行,對他們來說PARCH= 0
Ticket 票号
Fare 票價
Cabin 船倉号
Embarked 起點港口,C = Cherbourg, Q = Queenstown, S =Southampton

載入包

library('ggplot2') #可視化
#library('ggthemes') #可視化
#library('scales') #可視化
library('dplyr') #資料處理
library('mice') #插補
library(rpart)#決策樹算法
library(rpart.plot)#繪制決策樹
library(randomForest) #随機森林算法
           

導入資料

bind_rows是dplyr包的函數,因為我拿到的資料中,train和test的字段順序不一樣,是以直接進行rbind會出問題,是以使用bind_rows
train <- read.csv('train.csv', stringsAsFactors = F)
test  <- read.csv('test.csv', stringsAsFactors = F)
full  <- bind_rows(train, test) 
summary(full)#存在缺失值,後面需要進行處理
           

特征工程

從乘客姓名中擷取稱謂

“ Cavendish, Mrs. Tyrell William (Julia Florence Siegel)" 實際上取得是第一個逗号後和第一個點号前的資料

full$Title <- gsub('(.*, )|(\\..*)', '', full$Name)

#按性别顯示統計數量
table(full$Title,full$Sex)

#數非常低的字段要合并到“rare“
rare_title <- c('Dona', 'Lady', 'the Countess','Capt', 'Col', 'Don', 
                'Dr', 'Major', 'Rev', 'Sir', 'Jonkheer')

# 同時重新配置設定mlle,ms和mme
full$Title[full$Title == 'Mlle']        <- 'Miss' 
full$Title[full$Title == 'Ms']          <- 'Miss'
full$Title[full$Title == 'Mme']         <- 'Mrs' 
full$Title[full$Title %in% rare_title]  <- 'Rare Title'
full$Title<-as.factor(full$Title)#将稱謂置成因子型

#再按性别顯示Title數量
table(full$Sex, full$Title)
           
Title female male
Master 61
Miss 264
Mr 757
Mrs 198
Rare Title 4 25
我們将根據兄弟姐妹/配偶的數量制作一個家庭大小變量,(可能有人有一個以上的配偶)和孩子/父母的數量。
#建立一個包括乘客本身的家庭大小變量
#家庭規模=兄弟姐妹+配偶+自己
full$Fsize <- full$SibSp + full$Parch + 1

#使用ggplot2可視化家庭規模與生存之間的關系
ggplot(full[1:891,], aes(x = Fsize, fill = factor(Survived))) +
  geom_bar(stat='count', position='dodge') +
  scale_x_continuous(breaks=c(1:11)) +
  labs(x = 'Family Size')
           
我們可以看到,對于單身人士和家庭人數超過4人的人來說,死亡的占比會較高。我們可以将這個變量分解為三個級别,建立一個家庭規模變量。
基于R語言的Kaggle案例分析-泰坦尼克号
#家庭規模
full$FsizeD[full$Fsize == 1] <- 'singleton'
full$FsizeD[full$Fsize < 5 & full$Fsize > 1] <- 'small'
full$FsizeD[full$Fsize > 4] <- 'large'

library(sqldf)
full1<-sqldf('select FsizeD,Survived,count(1) as cnt from full where Survived>=0 group by FsizeD,Survived')
ggplot(full1,aes(x=FsizeD,y=cnt,fill=Survived))+geom_col(position="fill")
           
柱狀圖表明,單身人士和大家庭中存在幸存率較低,但小家庭的乘客幸存率占優勢
基于R語言的Kaggle案例分析-泰坦尼克号

62和830号乘客缺少出發港口的資訊,接下來我們進行缺失值填補,我們将根據我們能夠想象到的可能相關的目前資料:船艙登記和票價推斷他們的出發港口。

#我們看到,他們分别支付80美元和NA,他們的船艙等級是1和NA。那麼他們從哪裡出發呢?

full[c(62, 830), 'Embarked']

#其他乘客資訊
embark_fare <- full %>%
  filter(PassengerId != 62 & PassengerId != 830)

# 使用ggplot2可視化登船,乘客艙和中位數票價
ggplot(embark_fare, aes(x = Embarked, y = Fare, fill = factor(Pclass))) +
  geom_boxplot() +
  geom_hline(aes(yintercept=80), 
    colour='red', linetype='dashed', lwd=2) +
  scale_y_continuous(labels=dollar_format()) +
  theme_few()
           
從Charbourg(‘C’)起飛的頭等艙乘客的中位數票價與我們的乘客缺貨乘客支付的80美元相吻合。 由于他的頭等艙票價是80美元,他們很可能從’C’出發
基于R語言的Kaggle案例分析-泰坦尼克号
full$Embarked[c(62, 830)] <- 'C'
           
第1044行乘客缺失票價資訊,這是一名南安普敦(‘S’)的三等乘客。 我們使用同樣的南安普敦的三等座的有票價的票價的中位數替換缺失值
full$Fare[1044] <- median(full[full$Pclass == '3' & full$Embarked == 'S', ]$Fare, na.rm = TRUE)
           
最後,我們的資料中有一些缺失的Age值。 我們将基于其他變量對Age進行預測,我們使用

rf

(随機森林)來預測缺失的年齡,使用

mice

包來完成這項任務,你可以在 https://blog.csdn.net/sinat_26917383/article/details/51265213 中檢視主要

mice

處理缺失值的方法
#顯示缺少年齡值的數量
sum(is.na(full$Age))

#将變量因素納入因子
factor_vars <- c('PassengerId','Pclass','Sex','Embarked',
                 'Title','Surname','FsizeD')
full[factor_vars] <- lapply(full[factor_vars], function(x)as.factor(x))
#設定随機種子
set.seed(129)
#執行mice插補,排除某些不太有用的變量:
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

生成的值
基于R語言的Kaggle案例分析-泰坦尼克号
# 将Age變量替換為mice模型。
full$Age <- mice_output$Age

# 顯示缺少年齡值的新數量
sum(is.na(full$Age))
           
終于完成了對泰坦尼克資料集中所有相關缺失值的處理,還成功地建立了幾個新變量,我們希望這些變量可以幫助我們建立一個可靠地預測生存的模型

模組化

我們将依賴于

randomForest

分類算法
#分為訓練和測試集
train <- full[1:891,]
test <- full[892:1309,]

#建立模型
#然後我們使用訓練集上的`randomForest`建構我們的模型。
#構模組化型(注意:并非使用所有可能的變量)
rf_model <- randomForest(factor(Survived) ~ Pclass + Sex + Age + SibSp + Parch + Fare + Embarked + Title + FsizeD,importance=T,data = train)
           
黑線表示整體錯誤率低于20%。 紅線和綠線分别顯示“死亡”和“幸存”的錯誤率。 我們可以看到,現在我們在預測死亡方面比預測生存的錯誤率更低
基于R語言的Kaggle案例分析-泰坦尼克号
#變量的重要性
varImpPlot(rf_model)
           
我們以基尼系數的平均減少來看相對變量的重要性,其中最為重要的變量是Titel,而pclass變量相對而言不是那麼的重要
基于R語言的Kaggle案例分析-泰坦尼克号

預測

#預測使用測試集
prediction <- predict(rf_model, test)

#将解決方案儲存到具有兩列的資料框:
solution <- data.frame(PassengerID = test$PassengerId, Survived = prediction)
#寫入csv檔案
write.csv(solution, file = 'rf_mod_Solution.csv', row.names = F)
           

文章參考:

https://www.kaggle.com/nadintamer/titanic-survival-predictions-beginner

https://blog.csdn.net/yyxyyx10/article/details/78223196

繼續閱讀