背景
泰坦尼克号由位于北愛爾蘭貝爾法斯特的哈蘭·沃爾夫船廠興建,是當時最大的客運輪船,由于其規模相當一艘現代航空母艦,因而号稱“上帝也沉沒不了的巨型郵輪”。在泰坦尼克号的處女航中,從英國南安普敦出發,途經法國瑟堡-奧克特維爾以及愛爾蘭昆士敦,計劃橫渡大西洋前往美國紐約市。但因為人為錯誤,于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人的人來說,死亡的占比會較高。我們可以将這個變量分解為三個級别,建立一個家庭規模變量。
#家庭規模
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")
柱狀圖表明,單身人士和大家庭中存在幸存率較低,但小家庭的乘客幸存率占優勢
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’出發
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
包來完成這項任務,你可以在 https://blog.csdn.net/sinat_26917383/article/details/51265213 中檢視主要
mice
處理缺失值的方法
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
生成的值
# 将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%。 紅線和綠線分别顯示“死亡”和“幸存”的錯誤率。 我們可以看到,現在我們在預測死亡方面比預測生存的錯誤率更低
#變量的重要性
varImpPlot(rf_model)
我們以基尼系數的平均減少來看相對變量的重要性,其中最為重要的變量是Titel,而pclass變量相對而言不是那麼的重要
預測
#預測使用測試集
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