2016年10月16日日曜日

タイタニック号データ分析:Missingness

Feature Engineering」からの続き。

次は、本記事の "3 Missingness" から。

Now we’re ready to start exploring missing data and rectifying it through imputation. There are a number of different ways we could go about doing this. Given the small size of the dataset, we probably should not opt for deleting either entire observations (rows) or variables (columns) containing missing values. We’re left with the option of either replacing missing values with a sensible values given the distribution of the data, e.g., the mean, median or mode. Finally, we could go with prediction. We’ll use both of the two latter methods and I’ll rely on some data visualization to guide our decisions. 
これから、欠損データを見つけて修正するが、そのやり方はたくさんある。少ない数のデータなので、欠損データのレコードや変数を削除すべきではない。よって残された選択は、妥当な値で欠損値を置き換えること、データの平均値、中央値、モードを使って。

つまり「欠損値の対応」を行う(参照:データ操作:NA の取扱い方)。


乗船場所 Embarked

次のように、1309 件のデータ中 2 件で  Embarked 変数が欠損。

> full$PassengerId[full$Embarked == ""]
[1]  62 830

embarkment(乗船した場所)は passenger classfare と関連すると考えられる。この 2 件の値は

> full$Pclass[c(62,830)]; full$Fare[c(62,830)]
[1] 1 1
[1] 80 80

この 2 件を除いて、Embarked, Fare, Pclass でプロットする。

# 記事では filter 関数を使っていたが、上手くいかず。
> embark_fare <- subset(full, PassengerId!=62 & PassengerId!=830)

# 62, 830 のレコードが除かれたことを確認。
> embark_fare$PassengerId[embark_fare$PassengerId==1]
[1] 1
> embark_fare$PassengerId[embark_fare$PassengerId==62]
integer(0)
> embark_fare$PassengerId[embark_fare$PassengerId==830]
integer(0)
> 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()

Voilà! The median fare for a first class passenger departing from Charbourg (‘C’) coincides nicely with the $80 paid by our embarkment-deficient passengers. I think we can safely replace the NA values with ‘C’. 
Pclass が 1 (ファーストクラス)で乗船場所が C の中央値が 80 、よって 欠損レコードの 2 件の Embaked は C と判断する。

> full$Embarked[c(62,830)] <- 'C'


料金 Fare

ID 1044 の乗客の Fare 変数が NA(他の NA は予測に使用しないので無視)。

> 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    FsizeD Deck   Family
1044   3701   NA              S    Mr  Storey     1 singleton <NA> Storey_1

次は、Pclass = 3, Embarked = S のレコードで Fare の分布。
> 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()

縦点線が中央値で 8.05

> summary(full[full$Pclass=='3' & full$Embarked=='S',]$Fare)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  0.000   7.854   8.050  14.440  15.900  69.550       1 

これを ID 1044 の欠損値に設定

> full$Fare[1044] <- median(full[full$Pclass=='3'
    & full$Embarked=='S',]$Fare, na.rm=TRUE)


年齢 Age

3.2 Predictive imputation から。

Finally, as we noted earlier, there are quite a few missing Age values in our data. We are going to get a bit more fancy in imputing missing age values. Why? Because we can. We will create a model predicting ages based on other variables. 
他の変数から年齢を推定モデルを作る。

推定モデルの説明は以下の通り。

We could definitely use rpart (recursive partitioning for regression) to predict missing ages, but I’m going to use the mice package for this task just for something different. You can read more about multiple imputation using chained equations in r here (PDF). Since we haven’t done it yet, I’ll first factorize the factor variables and then perform mice imputation.

以下の実行例のように、年齢に関係するような変数を指定して、推定するモデルを作って、推定値を Age 変数に設定する。

# 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.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
...
  5   3  Age  Deck
  5   4  Age  Deck
  5   5  Age  Deck

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

元の Age の分布と、推定値の分布。
> 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))

# 置き換え前の NA レコード件数。
> sum(is.na(full$Age))
[1] 263
# 推定値と置き換え。
> full$Age <- mice_output$Age
# NA は無くなった
> sum(is.na(full$Age))
[1] 0


Feature Engineering #2」に続く。

0 件のコメント:

コメントを投稿