泰坦尼克號生存預測排名4%（R語言）
泰坦尼克號生存率資料集作為一個被徹底研究的物件，是每一個數據分析初學者都必須練習的一項重要內容。廢話不多說了，咱們一項一項開始吧。
理解資料
匯入資料集：
> train<-read。csv（“D：/train。csv”，stringsAsFactors=F）
> test<-read。csv（“D：/test。csv”，stringsAsFactors = F）
可以看到train有891條觀測，test有418條觀測
為避免重複處理資料，故合併兩個資料集一起處理：
> library（dplyr）
> full<-bind_rows（train，test）
檢視資料結構：
> str（full）
‘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” 。。。
字比較多，但是不要害怕，我們看前兩列就好：-）
PassengerId 整型變數，標識乘客的ID，遞增變數，對預測無幫助
Survived 整型變數，標識該乘客是否倖存。0表示遇難，1表示倖存。將其轉換為factor變數比較方便處理
Pclass 整型變數，標識乘客的社會階層，1代表Upper，2代表Middle，3代表Lower
Name 字元型變數，除包含姓和名以外，還包含Mr。 Mrs。 Dr。這樣的具有西方文化特點的資訊
Sex 字元型變數，標識乘客性別，適合轉換為factor型別變數
Age 整型變數，標識乘客年齡，有缺失值
SibSp 整型變數，代表兄弟姐妹及配偶的個數。其中Sib代表Sibling也即兄弟姐妹，Sp代表Spouse也即配偶
Parch 整型變數，代表父母或子女的個數。其中Par代表Parent也即父母，Ch代表Child也即子女
Ticket 字元型變數，代表乘客的船票號
Fare 數值型，代表乘客的船票價
Cabin 字元型，代表乘客所在的艙位，有缺失值
Embarked 字元型，代表乘客登船口岸，在預測中必須轉換為factor型變數。
檢視缺失值：
> sapply（full，function（X） sum（is。na（X））） #檢視缺失值#
PassengerId Survived Pclass Name Sex Age SibSp
0 418 0 0 0 263 0
Parch Ticket Fare Cabin Embarked
0 0 1 0 0
> sapply（full，function（X） sum（X==“”）） #檢視空值#
PassengerId Survived Pclass Name Sex Age SibSp
0 NA 0 0 0 NA 0
Parch Ticket Fare Cabin Embarked
0 0 NA 1014 2
這裡涉及到sapply的用法：lapply（）和sapply（）把第一個列表或向量作為其第一個引數，再把需要應用到每個列表元素的函式作為它的第二個引數。其實它也應用到了迴圈，是一種隱式的迴圈，對列表的每一個元素做同樣的函式計算。
特徵工程
探討階層(Pclass)與生存率的關係：
> full$Survived<-as。factor（full$Survived） #先轉換成因子#
> full$Pclass<-as。factor（full$Pclass）
繪圖，從圖中得到我們想要得資訊：
> ggplot（full［（1：891），］，aes（x=Pclass，y=。。count。。，fill=Survived））+
+ geom_bar（position =“dodge”）+geom_text（stat=“count”，aes（label=。。count。。），vjust=-0。2，colour=“black”，position=position_dodge（。9），size=5）+labs（title=“社會階層（pclass）對生存率的影響”）
上層生存率136/80，是死亡人數的1。7倍，中層87/97，是死亡人數的0。89倍，下層死亡率飆升119/372，生存的人數只有死亡人數的三分之一。可以看到階層對生存率的影響還是挺大的。
姓名對生存率的影響
鑑於東西方文化的不同，西方國家姓氏中的title可能對生存率的有影響，所以，從姓名中提取title。
> full$title<-strsplit（ful$Name，“，”）%>%sapply（“［”，2）
> full$title<-strsplit（ful$title，“［。］”）%>%sapply（“［”，1）
> table（full$Sex，full$title）
Capt Col Don Dona Dr Jonkheer Lady Major Master Miss Mlle Mme
female 0 0 0 1 1 0 1 0 0 260 2 1
male 1 4 1 0 7 1 0 2 61 0 0 0
Mr Mrs Ms Rev Sir the Countess
female 0 197 2 0 0 1
male 757 0 0 8 1 0 #目的達到了，？#
然後給title分類，title很重要，會直接影響結果。先合併一些稀有得title
rare_title <- c（‘Dona’， ‘Lady’， ‘the Countess’，‘Capt’， ‘Col’， ‘Don’，
+ ‘Dr’， ‘Major’， ‘Rev’， ‘Sir’， ‘Jonkheer’）
> 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”
上圖：
ggplot（full［（1：891），］，aes（x=title，y=。。count。。，fill=Survived））+geom_bar（position =“dodge”）+geom_text（stat=“count”，aes（label=。。count。。），vjust=-0。2，colour=“black”，position=position_dodge（。9），size=3）+labs（title=“頭銜（Title）對生存率的影響”）
從圖中可以看到，Mr，得犧牲率非常高，幾乎是生存率得三倍以上，而Miss，Mrs的命運就好很多啦，生存率遠高於死亡率。
性別（Sex）對生存率的影響
ggplot（full［（1：891），］，aes（x=Sex，y=。。count。。，fill=Survived））+geom_bar（position =“dodge”）+geom_text（stat=“count”，aes（label=。。count。。），vjust=-0。2，colour=“black”，position=position_dodge（。9），size=5）+labs（title=“性別（Sex）對生存率的影響”）
完全符合對title的判斷，“女士優先”在西方社會一直被視為最基本的行為準則，這在泰坦尼克上也充分展現出來：74%的女性活了下來，而只有接近19%的男性有幸存活。
年齡（Age）對生存率的影響
> ggplot（data=full［（！is。na（full$Age）） & row（as。matrix（full［，“Age”］））<=891，］，aes（x=Age，colour=Survived））+geom_line（stat=“bin”，binwidth=5，na。rm=TRUE）+labs（title=“年齡（Age）對生存率的影響”） #Age中有大量缺失值，此圖是剔除缺失值的樣子#
7歲以下孩子生存率遠高於其他年齡段，可見在逃生的過程中年幼的孩子是重點保護物件。
探討兄妹及配偶個數（SibSP）對生存率的影響
full$SibSp<-as。factor（full$SibSp）
ggplot（full［（1：891），］，aes（x=SibSp，y=。。count。。，fill=Survived））+geom_bar（position =“dodge”）+geom_text（stat=“count”，aes（label=。。count。。），vjust=-0。2，colour=“black”，position=position_dodge（。9），size=3） +labs（title=“兄妹及配偶數（SibSp）對生存率的影響”）
父母及子女數（Parch）對生存率的影響
full$Parch<-as。factor（full$Parch）
> ggplot（full［（1：891），］，aes（x=Parch，y=。。count。。，fill=Survived））+geom_bar（position =“dodge”）+geom_text（stat=“count”，aes（label=。。count。。），vjust=-0。2，colour=“black”，position=position_dodge（。9），size=3）+labs（title=“父母及子女數（Parch）對生存率的影響”）
由SibSP 和Parch聯想到家庭規模對生存率的影響，SibSp與Parch都說明，當乘客無親人時，倖存率較低，乘客有少數親人時，倖存率高於50%，而當親人數過高時，倖存率反而降低。在這裡，可以考慮將SibSp與Parch相加，生成新的變數，FamilySize
> full$Parch<-as。numeric（full$Parch） #只有轉換成數值型才能進行加減#
> full$SibSp<-as。numeric（full$SibSp）
> full$familysize<-full$SibSp+full$Parch+1 #+1是為了加上乘客自己#
繪圖：
ggplot（full［（1：891），］，aes（x=familysize，y=。。count。。，fill=Survived））+geom_bar（position =“dodge”）+geom_text（stat=“count”，aes（label=。。count。。），vjust=-0。2，colour=“black”，position=position_dodge（。9），size=3）+labs（title=“家庭規模（familysize）對生存率的影響”）
由圖可見，2-5口人的家庭生存率情況是最好的，過大或者過小的家庭規模存活情況都不好。
船票（Ticket）對生存率的影響
由於船票的重疊率非常低，沒辦法直接拿來進行判斷。但是船票中還是有一部分重複的，我們姑且認為重複的票是大人帶著孩子，或者其他家人。那麼我們將船票有重複的定義為“share“，單獨的定義為”unique“
tick。count<-aggregate（full$Ticket，by=list（full$Ticket），function（x） sum（！is。na（x）））
> full$TicketCount <- apply（full， 1， function（x） tick。count［which（tick。count［， 1］ ==x［”Ticket“］），2］）
> full$TicketCount <- factor（sapply（full$TicketCount， function（x） ifelse（x > 1，‘Share’， ‘Unique’）））
繪圖：
> ggplot（full［（1：891），］，aes（x=TicketCount，y=。。count。。，fill=Survived））+geom_bar（position =”dodge“）+geom_text（stat=”count“，aes（label=。。count。。），vjust=-0。2，colour=”black“，position=position_dodge（。9），size=5）+labs（title=”船票（TicketCount）對生存率的影響“）
票價（Fare）對生存率的影響:
ggplot（full［（1：891），］，aes（x=Fare，colour=Survived））+geom_line（stat=‘bin’，binwidth=5）+labs（title=”票價（Fare）對生存率的影響“）#資料中有一個缺失值，我忽略了#
票價越高，生存率越高。
登船口岸（Embarked）對生存率的影響：
ggplot（full［（1：891），］，aes（x=Embarked，y=。。count。。，fill=Survived））+geom_bar（position=‘dodge’）+geom_text（stat=‘count’，aes（label=。。count。。），vjust=-0。2，colour=‘black’，size=5，position=position_dodge（。9））+labs（title=”登船口岸（Embarked）對生存率的影響“）
C倉生存率：93/168，約為55%，Q倉生存率：30/77，約為39%，S倉生存率：約為34%。可見，C倉的乘客生存率最高。
對於Cabin，缺失值太多了…。。總共1309條資料，缺失了1014條。。。
這樣的值即使插補進去也只能降低總體預測的準確性吧？
那麼，接下來，我們就集中處理一下缺失值：）
3 缺失值處理
Age缺失值263個
首先，用多重插補法（mice）來對缺失值進行填補
> library（mice）
> sum（is。na（full$Age））
［1］ 263
> imp<-mice（full，seed=123）
> output<-complete（imp）
> full$Age<-output$Age
> sum（is。na（full$Age））
［1］ 0
看一下填充前後的效果：
> par（mfrow=c（1，2））
hist（ful$Age，freq=F，col=‘darkblue’，ylim=c（0，0。04））
> hist（output$Age，freq=F，col=‘lightblue’，ylim=c（0，0。04））
Fare中的缺失值只有一個，所以用中位數填充：
sum（is。na（full$Fare））
［1］ 1
> full$Fare［is。na（full$Fare）］<-median（full$Fare，na。rm=T）
> sum（is。na（full$Fare））
［1］ 0
Embarked有兩個空值
是空值，不是NA
> sum（is。na（full$Embarked））
［1］ 0
把空值轉成NA值才能進一步處理：
> full$Embarked［fu$Embarked==”“］<-NA
> sum（is。na（full$Embarked））
［1］ 2
> full［is。na（full$Embarked），c（”PassengerId“，”Pclass“，”Fare“，”Embarked“）］
PassengerId Pclass Fare Embarked
62 62 1 80
830 830 1 80
現在我們知道缺失的Embarked都屬於Pclass=1，並且Fare=80的，那麼畫圖看一下NA的位置：
ggplot（full［（1：891），］，aes（x=Embarked，y=Fare，fill=Pclass））+geom_boxplot（）+geom_hline（yintercept =80，colour=”red“，lwd=1，linetype=”dashed“）
從圖可知缺失值跟c口，Pclass的中位數完全一致，那麼可以推斷缺失值應該為“C“
full$Embarked［is。na（full$Embarked）］<-”C“
4 預測：
分開訓練組和測試組：
train<-full［（1：891），］
> test<-full［（892：1309），］
用隨機森林進行預測：
library（randomForest）
set。seed（754）
> rf_model<-randomForest（Survived~
+Pclass+Sex+Age+Fare+Embarked+title+familysize+TicketCount，data=train）
繪圖顯示模型誤差：
plot（rf_model，ylim=c（0，0。4））
legend（”topright“，colnames（rf_model$err。rate），col=1：3，fill=1：3）
由圖可知，對死亡率預測的誤差在0。1左右，對生存率的預測誤差在0。3左右。相對對死亡的預測更準確一些。總體誤差在0。2左右
檢視因子重要性：
> importance（rf_model）
MeanDecreaseGini
Pclass 32。061347
Sex 53。922945
Age 42。131608
Fare 53。811564
Embarked 9。370506
title 71。149280
familysize 24。353217
TicketCount 6。569171
新增一個排名變數：
rm<-importance（rf_model）
reimp<-data。frame（var=row。names（rm），importance=round（rm［，”MeanDecreaseGini“］，2））
rankimportance<-reimp%>%mutate（rank=（dense_rank（desc（rm））））%>%arrange（rank） #新增排名變數#
> rankimportance
var importance rank
1 title 71。15 1
2 Sex 53。92 2
3 Fare 53。81 3
4 Age 42。13 4
5 Pclass 32。06 5
6 familysize 24。35 6
7 Embarked 9。37 7
8 TicketCount 6。57 8
繪圖：
ggplot（rankimportance，aes（x=reorder（var，importance），y=importance，fill=importance））+geom_bar（stat=”identity“）+geom_text（aes（x = var， y = 0。5， label = rank），hjust=0， vjust=0。55， size = 4， colour = ‘red’）+labs（x=”Variables“）+coord_flip（）
終於來到預測環節了！
> prediction<-predict（rf_model，test）
> solution<-data。frame（PassengerId=test$PassengerId，Survivied=prediction）
儲存預測結果
> write。csv（solution，”D：\\solution。csv“，row。names=F）
這樣的結果對不起被我參考過文章的大牛們
5 調優
之前是用多重插補法填補Age中的空缺值，這次我們用經典決策樹（rpart）
> library（rpart）
> age_model<-rpart（Age~Pclass+Sex+SibSp+Parch+Fare+Embarked+title+familysize+TicketCount，data=full［！is。na（full$Age）， ］， method=‘anova’）
> full$Age［is。na（full$Age）］ <- predict（age_model， full［is。na（full$Age）， ］）
> sum（is。na（full$Age））
［1］ 0 #然而對結果的影響並不明顯#
Embarked中缺失值的情況：
> summary（full$Embarked）
C Q S
272 123 914
可以發現S口登船的乘客人數遠高於其他口，所以將缺失的值改為S
full$Embarked［c（62，830）］ = ”S“ #對結果影響不明顯#
現在改用決策樹（party）來預測： #對結果影響非常明顯！#
library（party）
library（grid）
> library（mvtnorm）
> library（modeltools）
> library（stats4）
> library（strucchange）
> library（zoo）
> library（sandwich） #鬼知道用個party包為什麼還要帶上這麼多玩意兒#
set。seed（754）
建模：
model <- cforest（as。factor（Survived） ~ Pclass+Sex+Age+Fare+Embarked+title+familysize+TicketCount， data = train， controls=cforest_unbiased（ntree=2000， mtry=3））
預測：
predict。result <- predict（model， test， OOB=TRUE， type = ”response“）
> submit <- data。frame（PassengerId = test$PassengerId， Survived = predict。result）
儲存預測結果：
> write。csv（submit，”D：\\submit1。csv“，row。names=F）
直接從16%飆到了4%……
總結：
隨機森林是最近非常火的預測模型，但也不是出處處都好使，還是要視情況進行甄選。作為入門必修的泰坦尼克生存預測，我從中看到了很多大牛們對基本函式爐火純青的使用。不記得視哪位高人說的了，大意是程式碼要越簡潔越好。深以為是。
太高深的東西對小白來說學習起來非常困難，但是能把很平常的函式玩好也絕非易事。
隨機森林還勉強能懂一些，party包就真不懂了，手頭這方面的學習資料非常少，還要慢慢消化，能有4%的戰績全靠對大牛們的模仿，這也說明這麼長時間以來，他們依舊屹立在頂端，只有被模仿而極少被超越。
附文章連結，有興趣的小夥伴可以看看：
https：//www。
kaggle。com/mrisdal/expl
oring-survival-on-the-titanic
機器學習（二） 如何做到Kaggle排名前2%
【R語言進行資料探勘】決策樹和隨機森林 - 推酷