タイタニック号の乗客の生存予測～Kaggleに挑戦（その２）

前回の投稿から1週間。

Kaggleのチュートリアルコンペであるタイタニック号の乗客の生存予測にリベンジしました。

※前回の投稿はこちら

http://yolo-kiyoshi.com/2017/11/15/post-499/

だんだん冬が近づいてきましたね。そろそろシャツ1枚で外出するのは、世間体的に宜しくないシーズンとなってまいりました。さて、今回はKaggleという統計学を学んだ者にとっては胸が熱くなるようなサービスがあったので、統計解析手法の復習もかねてチャレンジしてみようと思います！（まずはKaggleにアプライすることをゴールにしています、、、）お題はタイタニック号の乗客の生存予測です。タイタニック号の沈没事故は皆さん映画で良くご存知だと思いますので、説明は省略します。当時の乗客のデータを使って、どんな乗客なら生存し...

前回は、学習用データ、テストデータの変数であるAge（年齢）の欠損値を、単純に学習用データの中央値で補完しました。

今回は、乗客のName（名前）の敬称とAge（年齢）との関係性に着目して、Age（年齢）の欠損値をより正確に補完して予測しました。

2018年12月追記：以下に最新のKaggle titanic tutorialへの取り組みをあげています。

キヨシの命題

タイタニック号の乗客の生存予測〜80%以上の予測精度を超える方法（探索的データ解...

https://yolo-kiyoshi.com/2018/12/16/post-951

今さらですが、ついにKaggleのタイタニックチュートリアル(titanic tutorial)でAccuracy80%を達成できました。※過去に3つほどtitanic tutorialについての記事を書いています。titanic tutorialって何？っていう方は以下に詳しくまとめていますのでご参照ください。どうやってAccuracy80%を超えられたのかを、「探索的データ解析編」と「モデル構築＆推論編」に分けて備忘録的にまとめます。（なので、今回は「探索編」をまとめます。）モデル構築＆推論編はこちらです。まず、予測モデルの構築に必要な特徴量を見極めるために、改めて...

Name（名前）とAge（年齢）の関係

学習用データのName（名前）を眺めていると、Mr、Missなどの敬称でグルーピングできることに気が付きます。

input:

# 学習用データの読み込み
titanic_original <- read.csv("train.csv", stringsAsFactors=F, na.strings=(c("NA", "")))
# 先頭から数行を確認
head(titanic_original$Name)

output:

[1] "Braund, Mr. Owen Harris"                            
[2] "Cumings, Mrs. John Bradley (Florence Briggs Thayer)"
[3] "Heikkinen, Miss. Laina"                             
[4] "Futrelle, Mrs. Jacques Heath (Lily May Peel)"       
[5] "Allen, Mr. William Henry"                           
[6] "Moran, Mr. James"

出力結果を見ると、Name（名前）は以下のルールで表記されることがわかります。

・「first name（名前）, honorific（敬称）. family mame（苗字）」

ここで、honorific（敬称）にはそれぞれに意味があるようです。

以下、wikipediaより。

Master: for boys or young men and as a title for the heir apparent of a Scottish baron or viscount. It may also be used as a professional title, e.g. for the master of a college or the master of a merchant ship.
Mr: for men, regardless of marital status, who do not have another professional or academic title. The variant Mister, with the same pronunciation, is sometimes used to give jocular or offensive emphasis, or to address a man whose name is unknown.
"Mr" is used with the name of some offices to address a man who is the office-holder, e.g. "Mr President"; "Mr Speaker", see "Madam" below for the equivalent usage for women.
Miss: for girls, unmarried women and (in the UK) married women who continue to use their maiden name (although "Ms" is often preferred for the last two). In the UK, it is used in schools to address female teachers, regardless of marital status. It is also used, without a name, to address girls or young women and (in the UK) to address female shop assistants and wait staff.
Mrs: for married women who do not have another professional or academic title. The variant Missus is used in the UK to address a woman whose name is unknown.

実際に学習データの年齢について、敬称別に集計してみます。
input:

# 学習用データからAge（年齢）とName（名前）の2列を抽出
titanic_age_name <- cbind(as.matrix(titanic_original$Age),as.matrix(titanic_original$Name))
# Age（年齢）が欠損しているレコードを削除
titanic_na_omit_age_name <- na.omit(titanic_age_name)
# Nameから敬称を抽出
# 文字列配列の宣言
name_mid <- character(length(titanic_na_omit_age_name[,2]))
name_honorific <- character(length(titanic_na_omit_age_name[,2]))

for(i in 1:length(titanic_na_omit_age_name[,2])){
    # ","で文字列分割
    name_mid[i] <- strsplit(titanic_na_omit_age_name[,2],", ")[[i]][2]
    # "."で文字列分割
    name_honorific[i] <- strsplit(name_mid[i],"\\.")[[1]][1]
}
# 年齢ベクトルと敬称ベクトルを結合
name_honorific_age <- cbind(as.matrix(name_honorific),as.matrix(titanic_na_omit_age_name[,1]))
# データフレーム化
name_honorific_age <- data.frame(name_honorific_age)
# Age（年齢）を数値化
name_honorific_age[,2] <- as.numeric(as.character(name_honorific_age[,2]))
# 敬称ごとに年齢の平均算出
aggregate(x=list(value=name_honorific_age[,2]),by=list(keycol=name_honorific_age[,1]),FUN=mean)

output:

         keycol     value
1          Capt 70.000000
2           Col 58.000000
3           Don 40.000000
4            Dr 42.000000
5      Jonkheer 38.000000
6          Lady 48.000000
7         Major 48.500000
8        Master  4.574167
9          Miss 21.773973
10         Mlle 24.000000
11          Mme 24.000000
12           Mr 32.368090
13          Mrs 35.898148
14           Ms 28.000000
15          Rev 43.166667
16          Sir 49.000000
17 the Countess 33.000000

敬称ごとに年齢の平均値に偏りがあることがわかります。

上の結果を見ると、Age（年齢）の欠損値を学習データのMedian（中央値）28で一律に補完するというのはだいぶ強引でしたね。

Age（年齢）の欠損値補完

それでは、学習データのAge（年齢）の欠損値を補完します。

以下のコードは、Age(年齢)が欠損値になっているデータに対しては、Name（名前）の敬称に着目し、その敬称の平均値で補完してあげるものです。

input:

# 学習用データ加工
name_honorific <- character(length(titanic_original$Name))

for(i in 1:length(titanic_original$Name)){
    # ","で文字列分割
    name_honorific[i] <- strsplit(strsplit(titanic_original$Name,", ")[[i]][2],"\\.")[[1]][1]
}

# 学習用データのNameを敬称で上書き
titanic_original$Name <- name_honorific

# 学習用データのAgeの欠損値を補完
titanic_original$Age <- ifelse(is.na(titanic_original$Age)
                           ,ifelse(titanic_original$Name == "Capt",70,
                            ifelse(titanic_original$Name == "Col",58,
                            ifelse(titanic_original$Name == "Don",40,
                            ifelse(titanic_original$Name == "Dr",42,
                            ifelse(titanic_original$Name == "Jonkheer",38,
                            ifelse(titanic_original$Name == "Lady",48,
                            ifelse(titanic_original$Name == "Major",48.5,
                            ifelse(titanic_original$Name == "Master",4.574166667,
                            ifelse(titanic_original$Name == "Miss",21.7739726,
                            ifelse(titanic_original$Name == "Mlle",24,
                            ifelse(titanic_original$Name == "Mme",24,
                            ifelse(titanic_original$Name == "Mr",32.36809045,
                            ifelse(titanic_original$Name == "Mrs",35.89814815,
                            ifelse(titanic_original$Name == "Ms",28,
                            ifelse(titanic_original$Name == "Rev",43.16666667,
                            ifelse(titanic_original$Name == "Sir",49,33))))))))))))))))
                           ,titanic_original$Age)

次に、前回の投稿でも行ったデータの加工を行います。
input:

# PassengerID、Ticket、Cabinの除外
titanic_omit_vari <- titanic_original[,c(2,3,5:8,10,12)]
# NAを除外
titanic_na_omit <- na.omit(titanic_omit_vari)
# Sex（性別）の置き換え
# female:0,male:1
titanic_na_omit[,3] <- ifelse(titanic_na_omit[,3]=="female",0,1)
# Embarked（乗船した港）の置き換え
# C:0,Q:1,S:2
titanic_na_omit[,8] <- ifelse(titanic_na_omit[,8]=="C",0,ifelse(titanic_na_omit[,8]=="Q",1,2))

予測モデル構築とテストデータへのあてはめ

加工データを使って、予測モデルを構築します。

今回もロジスティック回帰で頑張ります笑

テストデータに対してもAge（年齢）の欠損値補完を行ったうえで、予測モデルをあてはめます。

input:

># データをattach
attach(titanic_na_omit)
# ロジスティック回帰モデル作成
glm_result <- glm(Survived~Pclass+Sex+Age+SibSp, family="binomial", data=titanic_na_omit)
# テストデータの読み込み
titanic_test <- read.csv("test.csv", stringsAsFactors=F, na.strings=(c("NA", "")))

name_honorific <- character(length(titanic_test$Name))

for(i in 1:length(titanic_test$Name)){
    # ","で文字列分割
    name_honorific[i] <- strsplit(strsplit(titanic_test$Name,", ")[[i]][2],"\\.")[[1]][1]
}

# テストデータのNameを敬称で上書き
titanic_test$Name <- name_honorific

# テストデータのAgeの欠損値を補完
titanic_test$Age <- ifelse(is.na(titanic_test$Age)
                           ,ifelse(titanic_test$Name == "Capt",70,
                            ifelse(titanic_test$Name == "Col",58,
                            ifelse(titanic_test$Name == "Don",40,
                            ifelse(titanic_test$Name == "Dr",42,
                            ifelse(titanic_test$Name == "Jonkheer",38,
                            ifelse(titanic_test$Name == "Lady",48,
                            ifelse(titanic_test$Name == "Major",48.5,
                            ifelse(titanic_test$Name == "Master",4.574166667,
                            ifelse(titanic_test$Name == "Miss",21.7739726,
                            ifelse(titanic_test$Name == "Mlle",24,
                            ifelse(titanic_test$Name == "Mme",24,
                            ifelse(titanic_test$Name == "Mr",32.36809045,
                            ifelse(titanic_test$Name == "Mrs",35.89814815,
                            ifelse(titanic_test$Name == "Ms",28,
                            ifelse(titanic_test$Name == "Rev",43.16666667,
                            ifelse(titanic_test$Name == "Sir",49,33))))))))))))))))
                           ,titanic_test$Age)

titanic_test$Sex <- ifelse(titanic_test$Sex=="female",0,1)
# 予測モデルをテストデータにあてはめ
# 生存確率0.5以上なら生存:1、それ以外は死亡:0
test_result <- ifelse(predict(glm_result,newdata=titanic_test,type="response")>=0.5,1,0)
# PassengerId（乗客ID）を予測結果に列結合
output <- cbind(titanic_test$PassengerId,test_result)

Kaggeleへ投稿

Kaggleへのリベンジ。その結果は

正答率は75.598%で、9,207人中7,801位でした。
前回よりも正答率は1.436%上昇、508位ランクアップ。
う～んこの。

Name（名前）とAge（年齢）の関係

Age（年齢）の欠損値補完

予測モデル構築とテストデータへのあてはめ

Kaggeleへ投稿

同じカテゴリの記事