Help us understand the problem. What is going on with this article?

kaggleのkernels学習ノート~Exploring Survival on the Titanic~

More than 1 year has passed since last update.

kaggleのkernels学習ノート~Exploring Survival on the Titanic~

題名の通りkaggleのkernelsを和訳したものです。自分の勉強の備忘録をまとめていきます。そして、データ分析に携わる誰かのお役に立てれば幸いです。和訳とか得意じゃないので間違っていたらごめんなさい。
今回はMegan L. RisdalさんのExploring Survival on the Titanicを和訳していきます。

1 イントロダクション

これはKaggleの最初のスクリプトです。タイタニックのデータセットで作業することにしました。時間をかけてサイトを見て、他のKagglersが作成したインスピレーション溢れるスクリプトを見ました。私は途中で分析に役立つデータの視覚化を行うことに焦点を当てています。次に、ランダムフォレストを使用して、タイタニック号の乗船客の生存を予測するモデルを作成します。私にとってマシンラーニングは新しい取り組みで、多くを学ぶことを望んでいます。なので、フィードバックは大歓迎です!
スクリプトには次の3つの部分があります:

  • 特徴量加工
  • 欠損値の補完
  • 予測!

1.1 データのロードとチェック

R
# Load packages
library('ggplot2') # visualization
library('ggthemes') # visualization
library('scales') # visualization
library('dplyr') # data manipulation
library('mice') # imputation
library('randomForest') # classification algorithm

パッケージがロードされたので、データを読み込んで行きましょう。

R
train <- read.csv('../input/train.csv', stringsAsFactors = F)
test  <- read.csv('../input/test.csv', stringsAsFactors = F)

full  <- bind_rows(train, test) # bind training & test data

# check data
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" ...

変数、そのクラスの型、最初のいくつかのデータの雰囲気を掴みます。1309行×12列のデータセットです。いくつかの変数名が省略されているので、明らかにするために、ここでは対処しておきます。

Variable Name Description
Survived Survived (1) or died (0)
Pclass Passenger’s class
Name Passenger’s name
Sex Passenger’s sex
Age Passenger’s age
SibSp Number of siblings/spouses aboard
Parch Number of parents/children aboard
Ticket Ticket number
Fare Fare
Cabin Cabin
Embarked Port of embarkation

2 特徴量加工

2.1 名前って何?

私が最初に興味を持ったのは乗客の名前に関する変数です。なぜなら、意味のある別の変数に分解でき、予測で使ったり、追加の新しい変数を作成するのに使うことができるからです。たとえば、旅客名は旅客名変数に含まれており、姓を使用して家族を表すことができます。特徴量加工を行いましょう。

R
# Grab title from passenger names
full$Title <- gsub('(.*, )|(\\..*)', '', full$Name)

# Show title counts by sex
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

# Titles with very low cell counts to be combined to "rare" level
rare_title <- c('Dona', 'Lady', 'the Countess','Capt', 'Col', 'Don', 
                'Dr', 'Major', 'Rev', 'Sir', 'Jonkheer')

# Also reassign mlle, ms, and mme accordingly
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'

# Show title counts by sex again
table(full$Sex, full$Title)
##         
##          Master Miss  Mr Mrs Rare Title
##   female      0  264   0 198          4
##   male       61    0 757   0         25
# Finally, grab surname from passenger name
full$Surname <- sapply(full$Name,  
                      function(x) strsplit(x, split = '[,.]')[[1]][1])
上記の処理の具体例
full[,c("Name", "Title")]
# A tibble: 891 x 2
   Name                                                Title 
   <chr>                                               <chr> 
 1 Braund, Mr. Owen Harris                             Mr    
 2 Cumings, Mrs. John Bradley (Florence Briggs Thayer) Mrs   
 3 Heikkinen, Miss. Laina                              Miss  
 4 Futrelle, Mrs. Jacques Heath (Lily May Peel)        Mrs   
 5 Allen, Mr. William Henry                            Mr    
 6 Moran, Mr. James                                    Mr    
 7 McCarthy, Mr. Timothy J                             Mr    
 8 Palsson, Master. Gosta Leonard                      Master
 9 Johnson, Mrs. Oscar W (Elisabeth Vilhelmina Berg)   Mrs   
10 Nasser, Mrs. Nicholas (Adele Achem)                 Mrs 

full[,c("Name", "Surname")]
# A tibble: 891 x 2
   Name                                                Surname  
   <chr>                                               <chr>    
 1 Braund, Mr. Owen Harris                             Braund   
 2 Cumings, Mrs. John Bradley (Florence Briggs Thayer) Cumings  
 3 Heikkinen, Miss. Laina                              Heikkinen
 4 Futrelle, Mrs. Jacques Heath (Lily May Peel)        Futrelle 
 5 Allen, Mr. William Henry                            Allen    
 6 Moran, Mr. James                                    Moran    
 7 McCarthy, Mr. Timothy J                             McCarthy 
 8 Palsson, Master. Gosta Leonard                      Palsson  
 9 Johnson, Mrs. Oscar W (Elisabeth Vilhelmina Berg)   Johnson  
10 Nasser, Mrs. Nicholas (Adele Achem)                 Nasser   

875のユニークな姓を持っています。姓を使って、民族性を推測することに興味がありますが、それはまた別の機会に。

2.2 家族は一緒に沈むの?泳ぐの?

乗客名をいくつかの新しい変数に分割したので、これをさらに進めて新しい家族変数を作成します。最初に、兄弟/配偶者の数(複数の配偶者がいるかもしれません)と子供/親の数に基づいて家族サイズの変数を作成します。

R
# Create a family size variable including the passenger themselves
full$Fsize <- full$SibSp + full$Parch + 1

# Create a family variable 
full$Family <- paste(full$Surname, full$Fsize, sep='_')

家族サイズの変数はどうでしょうか?生存にどのように関係するかを理解するためにプロットしましょう。

R
# Use ggplot2 to visualize the relationship between family size & survival
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') +
  theme_few()

unnamed-chunk-6-1.png
独身や4よい小さい家族サイズには生存するのが難しいようです。この変数を3つのレベルに離散化できます。これは、大きな家族サイズが比較的少ないので役立ちます。離散化された家族サイズ変数を作成しましょう。

R
# Discretize family size
full$FsizeD[full$Fsize == 1] <- 'singleton'
full$FsizeD[full$Fsize < 5 & full$Fsize > 1] <- 'small'
full$FsizeD[full$Fsize > 4] <- 'large'

# Show family size by survival using a mosaic plot
mosaicplot(table(full$FsizeD, full$Survived), main='Family Size by Survival', shade=TRUE)

unnamed-chunk-7-1.png
モザイクプロットは、独身や大家族が生存するのが難しいことを示していますが、小家族のお客はその逆を示しています。年齢変数を使ってさらに何かしたいのですが、263行には年齢の値がありません。そのため、欠損値の補完を行うまで、待たなければなりません。

2.3 いくつかの値を対処する…

何か残っていますか?おそらく、甲板も含め、客室内の変数が潜在的に有用な情報がありそうです。見てみましょう。

R
# This variable appears to have a lot of missing values
full$Cabin[1:28]
##  [1] ""            "C85"         ""            "C123"        ""           
##  [6] ""            "E46"         ""            ""            ""           
## [11] "G6"          "C103"        ""            ""            ""           
## [16] ""            ""            ""            ""            ""           
## [21] ""            "D56"         ""            "A6"          ""           
## [26] ""            ""            "C23 C25 C27"
# The first character is the deck. For example:
strsplit(full$Cabin[2], NULL)[[1]]
## [1] "C" "8" "5"
# Create a Deck variable. Get passenger deck A - F:
full$Deck<-factor(sapply(full$Cabin, function(x) strsplit(x, NULL)[[1]][1]))

複数の部屋があるキャビン(例:行28:「C23 C25 C27」)を調べるなど、もっと多くのことが考えられますが、ここでは列のスパースさを考えると、ここでやめておきます。

3 欠損値

不足しているデータを調査し、補完によって修正する準備が整いました。これをやる方法はいくつかあります。データセットのサイズが小さい場合は、観測値(行)全体または欠損値を含む変数(列)を削除しないほうがいいです。欠損値を、データの分布(例えば、平均値、中央値またはモード)を考慮して合理的な値に置き換えるという選択肢があります。最後に、予測することもできます。後者の2つを使用し、データを視覚化してから決定します。

3.1 Sensible value imputation(感覚的に補完?)

R
# Passengers 62 and 830 are missing Embarkment
full[c(62, 830), 'Embarked']
## [1] "" ""

乗客のクラスと運賃が関係していると思われるので、現在のデータから、乗船の価値を推測します。彼らはそれぞれ$80と$NAを支払っており、そのクラスは1とNAです。彼らはどこから乗船したのでしょう?

R
# Get rid of our missing passenger IDs
embark_fare <- full %>%
  filter(PassengerId != 62 & PassengerId != 830)

# Use ggplot2 to visualize embarkment, passenger class, & median fare
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()

unnamed-chunk-11-1.png
シャルブール('C')から出発するファーストクラスの乗客の運賃の中央値と、欠損している乗客が支払った$80がうまく一致します。NAの値を'C'で置き換えることができると思います。

R
# Since their fare was $80 for 1st class, they most likely embarked from 'C'
full$Embarked[c(62, 830)] <- 'C'

少数のNAを修正できてきました。1044行目の乗客は、運賃がNAです。

R
# Show row 1044
full[1044, ]
##    PassengerId   Survived  Pclass                 Name   Sex   Age SibSp Parch
## 1044        1044         NA       3   Storey, Mr. Thomas  male  60.5     0     0
##      Ticket Fare Cabin Embarked Title Surname  Fsize   Family    FsizeD
## 1044   3701   NA              S    Mr  Storey      1 Storey_1 singleton
##      Deck
## 1044 <NA>

これはサザンプトン('S')から出発した第3クラス(級?)の乗客です。クラスと乗船のすべてのクラスの運賃を視覚化しましょう(n = 494)。

R
ggplot(full[full$Pclass == '3' & full$Embarked == 'S', ], 
  aes(x = Fare)) +
  geom_density(fill = '#99d6ff', 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()

unnamed-chunk-14-1.png
この視覚化から判断するに、NAであるFareの値をクラスと乗車の中央値で置き換えることはかなり妥当なように思います($8.05)。

R
# Replace missing fare value with median fare for class/embarkment
full$Fare[1044] <- median(full[full$Pclass == '3' & full$Embarked == 'S', ]$Fare, na.rm = TRUE)

3.2 予測値で補完

最後に、Ageの値が欠落しています。欠損している年齢の値をファンシーかもしれませんが対処していきましょう。他の変数に基づいて年齢を予測するモデルを作成すれば対処できます。

R
# Show number of missing Age values
sum(is.na(full$Age))
## [1] 263

欠損した年齢を予測するために{rpart}(回帰のための再帰的分割)を使うことは間違いありませんが、私はこの処理のために{mice}パッケージを別のものに使うつもりです。私たちはまだそれをしていないので、まずファクタ変数にしてから{mice}で補完していきます。

R
# Make variables factors into factors
factor_vars <- c('PassengerId','Pclass','Sex','Embarked',
                 'Title','Surname','Family','FsizeD')

full[factor_vars] <- lapply(full[factor_vars], function(x) as.factor(x))

# 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')], method='rf') 

## 
##  iter imp variable
##   1   1  Age  Deck
##   1   2  Age  Deck
##   1   3  Age  Deck
##   1   4  Age  Deck
##   1   5  Age  Deck
##   2   1  Age  Deck
##   2   2  Age  Deck
##   2   3  Age  Deck
##   2   4  Age  Deck
##   2   5  Age  Deck
##   3   1  Age  Deck
##   3   2  Age  Deck
##   3   3  Age  Deck
##   3   4  Age  Deck
##   3   5  Age  Deck
##   4   1  Age  Deck
##   4   2  Age  Deck
##   4   3  Age  Deck
##   4   4  Age  Deck
##   4   5  Age  Deck
##   5   1  Age  Deck
##   5   2  Age  Deck
##   5   3  Age  Deck
##   5   4  Age  Deck
##   5   5  Age  Deck

# Save the complete output 
mice_output <- complete(mice_mod)

結果と乗客の年齢分布を比較し、何も間違っていないことを確認しましょう。

R
# 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_output$Age, freq=F, main='Age: MICE Output', 
  col='lightgreen', ylim=c(0,0.04))

unnamed-chunk-18-1.png
良さそうなので、元のデータの年齢ベクトルを{mice}の出力に置き換えてみましょう。

R
# Replace Age variable from the mice model.
full$Age <- mice_output$Age

# Show new number of missing Age values
sum(is.na(full$Age))
## [1] 0

気にしていたすべての変数の値を代入し終えました!欠損のないAge変数がありますが、いくつかの仕上げを行いましょう。年齢を使ってちょっとだけ特徴量加工してみます。

3.3 特徴量加工:ラウンド2

すべての年齢を知っているので、新しい年齢に依存する2つの変数(子供と母親)を作成できます。Childは18歳未満の人で、母親は1)female、2)18歳以上はAdult、3)子供が0人以上(冗談なし)、4)タイトルがないものは'Miss'。

R
# First we'll look at the relationship between age & survival
ggplot(full[1: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()

unnamed-chunk-20-1.png

R
# Create the column child, and indicate whether child or adult
full$Child[full$Age < 18] <- 'Child'
full$Child[full$Age >= 18] <- 'Adult'

# Show counts
table(full$Child, full$Survived)
##        
##           0   1
##   Adult 484 274
##   Child  65  68

# Finish by factorizing our two new factor variables
full$Child  <- factor(full$Child)
full$Mother <- factor(full$Mother)

私たちが気にかけている変数はすべて処理しなければなりませんが、欠落したデータももうないはずです。 確かめましょう。

R
md.pattern(full)
## Warning in data.matrix(x): NAs introduced by coercion

## Warning in data.matrix(x): NAs introduced by coercion

## Warning in data.matrix(x): NAs introduced by coercion
##     PassengerId Pclass Sex Age SibSp Parch Fare Embarked Title Surname
## 150           1      1   1   1     1     1    1        1     1       1
##  61           1      1   1   1     1     1    1        1     1       1
##  54           1      1   1   1     1     1    1        1     1       1
## 511           1      1   1   1     1     1    1        1     1       1
##  30           1      1   1   1     1     1    1        1     1       1
## 235           1      1   1   1     1     1    1        1     1       1
## 176           1      1   1   1     1     1    1        1     1       1
##  92           1      1   1   1     1     1    1        1     1       1
##               0      0   0   0     0     0    0        0     0       0
##     Fsize Family FsizeD Child Mother Ticket Survived Deck Name Cabin     
## 150     1      1      1     1      1      1        1    1    0     0    2
##  61     1      1      1     1      1      1        0    1    0     0    3
##  54     1      1      1     1      1      0        1    1    0     0    3
## 511     1      1      1     1      1      1        1    0    0     0    3
##  30     1      1      1     1      1      0        0    1    0     0    4
## 235     1      1      1     1      1      1        0    0    0     0    4
## 176     1      1      1     1      1      0        1    0    0     0    4
##  92     1      1      1     1      1      0        0    0    0     0    5
##         0      0      0     0      0    352      418 1014 1309  1309 4402

これで最終的に、タイタニックのデータセットのすべての欠損値を対処し終えました。ここまでで、生存を予測するモデルを構築するのに、役立ついくつかの新しい変数を作成しました。

4. 予測

タイタニック号の乗客の中で、欠損値を補完した変数や特徴量加工した変数に基づいて、誰が生き残るかを予測します。このために、randomForestアルゴリズムを使用します。結局のところ、多くの時間を欠損値の補完という前処理に費やしました。

4.1 テストデータと訓練データに分割

予測の最初のステップはテストデータと訓練データにデータを分割することです。

R
# Split the data back into a train set and a test set
train <- full[1:891,]
test <- full[892:1309,]

4.2 モデルの構築

訓練データでランダムフォレストを実行します。

R
# Set a random seed
set.seed(754)

# Build the model (note: not all possible 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)

unnamed-chunk-24-1.png
黒い線は全体のエラー率が20%を下回ることを示しています。赤線と緑線はそれぞれ「死亡」と「生存」のエラー率を示しています。プロットを見る限り、生存よりも脂肪のほうが上手く予測できていることがわかります。

4.3 変数重要度

すべてのツリーにわたって計算されたGiniの平均減少量をプロットすることによって、相対的な変数重要度を見てみましょう。

R
# Get importance
importance    <- importance(rf_model)
varImportance <- data.frame(Variables = row.names(importance), 
                            Importance = round(importance[ ,'MeanDecreaseGini'],2))

# Create a rank variable based on importance
rankImportance <- varImportance %>%
  mutate(Rank = paste0('#',dense_rank(desc(Importance))))

# Use ggplot2 to visualize the relative importance of variables
ggplot(rankImportance, aes(x = reorder(Variables, Importance), 
    y = Importance, fill = Importance)) +
  geom_bar(stat='identity') + 
  geom_text(aes(x = Variables, y = 0.5, label = Rank),
    hjust=0, vjust=0.55, size = 4, colour = 'red') +
  labs(x = 'Variables') +
  coord_flip() + 
  theme_few()

unnamed-chunk-25-1.png
Titleが、すべての予測変数の中で最も重要です。私はPclassが#5なのが驚きですが、それは子供ころに何度もタイタニック号を見ていることによるバイアスに過ぎないかもしれません。

4.4 予測

最後のステップに向けて準備をしていきましょう。このステップでは、さまざまなモデルを使用してパラメタ調整したり、さまざまな変数の組み合わせを使用して予測を改善したりしますが、これは今の私にとって良いスタート(そして停止)のポイントです。

R
# Predict using the test set
prediction <- predict(rf_model, test)

# Save the solution to a dataframe with two columns: PassengerId and Survived (prediction)
solution <- data.frame(PassengerID = test$PassengerId, Survived = prediction)

# Write the solution to file
write.csv(solution, file = 'rf_mod_Solution.csv', row.names = F)

5 結論

はじめてのKaggleデータセットの分析を読んでいただきありがとうございます。私はより多くのことをできることを楽しみにしています。コメントや提案を歓迎します!

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away