Titanic數(shù)據(jù)集分析

1、泰坦尼克數(shù)據(jù)集探索1. 簡介：從泰塔尼克數(shù)據(jù)集中，根據(jù)每個乘客的信息，建立模型并進(jìn)行預(yù)測。整篇文章分為三步：1. 特征選擇2. 缺失數(shù)據(jù)處理3. 預(yù)測1.1 導(dǎo)入軟件包并檢查數(shù)據(jù)> library('ggplot2') # 可視化> library('ggthemes') # 可視化> library('scales') # 可視化> library('dplyr') # 數(shù)據(jù)處理> library('mice') # 填充缺失數(shù)據(jù)> library('randomFor

2、est') # 分類算法> #數(shù)據(jù)的導(dǎo)入> setwd('D:/Titanic')#設(shè)置默認(rèn)功過路徑> train <- read.csv('train.csv',stringsAsFactors= FALSE)#訓(xùn)練集> test <- read.csv('test.csv',stringsAsFactors= FALSE)#測試集#進(jìn)行數(shù)據(jù)拼接，一同進(jìn)行特征選擇和缺失數(shù)據(jù)處理> full <- bind_rows(train, test) # bind training & te

3、st data> # check data> str(full)我們觀察到一共有1309條數(shù)據(jù)，每一條數(shù)據(jù)有12個相關(guān)變量。2. 特征工程頭銜># 從名稱中挖掘> # 從乘客名字中提取頭銜> #R中的grep、grepl、sub、gsub、regexpr、gregexpr等函數(shù)都使用正則表達(dá)式的規(guī)則進(jìn)行匹配。默認(rèn)是egrep的規(guī)則，sub函數(shù)只實現(xiàn)第一個位置的替換，gsub函數(shù)實現(xiàn)全局的替換。> full$Title <- gsub('(.*, )|(.*)', '', full$Name)> > # 查看按

4、照性別劃分的頭銜數(shù)量> table(full$Sex, full$Title)我們發(fā)現(xiàn)頭銜的類別太多，并且好多出現(xiàn)的頻次是很低的，我們可以將這些類別進(jìn)行合并> rare_title <- c('Dona', 'Lady', 'the Countess','Capt', 'Col', 'Don', + 'Dr', 'Major', 'Rev', 'Sir', 'Jonkheer')# 合并低頻頭銜為一類&

5、gt; # 重命名稱呼> full$Titlefull$Title = 'Mlle' <- 'Miss' > full$Titlefull$Title = 'Ms' <- 'Miss'> full$Titlefull$Title = 'Mme' <- 'Mrs' > full$Titlefull$Title %in% rare_title <- 'Rare Title'> > # 再次查看按照性別劃分的頭銜數(shù)量> ta

6、ble(full$Sex, full$Title)可以看到頭銜的個數(shù)得到了大量的縮減> #sapply()函數(shù)：根據(jù)傳入?yún)?shù)規(guī)則重新構(gòu)建一個合理的數(shù)據(jù)類型返回> full$Surname <- sapply(full$Name, + function(x) strsplit(x, split = ',.')11)家庭人數(shù)既然我們已經(jīng)根據(jù)乘客的名字劃分成一些新的變量,我們可以把它進(jìn)一步做一些新的家庭變量。首先我們要做一個基于兄弟姐妹/配偶數(shù)量(s)和兒童/父母數(shù)量的家庭規(guī)模變量。> # Create a family size variable inclu

7、ding the passenger themselves> full$Fsize <- full$SibSp + full$Parch + 1> > # Create a family variable > full$Family <- paste(full$Surname, full$Fsize, sep='_')> #為了直觀顯示，我們可以用ggplot2 畫出家庭成員數(shù)量和生存家庭數(shù)情況的圖形> ggplot(full1:891, aes(x = Fsize, fill = factor(Survived) + geom_

8、bar(stat='count', position='dodge') + scale_x_continuous(breaks=c(1:11) + labs(x = 'Family Size') + theme_few()> full$FsizeDfull$Fsize = 1 <- 'singleton'> full$FsizeDfull$Fsize < 5 & full$Fsize > 1 <- 'small'> full$FsizeDfull$Fsize >

9、; 4 <- 'large'> # Show family size by survival using a mosaic plot> mosaicplot(table(full$FsizeD, full$Survived), main='Family Size by Survival', shade=TRUE)嘗試創(chuàng)建一些新的特征> # This variable appears to have a lot of missing values> full$Cabin1:28> # Create a Deck variable

10、. Get passenger deck A - F:> full$Deck<-factor(sapply(full$Cabin, function(x) strsplit(x, NULL)11)還有更多可能的變量在這里完成，比如在乘客客艙變量 passenger cabin 也存在一些有價值的信息如客艙層數(shù) deck,但是這個變量的缺失值太多，無法做出新的有效的變量，暫時放棄這個變量的挖掘。3. 缺失數(shù)據(jù)的處理觀察文件中的數(shù)據(jù)，我們會發(fā)現(xiàn)有些乘客的信息參數(shù)并不完整，由于所給的數(shù)據(jù)集并不大，我們不能通過刪除一行或者一列來處理缺失值，因而對于我們關(guān)注的一些字段參數(shù)，我們需要根據(jù)統(tǒng)計學(xué)

11、的描述數(shù)據(jù)（平均值、中位數(shù)等等）來合理給出缺失值。我們可以通過函數(shù)查看缺失數(shù)據(jù)的變量在第幾條數(shù)據(jù)出現(xiàn)缺失和總共缺失的個數(shù)。我們將根據(jù)我們想象可能相關(guān)的現(xiàn)有數(shù)據(jù)，推測他們的登機(jī)價值：乘客等級和票價。 我們看到他們分別支付了80美元和$ NA，他們的班級是1和NA。 那么他們從哪里開始呢？> # Use ggplot2 to visualize embarkment, passenger class, & median fare> ggplot(embark_fare, aes(x = Embarked, y = Fare, fill = factor(Pclass) + ge

12、om_boxplot() + geom_hline(aes(yintercept=80), + colour='red', linetype='dashed', lwd=2) + scale_y_continuous(labels=dollar_format() + theme_few()可以看到出發(fā)的一級乘客的中位票價與我們的登機(jī)手續(xù)費(fèi)乘客支付的80美元相當(dāng)。我們接近在這里和那里確定了幾個缺失值的位置。 1044行上的乘客的票價是缺失值。> # Since their fare was $80 for 1st class, they most likel

13、y embarked from 'C'> full$Embarkedc(62, 830) <- 'C'> # Show row 1044> full1044, 這是從南安普敦（'S'）出發(fā)的三級乘客。 讓所有其他人分享他們的班級和登機(jī)牌（n = 494）可視化票價。> ggplot(fullfull$Pclass = '3' & full$Embarked = 'S', , + aes(x = Fare) + geom_density(fill = '#99d6ff&#

14、39;, 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()從這個可視化的角度來看，將NA票價值替換為上課時間為8.05美元的中位數(shù)似乎是相當(dāng)合理的。> # Replace missing fare value with median fare for class/embarkment&

15、gt; full$Fare1044 <- median(fullfull$Pclass = '3' & full$Embarked = 'S', $Fare, na.rm = TRUE)插補(bǔ)我們可以使用rpart（遞歸分區(qū)回歸）來預(yù)測缺少的年齡，但是我將使用MICE來完成這個任務(wù)，只是為了不同的東西。 您可以在這里閱讀更多關(guān)于使用鏈接方程的多重插補(bǔ)（PDF）。 由于我們還沒有完成，我將首先對因子變量進(jìn)行因子分解，然后使用mice插補(bǔ)。> # Show number of missing Age values> sum(is.na(ful

16、l$Age)> # Make variables factors into factors> factor_vars <- c('PassengerId','Pclass','Sex','Embarked',+ 'Title','Surname','Family','FsizeD')> > fullfactor_vars <- lapply(fullfactor_vars, function(x) as.factor(x)>

17、> # Set a random seed> set.seed(129)> > # Perform mice imputation, excluding certain less-than-useful variables:> mice_mod <- mice(full, !names(full) %in% c('PassengerId','Name','Ticket','Cabin','Family','Surname','Survived'),

18、 method='rf') > # Save the complete output > mice_output <- complete(mice_mod)為保證結(jié)果沒有失真，我們將比較我們得到的結(jié)果與原始的乘客年齡分布。> # Plot age distributions> par(mfrow=c(1,2)> hist(full$Age, freq=F, main='Age: Original Data', + col='darkgreen', ylim=c(0,0.04)> hist(mice_out

19、put$Age, freq=F, main='Age: MICE Output', + col='lightgreen', ylim=c(0,0.04)> # Show new number of missing Age values> sum(is.na(full$Age)第二次特征工程現(xiàn)在我們知道每個人的年齡，我們可以創(chuàng)造幾個新的年齡變量：兒童和母親。 一個孩子只會是18歲以下的人，母親是1）女性2）18歲以上3）有超過0個孩子4）沒有頭銜 'Miss'> # First we'll look at the rela

20、tionship between age & survival> ggplot(full1:891, aes(Age, fill = factor(Survived) + + geom_histogram() + + # I include Sex since we know (a priori) it's a significant predictor+ facet_grid(.Sex) + + theme_few()> # Create the column child, and indicate whether child or adult> full$

21、Childfull$Age < 18 <- 'Child'> full$Childfull$Age >= 18 <- 'Adult'> > # Show counts> table(full$Child, full$Survived)> # Adding Mother variable> full$Mother <- 'Not Mother'> full$Motherfull$Sex = 'female' & full$Parch > 0 &am

22、p; full$Age > 18 & full$Title != 'Miss' <- 'Mother'> > # Show counts> table(full$Mother, full$Survived)> # Finish by factorizing our two new factor variables> full$Child <- factor(full$Child)> full$Mother <- factor(full$Mother)> md.pattern(full)預(yù)測

23、最后，我們準(zhǔn)備根據(jù)我們精心策劃和處理缺失值的變量，預(yù)測在泰坦尼克號的乘客中誰能幸存下來。 為此，我們將依靠隨機(jī)森林分類算法; 畢竟，我們花了所有的時間來進(jìn)行數(shù)據(jù)處理。拆分測試與訓(xùn)練> # Split the data back into a train set and a test set> train <- full1:891,> test <- full892:1309,建模> # Set a random seed> set.seed(754)> > # Build the model (note: not all possible

24、variables are used)> rf_model <- randomForest(factor(Survived) Pclass + Sex + Age + SibSp + Parch + + Fare + Embarked + Title + + FsizeD + Child + Mother,+ data = train)> # Show model error> plot(rf_model, ylim=c(0,0.36)> legend('topright', colnames(rf_model$err.rate), col=1:3, fill=1:3)黑線顯示總體錯誤率低于20。 紅線和綠線分別顯示“死亡”和“幸存”的錯誤率。 我們可以看到，現(xiàn)在我們比預(yù)測死亡更成功，而不是生存。變量重要性> # Get importanc