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

kaggleのkernels学習ノート~Head Start for Data Scientist~

More than 1 year has passed since last update.

題名の通りkaggleのkernelsを和訳したものです。自分の勉強の備忘録をまとめていきます。そして、データ分析に携わる誰かのお役に立てれば幸いです。和訳とか得意じゃないので間違っていたらごめんなさい。
今回はHitesh palamadaHeadさんのHead Start for Data Scientist
を和訳していきます。

1 データサイエンスって何ですか¿¿

私は機械学習の世界では初心者でした。コーディングする言語の選択、適切なオンラインコースの選択、正しいアルゴリズムの選択など、小さな決定に圧倒されました。だからこそ、皆さんが機械学習に馴染みやすいように計画しています。多くの人が機械学習の学習をゼロから始めていると思います。現場の専門家がどのように目的地に到着したのか、その中で見倣う部分はどこなのか見てみましょう。

1.1 どうすればできるのか!!

Stage 1 - あなた自身をコミットする

機械学習を学び始める人にとって、機械学習を学び、教えて、練習している人たちに囲まれていることが重要です。一人で学ぶことは簡単ではありません。なので、機械学習を学ぶことを約束し、データ・サイエンス・コミュニティを見つけて、学び始め時の苦痛を減らすのに役立ててください。

Stage 2 - 生態系を学ぶ

機械学習のエコシステムを発見する
データサイエンスは、オープンソースプラットフォームを活用している分野です。データ分析はさまざまな言語で実行できますが、適切なツールを使用することは、プロジェクトの成功を左右します。
データサイエンスのライブラリは、PythonとRの生態系では、非常に栄えています。データ解析のためのPythonとRのインフォグラフィックについてはこちらをご覧ください。どの言語を選んでも、データを操作しながら視覚化することができるJupyterノートブックとRStudioは、私たちのデータサイエンスライフをはるかに容易にしてくれます。
Jupyter Notebookの機能の詳細については、このリンクをクリックしてください。
Kaggle、Analytics Vidhya、MachineLearningMastery、KD Nuggetsなどは、世界中のデータサイエンティストがお互いの学習を豊かにするための活発なコミュニティです。機械学習は、Coursera、EdXなどのオンラインコースまたはMOOCによって民主化されています。ここでは、世界の大学の素晴らしい教授から学ぶことができます。現在入手可能なデータサイエンスのトップMOOCのリストを示します。

Stage 3 - 基礎を固める

データを扱う方法を学ぶ
データサイエンティストは、有用な情報を探索する前に、手の込んだデジタルデータを収集して前処理するという仕事にかける時間は50%〜80%に及びます-ニューヨークタイムズのスティーブ・ローア-
「データクランチング」は、機械学習ワークフロー全体です。 このプロセスを手助けするために、PythonのPandasライブラリを利用できます。リレーショナルデータまたはラベル付きデータのデータ構造を提供します。
データサイエンスは、機械学習モデルを構築するだけではありません。モデルを説明し、それらを使用してデータドリブンな意思決定を行うこともあります。分析からデータドリブンな意思決定において、データの視覚化は、データを強力かつ信頼させるための方法で提示できる非常に重要な役割を果たします。
PythonのMatplotlibライブラリやRのggplotは、高品質のデータ視覚化を作成するための非常に高い柔軟性を備えた完全な2Dグラフィックサポートを提供します。これらは、分析を実施する際にほとんどの時間、使用するライブラリの一部です。

Stage 4 - 明けても暮れても練習

機械学習アルゴリズムの学習と実践
基礎が固まったら、予測するために機械学習アルゴリズムを実装します。PythonのScikit-learnライブラリやRのcaret、e1071ライブラリは、一貫したインタフェースを介して教師あり/なしの機械学習アルゴリズムを提供します。これにより、内側の動作や細かい部分について心配することなくアルゴリズムを実装できます。
これらの機械学習アルゴリズムを、あなたの周りにあるユースケースに試してみてください。これはあなたの仕事の中にあるかもしれませんし、Kaggleのコンペで練習することもできます。kaggleでは、世界中のデータサイエンティストが、問題を解決するためにモデルを構築することで競争しています。
同時にアルゴリズムの内部動作を次々と理解していきましょう。線形回帰は、機械学習の「Hello World!」であり、ロジスティック回帰、決定木、サポートベクターマシンに移行していきましょう。これには、統計と線形代数の知識をブラッシュアップする必要があります。
AIの先駆者であるCourseraの創設者Andrew Ngは、機械学習アルゴリズムの内部動作を理解するための出発点となる機械学習コースを開発しました。

Stage 5 - 高度なスキルを学ぶ

複雑な機械学習アルゴリズムと深い学習アーキテクチャを学ぶ
機械学習は分野として長らく確立されてきた武運やである一方で、最近の誇大宣伝によるメディアの注目は、コンピュータビジョン、音声認識、言語処理などのAI分野の機械学習アプリケーションによって引き起こされたものです。これらの多くは、Google、Facebook、Microsoftなどのテックジャイアントによって開拓されてきました。最近の進歩は、安価な計算、大規模データの可用性、および新しいディープ・ラーニング・アーキテクチャーの開発で行われた進歩に比例する可能性があります。
ディープ・ラーニングで作業するには、フリー・テキスト、イメージのような非構造化データを処理する方法を学ぶ必要があります。また、TensorFlowやTorchなどのプラットフォームを使用する方法を学ぶことで、低レベルのハードウェア要件を気にせずにDeep Learningを適用できます。AlphaGo ZeroのようなモダンなAIを可能にした強化学習も学びます。

2 それは何ですか…?

Kaggleで多くの新しい学習者を見ています。基本的な学習者のために作成したこのカーネルは、データサイエンスを迅速に理解するための試みとして、「会話型の形式」で進めます。
カーネルでは、マークがデータサイエンス初心者であり、ジェームズが彼に概念を理解させる役割です。マークジェームズと表記します。使用するデータはタイタニックのデータセットです。

2.1 イントロダクション

1912年4月14日、タイタニック号は大規模な氷山に追突し、約1,500人の乗客と乗組員が犠牲になりました。海上での最悪の災害の1つと考えられたこの悲劇的な出来事は、このような大災害が再び起こるのを防ぐための数多くの安全規制と政策を作り出しました。しかし、一部の批評家は、幸運以外の状況では死者数が不均衡になったと主張しています。この分析の目的は、人が生き残る可能性に影響を与えた要因を探求することです。

2.1.1 ソフトウェア

以下の分析は、R環境で実施されました。

マーク - ジェームズ、今日は何を学んでいるのですか?
ジェームズ - データ科学の基礎です。
マーク - データサイエンスとは何ですか?
ジェームズ - データサイエンスは、複雑な問題を解決するために、データ推論、アルゴリズム開発、テクノロジーを使って分析する複合的な総称のようなもです。
マーク - データサイエンティストはどのようにしてインサイトを得るのですか?
ジェームズ - 下記のことから始めてみましょうか。

  1. 問題を解決するために必要なローデータを収集
  2. データを処理する(データラングリング)
  3. データを調べる(データの視覚化)
  4. 深く分析する(機械学習、統計モデル、アルゴリズム)
  5. 分析結果を伝える。

マーク - ジェームズ、具体的に説明してください。
ジェームズ - では、「タイタニック」のローデータがあります。これらは一般的に、データはデータベースから取り出されます。

2.2 ライブラリとデータのインポート

マーク - Rstudioにデータセットをインポートする方法は?
ジェームズ - データをロードする前に、関数と特定のアルゴリズムのためにライブラリを呼び出す必要があります。
マーク - ライブラリが呼び出されない場合はどうでしょうか?
ジェームズ - Rコンソールにエラーメッセージが返されます。
マーク - Oh Gowd、ライブラリを呼び出したいです。
ジェームズ - インポートライブラリでインポートできます。

R
# data wrangling
library(tidyverse)
library(forcats)
library(stringr)
library(caTools)

# data assessment/visualizations
library(DT)
library(data.table)
library(pander)
library(ggplot2)
library(scales)
library(grid)
library(gridExtra)
library(corrplot)
library(VIM) 
library(knitr)
library(vcd)
library(caret)

# model
library(xgboost)
library(MLmetrics)
library(randomForest) 
library(rpart)
library(rpart.plot)
library(car)
library(e1071)
library(vcd)
library(ROCR)
library(pROC)
library(VIM)
library(glmnet) 

マーク - データセットをインポートできるようになりました。
ジェームズ - はい。

R
train <- read_csv('../input/train.csv')
test  <- read_csv('../input/test.csv')

ジェームズ - 一連のデータセットを完成させるために、テストデータと訓練データセットを結合できます。その前に、新しいカラム"set"を追加し、テストデータセットの名前を"test"と、訓練データの名前を"train"として、識別できるようにしておきます。

R
train$set <- "train"
test$set  <- "test"
test$Survived <- NA
full <- rbind(train, test)

マーク - これで問題は解決しましたか?
ジェームズ - はい、次にデータを処理します。
マーク - データラングリングをする必要があるのはなぜですか?
ジェームズ - 収集したデータはまだ「生データ」です。誤入力、欠損などを含む可能性が非常に高いのです。データから何らかの結論を引き出す前に、データラングリングが必要です。これは次のセクションのテーマです。私たちは操作を実行したいデータを選択します。
マーク - データサイエンスではどのような作業が行われていきますか?
ジェームズ - こんな感じです。
data-science-02.jpg
ジェームズ - わかりやすいですね。
1_2T5rbjOBGVFdSvtlhCqlNg.png
マーク - このツールは素晴らしいツールです。
ジェームズ - このカーネルでは、Rプログラミング言語を使用します。これまでのデータを見てみましょう。str()names()summary()glimpse()などを使用しましょう。

  1. どのように散らばっているのかデータを調べる
  2. データセットの次元
  3. 列名
  4. 各行にはユニークな値がいくつあるか
  5. 値の欠落など
R
#データの確認
str(full)

#データの次元
dim(full)

#カラムごとのユニークな値の数
lapply(full, function(x) length(unique(x))) 

#欠損値の確認
missing_values <- full %>% summarize_all(funs(sum(is.na(.))/n()))
missing_values <- gather(missing_values, key="feature", value="missing_pct")

missing_values %>% 
  ggplot(aes(x=reorder(feature,-missing_pct),y=missing_pct)) +
  geom_bar(stat="identity",fill="red")+
  coord_flip()+theme_bw()

unnamed-chunk-3-1.png

R
#欠損値を確認するための便利関数
checkColumn = function(df,colname){
  testData = df[[colname]]
  numMissing =max(sum(is.na(testData)|is.nan(testData)|testData==''),0)
  if (class(testData) == 'numeric' | class(testData) == 'Date' | class(testData) == 'difftime' | class(testData) == 'integer'){
    list('col' = colname,'class' = class(testData), 'num' = length(testData) - numMissing, 'numMissing' = numMissing, 'numInfinite' = sum(is.infinite(testData)), 'avgVal' = mean(testData,na.rm=TRUE), 'minVal' = round(min(testData,na.rm = TRUE)), 'maxVal' = round(max(testData,na.rm = TRUE)))
  } else{
    list('col' = colname,'class' = class(testData), 'num' = length(testData) - numMissing, 'numMissing' = numMissing, 'numInfinite' = NA,  'avgVal' = NA, 'minVal' = NA, 'maxVal' = NA)
  }
}

checkAllCols = function(df){
  resDF = data.frame()
  for (colName in names(df)){
    resDF = rbind(resDF,as.data.frame(checkColumn(df=df,colname=colName)))
  }
  resDF
}

datatable(checkAllCols(full), style="bootstrap", class="table-condensed", options = list(dom = 'tp',scrollX = TRUE))
miss_pct <- map_dbl(full, function(x) { round((sum(is.na(x)) / length(x)) * 100, 1) })
miss_pct <- miss_pct[miss_pct > 0]
data.frame(miss=miss_pct, var=names(miss_pct), row.names=NULL) %>%
    ggplot(aes(x=reorder(var, -miss), y=miss)) + 
    geom_bar(stat='identity', fill='red') +
    labs(x='', y='% missing', title='Percent missing data by feature')+
    theme(axis.text.x=element_text(angle=90, hjust=1))

unnamed-chunk-4-1.png

2.3 フィーチャー・エンジニアリング

マーク - フィーチャエンジニアリングとは何ですか?
ジェームズ - このプロセスは、データ内の既存のフィーチャから追加のフィーチャを作成し、学習モデルの予測力を向上させるためのものです。フィーチャエンジニアリングテクニックについてのアイデアを得るには- https://github.com/bobbbbbi/Machine-learning-Feature-engineering-techniquesを参照してください。

2.4 データのマニピュレーション

マーク - データセットの中身を知っていますか?
ジェームズ - その後に、データのマニピュレーションを始めます。
マーク - データのマニピュレーションとは何ですか?
ジェームズ - データマニピュレーションとは、データの読み込みや整理を容易にするためにデータを変更するプロセスです。

以下のセクションでは、探索的データ分析やモデリングフィッティングなど、分析に使用できるようにデータを準備することに焦点を当てます。

【備考】
変数名データセットとの対応を残すために英語のままです(訳者補足)。

2.4.1 Age

欠損した年齢の値を、タイタニック号のすべての乗客の平均年齢で置き換えます。

R
full <- full %>%
    mutate(
      Age = ifelse(is.na(Age), mean(full$Age, na.rm=TRUE), Age),
      `Age Group` = case_when(Age < 13 ~ "Age.0012", 
                                 Age >= 13 & Age < 18 ~ "Age.1317",
                                 Age >= 18 & Age < 60 ~ "Age.1859",
                                 Age >= 60 ~ "Age.60Ov"))

2.4.2 Embarked

Embarkedでは、Embarked内で最も共通的なコードである"S"を使用してNAsを置き換えます。

R
full$Embarked <- replace(full$Embarked, which(is.na(full$Embarked)), 'S')

2.4.3 Titles

名前から個人の肩書を抽出します。

R
names <- full$Name
title <-  gsub("^.*, (.*?)\\..*$", "\\1", names)
full$title <- title

table(title)
## title
##         Capt          Col          Don         Dona           Dr 
##            1            4            1            1            8 
##     Jonkheer         Lady        Major       Master         Miss 
##            1            1            2           61          260 
##         Mlle          Mme           Mr          Mrs           Ms 
##            2            1          757          197            2 
##          Rev          Sir the Countess 
##            8            1            1

###MISS, Mrs, Master and Mr に変換する
full$title[full$title == 'Mlle'] <- 'Miss' 
full$title[full$title == 'Ms']   <- 'Miss'
full$title[full$title == 'Mme']  <- 'Mrs' 
full$title[full$title == 'Lady'] <- 'Miss'
full$title[full$title == 'Dona'] <- 'Miss'

##小さいデータで加工すると過学習する恐れがありますし、特定のカテゴリの予測能力をなくしてしまいます
full$title[full$title == 'Capt']  <- 'Officer' 
full$title[full$title == 'Col']   <- 'Officer' 
full$title[full$title == 'Major'] <- 'Officer'
full$title[full$title == 'Dr']    <- 'Officer'
full$title[full$title == 'Rev']   <- 'Officer'
full$title[full$title == 'Don']   <- 'Officer'
full$title[full$title == 'Sir']   <- 'Officer'
full$title[full$title == 'the Countess'] <- 'Officer'
full$title[full$title == 'Jonkheer'] <- 'Officer'  

2.4.4 Family Groups

家族の数に基づいて離散化された特徴に分類します。

R
full$FamilySize <-full$SibSp + full$Parch + 1 
full$FamilySized[full$FamilySize == 1] <- 'Single' 
full$FamilySized[full$FamilySize < 5 & full$FamilySize >= 2] <- 'Small' 
full$FamilySized[full$FamilySize >= 5] <- 'Big' 
full$FamilySized=as.factor(full$FamilySized)

2.4.5 Tickets

同じチケットを持つすべての乗客に基づいて特徴量を加工します。

R
ticket.unique <- rep(0, nrow(full))
tickets <- unique(full$Ticket)

for (i in 1:length(tickets)) {
  current.ticket <- tickets[i]
  party.indexes <- which(full$Ticket == current.ticket)
  for (k in 1:length(party.indexes)) {
    ticket.unique[party.indexes[k]] <- length(party.indexes)
  }
}

full$ticket.unique <- ticket.unique
full$ticket.size[full$ticket.unique == 1]   <- 'Single'
full$ticket.size[full$ticket.unique < 5 & full$ticket.unique>= 2]   <- 'Small'
full$ticket.size[full$ticket.unique >= 5]   <- 'Big'

2.4.6 Independent Variable/Target

2.4.7 Survival

独立変数であるSurvivedは、生存している乗客または乗組員が値=1で符号化されるベルヌイ試行でラベル付けされます。訓練データ内のうち、約38%の乗客と乗組員が生き残ったことがわかります。

R
full <- full %>%
  mutate(Survived = case_when(Survived==1 ~ "Yes", 
                              Survived==0 ~ "No"))

crude_summary <- full %>%
  filter(set=="train") %>%
  select(PassengerId, Survived) %>%
  group_by(Survived) %>%
  summarise(n = n()) %>%
  mutate(freq = n / sum(n))

crude_survrate <- crude_summary$freq[crude_summary$Survived=="Yes"]
kable(crude_summary, caption="2x2 Contingency Table on Survival.", format="markdown")
Survived n freq
No 549 0.6161616
Yes 342 0.3838384

2.5 探索的データ分析

マーク - 探索的データ分析とは何ですか?
ジェームズ - データサイエンスは、分析的に複雑な問題を解決するために、データ推論、アルゴリズム開発、テクノロジーが混ざりあったものです。統計における探索的データ分析(EDA)は、多くの場合、視覚的な方法で、その主要な特徴を要約するためにデータセットを分析するアプローチです。統計的モデルを使用してもしなくてもかまいませんが、主にEDAは正式なモデリングや仮説検定の作業を超えてデータを理解するためのものです。

2.5.1 従属変数と独立変数の関係

2.5.2 独立変数/予測子

下記の各変数項目を参照してください。

2.5.3 生存率との関係

Pclass

R
ggplot(full %>% filter(set=="train"), aes(Pclass, fill=Survived)) +
  geom_bar(position = "fill") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  ylab("Survival Rate") +
  geom_hline(yintercept=crude_survrate, col="white", lty=2, size=2) +
  ggtitle("Survival Rate by Class") + 
  theme_minimal()

rate_pclass-1.png

Sex

R
ggplot(full %>% filter(set=="train"), aes(Sex, fill=Survived)) +
  geom_bar(position = "fill") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  ylab("Survival Rate") +
  geom_hline(yintercept=crude_survrate, col="white", lty=2, size=2) +
  ggtitle("Survival Rate by Sex") + 
  theme_minimal()

rate_sex-1.png

Age

R
tbl_age <- full %>%
  filter(set=="train") %>%
  select(Age, Survived) %>%
  group_by(Survived) %>%
  summarise(mean.age = mean(Age, na.rm=TRUE))

ggplot(full %>% filter(set=="train"), aes(Age, fill=Survived)) +
  geom_histogram(aes(y=..density..), alpha=0.5) +
  geom_density(alpha=.2, aes(colour=Survived)) +
  geom_vline(data=tbl_age, aes(xintercept=mean.age, colour=Survived), lty=2, size=1) +
  scale_fill_brewer(palette="Set1") +
  scale_colour_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  ylab("Density") +
  ggtitle("Survival Rate by Age") + 
  theme_minimal()

rate_age-1.png

Age Group

R
ggplot(full %>% filter(set=="train" & !is.na(Age)), aes(`Age Group`, fill=Survived)) +
  geom_bar(position = "fill") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  ylab("Survival Rate") +
  geom_hline(yintercept=crude_survrate, col="white", lty=2, size=2) +
  ggtitle("Survival Rate by Age Group") + 
  theme_minimal()

rate_age_group-1.png

SibSp

R
ggplot(full %>% filter(set=="train"), aes(SibSp, fill=Survived)) +
  geom_bar(position = "fill") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  ylab("Survival Rate") +
  geom_hline(yintercept=crude_survrate, col="white", lty=2, size=2) +
  ggtitle("Survival Rate by SibSp") + 
  theme_minimal()

rate_sibsp-1.png

Parch

R
ggplot(full %>% filter(set=="train"), aes(Parch, fill=Survived)) +
  geom_bar(position = "fill") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  ylab("Survival Rate") +
  geom_hline(yintercept=crude_survrate, col="white", lty=2, size=2) +
  ggtitle("Survival Rate by Parch") + 
  theme_minimal()

rate_parch-1.png

Embarked

R
ggplot(full %>% filter(set=="train"), aes(Embarked, fill=Survived)) +
  geom_bar(position = "fill") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  ylab("Survival Rate") +
  geom_hline(yintercept=crude_survrate, col="white", lty=2, size=2) +
  ggtitle("Survival Rate by Embarked") + 
  theme_minimal()

rate_embarked-1.png

Title

R
ggplot(full %>% filter(set=="train") %>% na.omit, aes(title, fill=Survived)) +
  geom_bar(position="fill") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  ylab("Survival Rate") +
  geom_hline(yintercept=crude_survrate, col="white", lty=2, size=2) +
  ggtitle("Survival Rate by Title") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

rate_title-1.png

family Group

R
ggplot(full %>% filter(set=="train") %>% na.omit, aes(`FamilySize`, fill=Survived)) +
  geom_bar(position="fill") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  ylab("Survival Rate") +
  geom_hline(yintercept=crude_survrate, col="white", lty=2, size=2) +
  ggtitle("Survival Rate by Family Group") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

rate_family-1.png

2.5.4 頻度との関係性

Pclass

R
ggplot(full %>% filter(set=="train"), aes(Pclass, fill=Survived)) +
  geom_bar(position="stack") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=comma) +
  ylab("Passengers") 
  ggtitle("Survived by Class") + 
  theme_minimal()

freq_pclass-1.png

Sex

R
ggplot(full %>% filter(set=="train"), aes(Sex, fill=Survived)) +
  geom_bar(position="stack") +
  scale_fill_brewer(palette="Set1") 
  scale_y_continuous(labels=percent) +
  scale_y_continuous(labels=comma) +
  ylab("Passengers") +
  ggtitle("Survived by Sex") + 
  theme_minimal()

freq_sex-1.png

Age

R
ggplot(full %>% filter(set=="train"), aes(Age, fill=Survived)) +
  geom_histogram(aes(y=..count..), alpha=0.5) +
  geom_vline(data=tbl_age, aes(xintercept=mean.age, colour=Survived), lty=2, size=1) +
  scale_fill_brewer(palette="Set1") +
  scale_colour_brewer(palette="Set1") +
  scale_y_continuous(labels=comma) +
  ylab("Density") +
  ggtitle("Survived by Age") + 
  theme_minimal()

freq_age-1.png

Age Group

R
ggplot(full %>% filter(set=="train" & !is.na(Age)), aes(`Age Group`, fill=Survived)) +
  geom_bar(position="stack") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=comma) 
  ylab("Passengers") +
  ggtitle("Survived by Age Group") + 
  theme_minimal()

freq_age_group-1.png

SibSp

R
ggplot(full %>% filter(set=="train"), aes(SibSp, fill=Survived)) +
  geom_bar(position="stack") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=percent) +
  scale_y_continuous(labels=comma) +
  ylab("Passengers") +
  ggtitle("Survived by SibSp") + 
  theme_minimal()

freq_sibsp-1.png

Parch

R
ggplot(full %>% filter(set=="train"), aes(Parch, fill=Survived)) +
  geom_bar(position="stack") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=comma) +
  ylab("Passengers") +
  ggtitle("Survived by Parch") + 
  theme_minimal()

freq_parch-1.png

Embarked

R
ggplot(full %>% filter(set=="train"), aes(Embarked, fill=Survived)) +
  geom_bar(position="stack") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=comma) +
  ylab("Passengers") +
  ggtitle("Survived by Embarked") + 
  theme_minimal()

freq_embarked-1.png

Title

R
ggplot(full %>% filter(set=="train") %>% na.omit, aes(title, fill=Survived)) +
  geom_bar(position="stack") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=comma) +
  ylab("Passengers") +
  ggtitle("Survived by Title") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

freq_title-1.png

Family

R
ggplot(full %>% filter(set=="train") %>% na.omit, aes(`FamilySize`, fill=Survived)) +
  geom_bar(position="stack") +
  scale_fill_brewer(palette="Set1") +
  scale_y_continuous(labels=comma) +
  ylab("Passengers") +
  ggtitle("Survived by Family Group") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

freq_family-1.png

2.5.5 変数間のインタラクティブな関係

2.5.5.1 相関行列プロット

マーク - 相関プロットとは何ですか?
ジェームズ - corrplotパッケージは、相関行列、信頼区間のグラフを表示するパッケージです。 また、行列の並び替えを行うアルゴリズムも含まれています。 さらに、色、テキストラベル、カラーラベル、レイアウトなどを選択するなど、細部にも優れています。
数値フィーチャ間の相関測定は、Fare with Pclassのような冗長な情報を示唆しています。 しかし、この関係は、運賃が家族の総費用の合計を表す家族として搭乗した乗客のために歪むことがあります。

R
tbl_corr <- full %>%
  filter(set=="train") %>%
  select(-PassengerId, -SibSp, -Parch) %>%
  select_if(is.numeric) %>%
  cor(use="complete.obs") %>%
  corrplot.mixed(tl.cex=0.85)

corrplot-1.png

2.5.5.2 モザイクプロット

マーク - モザイクプロットとなんですか?
ジェームズ - モザイクプロット(Marimekkoダイアグラムとも呼ばれます)は、2つ以上の質的変数からデータを視覚化するためのグラフィカルな方法です。これは、スパインプロットの多次元拡張であり、1つの変数に対してのみ、同じ情報をグラフィカルに表示します。

R
tbl_mosaic <- full %>%
  filter(set=="train") %>%
  select(Survived, Pclass, Sex, AgeGroup=`Age Group`, title, Embarked, `FamilySize`) %>%
  mutate_all(as.factor)
mosaic(~Pclass+Sex+Survived, data=tbl_mosaic, shade=TRUE, legend=TRUE)

mosaicplot-1.png

2.5.5.3 アルビアルダイアグラム

マーク - アルビアルダイアグラムとは何ですか?
ジェームズ - アルビアルダイアグラムは、元々時間の経過とともにネットワーク構造の変化を表すために開発されたフローダイアグラムの一種です。ブロックと流れに重点をおいて見ると、アルビアルダイアグラムは、流水から堆積した土によって自然に形成される扇状地見えます。

生存可能性は、第3等級の乗客が最も低かった。 しかし、性別が女性の場合、生存の可能性が増えました。驚くべきことに、幼児と青少年の半数が死亡し、これについての説得力のある説明として、死亡した子どもの多くが、以下の条件付き推論ツリーモデルで示唆されているように、サイズの大きな家族から来たものである可能性があります。

R
library(alluvial)

tbl_summary <- full %>%
  filter(set=="train") %>%
  group_by(Survived, Sex, Pclass, `Age Group`, title) %>%
  summarise(N = n()) %>% 
  ungroup %>%
  na.omit

alluvial(tbl_summary[, c(1:4)],
         freq=tbl_summary$N, border=NA,
         col=ifelse(tbl_summary$Survived == "Yes", "blue", "gray"),
         cex=0.65,
         ordering = list(
           order(tbl_summary$Survived, tbl_summary$Pclass==1),
           order(tbl_summary$Sex, tbl_summary$Pclass==1),
           NULL,
           NULL))

alluvial-1.png

2.6 機械学習アルゴリズム

マーク - 機械学習とは何ですか?
ジェームズ - 機械学習は、明示的にプログラムしなくても、システムが自動的に経験から学び、改善する能力を提供する人工知能(AI)のアプリケーションです。機械学習は、データにアクセスして学習するためのコンピュータプログラムの開発に重点を置いています。
学習のプロセスは、データのパターンを探したり、将来のよりよい意思決定を行うために、私たちが提供する事例、直接的な経験、インストラクションから始まります。主な目的は、人間の介入や援助なしに、自動的にコンピュータを学習させ、それに応じて行動を調整することです。
machinelearningtypes.jpg
マーク - 教師なしの機械学習とは何ですか?
ジェームズ -
教師あり学習 - 教師付き学習は、ラベル付きのトレーニングデータから関数を推論するデータマイニングタスクです。トレーニングデータは一連のトレーニング例で構成されています。 教師あり学習では、各例は入力オブジェクト(通常ベクトル)と望ましい出力値(監視信号とも呼ばれます)からなるペアです。教師付き学習アルゴリズムは、トレーニングデータを分析し、新しい例をマッピングするために使用される推論関数を生成します。最適なシナリオは、アルゴリズムが、見えないインスタンスのクラスラベルを正しく決定することを可能にします。これは、学習アルゴリズムがトレーニングデータから見えない状況を「合理的な」方法で一般化することを必要とします。
教師なし学習 - データマイニングやデータサイエンスの世界において、教師なし学習タスクの問題というのは、ラベルのないデータに隠れた構造を見つけることです。学習者に与えられた例はラベルが付けられていないので、潜在的な解決策を評価するためのエラーや報酬のシグナルはありません。

マーク - さて、私たちは教師あり学習をしますか?
ジェームズ - はい、それはタイタニック号の乗客の生存を予測したいので教師付き機械学習です。
マーク - 教師付き学習のアルゴリズムは何ですか?
ジェームズ - 理解を促すために、アルゴリズム統計関数の詳細についてこのイメージを見てください。
machine-learning-cheet-sheet.png
ジェームズ - "Pclass"、 "title"、 "Sex"、 "Embarked"、 "FamilySized"、 "ticket.size"を持つトレーニングデータセットを準備しましょう。変数とデータセットをトレーニングデータセットとして70%、テストデータセットとして30%に分割します。
マーク - トレーニングデータとテストデータは何ですか?
ジェームズ -
トレーニングセット - 機械学習では、トレーニングセットはモデルをトレーニングするために使用されるデータセットです。 モデルのトレーニングでは、トレーニングセットから特定の特徴量が選択されます。 これらの特徴量は、モデルに組み込まれます。
テストセット - テストセットは、そのテストセットで予測を行う際にモデルがどれだけうまく機能するかを測定するために使用されるデータセットです

2.6.1 データセットの準備

R
###lets prepare and keep data in the proper format
feauter1<-full[1:891, c("Pclass", "title","Sex","Embarked","FamilySized","ticket.size")]
response <- as.factor(train$Survived)
feauter1$Survived=as.factor(train$Survived)

###For Cross validation purpose will keep 20% of data aside from my orginal train set
##This is just to check how well my data works for unseen data
set.seed(500)
ind=createDataPartition(feauter1$Survived,times=1,p=0.8,list=FALSE)
train_val=feauter1[ind,]
test_val=feauter1[-ind,]
####check the proprtion of Survival rate in orginal training data, current traing and testing data

round(prop.table(table(train$Survived)*100),digits = 1)
## 
##   0   1 
## 0.6 0.4

round(prop.table(table(train_val$Survived)*100),digits = 1)
## 
##   0   1 
## 0.6 0.4

round(prop.table(table(test_val$Survived)*100),digits = 1)
## 
##   0   1 
## 0.6 0.4

ジェームズ - アルゴリズムを使ったトレーニングをしましょう。
マーク - アルゴリズムを使ったトレーニングの後、次は何をしますか?
ジェームズ - 私たちは、訓練されたアルゴリズムをテストデータセットで検証しなければなりません。
マーク - アルゴリズムのパフォーマンスをどのように測定しますか?
ジェームズ - 適合の良さで検証し、コンフュージョンマトリックスを利用します。
注 - アルゴリズムごとにタブごとに移動します

2.7 予測とクロスバリデーション

決定木

R
##ランダムフォレストは決定木の発展版で、ランダムフォレストを理解する上で決定木は役立ちます

set.seed(1234)
Model_DT=rpart(Survived~.,data=train_val,method="class")
rpart.plot(Model_DT,extra =  3,fallen.leaves = T)

unnamed-chunk-8-1.png

R
###モデルは、Title, Pclass and Ticket.sizeしか使っていません。
###精度を確認します

PRE_TDT=predict(Model_DT,data=train_val,type="class")

confusionMatrix(PRE_TDT,train_val$Survived)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 395  71
##          1  45 203
##                                           
##                Accuracy : 0.8375          
##                  95% CI : (0.8084, 0.8639)
##     No Information Rate : 0.6162          
##     P-Value [Acc > NIR] : < 2e-16         
##                                           
##                   Kappa : 0.6502          
##  Mcnemar's Test P-Value : 0.02028         
##                                           
##             Sensitivity : 0.8977          
##             Specificity : 0.7409          
##          Pos Pred Value : 0.8476          
##          Neg Pred Value : 0.8185          
##              Prevalence : 0.6162          
##          Detection Rate : 0.5532          
##    Detection Prevalence : 0.6527          
##       Balanced Accuracy : 0.8193          
##                                           
##        'Positive' Class : 0               
## 
#####Accuracy is 0.8375
####3つしか特徴量がないですがまずまずです
##決定木は過学習しやすいので、10ホールドクロスバリデーションしておきます

set.seed(1234)
cv.10 <- createMultiFolds(train_val$Survived, k = 10, times = 10)

# Control
ctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 10,index = cv.10)
train_val <- as.data.frame(train_val)

##Train the data
Model_CDT <- train(x = train_val[,-7], y = train_val[,7], method = "rpart", tuneLength = 30,trControl = ctrl)

##精度の確認
##10ホールドクロスバリデーションでの精度は0.8139 
##さきほどのは過学習していたようです。精度は0.83になりました。

#変数重要度を確認します
rpart.plot(Model_CDT$finalModel,extra =  3,fallen.leaves = T)

unnamed-chunk-9-1.png

R
##Yes, there is no change in the imporatnce of variable
###Lets cross validate the accurcay using data that kept aside for testing purpose
PRE_VDTS=predict(Model_CDT$finalModel,newdata=test_val,type="class")

confusionMatrix(PRE_VDTS,test_val$Survived)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 97 20
##          1 12 48
##                                           
##                Accuracy : 0.8192          
##                  95% CI : (0.7545, 0.8729)
##     No Information Rate : 0.6158          
##     P-Value [Acc > NIR] : 3.784e-09       
##                                           
##                   Kappa : 0.6093          
##  Mcnemar's Test P-Value : 0.2159          
##                                           
##             Sensitivity : 0.8899          
##             Specificity : 0.7059          
##          Pos Pred Value : 0.8291          
##          Neg Pred Value : 0.8000          
##              Prevalence : 0.6158          
##          Detection Rate : 0.5480          
##    Detection Prevalence : 0.6610          
##       Balanced Accuracy : 0.7979          
##                                           
##        'Positive' Class : 0               
## 
###There it is, How exactly our train data and test data matches in accuracy (0.8192)

col_names <- names(train_val)
train_val[col_names] <- lapply(train_val[col_names] , factor)
test_val[col_names] <- lapply(test_val[col_names] , factor)

ランダムフォレスト

R
set.seed(1234)
rf.1 <- randomForest(x = train_val[,-7],y=train_val[,7], importance = TRUE, ntree = 1000)

rf.1
## 
## Call:
##  randomForest(x = train_val[, -7], y = train_val[, 7], ntree = 1000,      importance = TRUE) 
##                Type of random forest: classification
##                      Number of trees: 1000
## No. of variables tried at each split: 2
## 
##         OOB estimate of  error rate: 17.09%
## Confusion matrix:
##     0   1 class.error
## 0 395  45   0.1022727
## 1  77 197   0.2810219

varImpPlot(rf.1)

unnamed-chunk-10-1.png

R
####ランダムフォレストの精度は82.91で、決定木よりも1%改善されています。
####不要な特徴量を削除して再度モデリングします
train_val1=train_val[,-4:-5]
test_val1=test_val[,-4:-5]
set.seed(1234)

rf.2 <- randomForest(x = train_val1[,-5],y=train_val1[,5], importance = TRUE, ntree = 1000)

rf.2
## 
## Call:
##  randomForest(x = train_val1[, -5], y = train_val1[, 5], ntree = 1000,      importance = TRUE) 
##                Type of random forest: classification
##                      Number of trees: 1000
## No. of variables tried at each split: 2
## 
##         OOB estimate of  error rate: 15.97%
## Confusion matrix:
##     0   1 class.error
## 0 395  45   0.1022727
## 1  69 205   0.2518248

varImpPlot(rf.2)

unnamed-chunk-10-2.png

R
###2つの特徴量を削除するだけで精度が向上します。現在の精度は84.03です。
##ランダムフォレストだけでもパワフルですがクロスバリデーションしておきます
set.seed(2348)
cv10_1 <- createMultiFolds(train_val1[,5], k = 10, times = 10)

# Set up caret's trainControl object per above.
ctrl_1 <- trainControl(method = "repeatedcv", number = 10, repeats = 10, index = cv10_1)


set.seed(1234)
rf.5<- train(x = train_val1[,-5], y = train_val1[,5], method = "rf", tuneLength = 3, ntree = 1000, trControl =ctrl_1)

rf.5
## Random Forest 
## 
## 714 samples
##   4 predictor
##   2 classes: '0', '1' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 10 times) 
## Summary of sample sizes: 642, 643, 642, 643, 643, 643, ... 
## Resampling results across tuning parameters:
## 
##   mtry  Accuracy   Kappa    
##   2     0.8392390  0.6538299
##   3     0.8382551  0.6518851
##   4     0.8368466  0.6489636
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.
##Cross validation give us the accurcay rate of .8393

###予測します
pr.rf=predict(rf.5,newdata = test_val1)
confusionMatrix(pr.rf,test_val1$Survived)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 97 20
##          1 12 48
##                                           
##                Accuracy : 0.8192          
##                  95% CI : (0.7545, 0.8729)
##     No Information Rate : 0.6158          
##     P-Value [Acc > NIR] : 3.784e-09       
##                                           
##                   Kappa : 0.6093          
##  Mcnemar's Test P-Value : 0.2159          
##                                           
##             Sensitivity : 0.8899          
##             Specificity : 0.7059          
##          Pos Pred Value : 0.8291          
##          Neg Pred Value : 0.8000          
##              Prevalence : 0.6158          
##          Detection Rate : 0.5480          
##    Detection Prevalence : 0.6610          
##       Balanced Accuracy : 0.7979          
##                                           
##        'Positive' Class : 0               
## 
####精度は0.8192ですが、予想したよりも悪いかったです。 

ラッソ-リッジ回帰

R
train_val <- train_val %>%
    mutate(Survived = case_when(Survived==1 ~ "Yes", 
                                Survived==0 ~ "No"))

train_val<- as.data.frame(train_val)
train_val$title<-as.factor(train_val$title)
train_val$Embarked<-as.factor(train_val$Embarked)
train_val$ticket.size<-as.factor(train_val$ticket.size)

table(train_val$Survived)
## 
##  No Yes 
## 440 274

test_val<- as.data.frame(test_val)

test_val$title<-as.factor(test_val$title)
test_val$Embarked<-as.factor(test_val$Embarked)
test_val$ticket.size<-as.factor(test_val$ticket.size)
test_val$Survived<-as.factor(test_val$Survived)

train.male = subset(train_val, train_val$Sex == "male")
train.female = subset(train_val, train_val$Sex == "female")
test.male = subset(test_val, test_val$Sex == "male")
test.female = subset(test_val, test_val$Sex == "female")

train.male$Sex = NULL
train.male$title = droplevels(train.male$title)
train.female$Sex = NULL
train.female$title = droplevels(train.female$title)
test.male$Sex = NULL
test.male$title = droplevels(test.male$title)
test.female$Sex = NULL
test.female$title = droplevels(test.female$title)
set.seed(101) 
train_ind <- sample.split(train.male$Survived, SplitRatio = .75)

# MALE
## set the seed to make your partition reproductible
cv.train.m <- train.male[train_ind, ]
cv.test.m  <- train.male[-train_ind, ]

# FEMALE
set.seed(100)

## 再現性のためにシードを固定します
set.seed(123)
train_ind <- sample.split(train.female$Survived, SplitRatio = .75)
cv.train.f <- train.male[train_ind, ]
cv.test.f  <- train.male[-train_ind, ]
x.m = data.matrix(cv.train.m[,1:5])
y.m = cv.train.m$Survived

set.seed(356)
# 10 fold cross validation
cvfit.m.ridge = cv.glmnet(x.m, y.m, 
                  family = "binomial", 
                  alpha = 0,
                  type.measure = "class")

cvfit.m.lasso = cv.glmnet(x.m, y.m, 
                  family = "binomial", 
                  alpha = 1,
                  type.measure = "class")

par(mfrow=c(1,2))
plot(cvfit.m.ridge, main = "Ridge")
plot(cvfit.m.lasso, main = "Lasso")

unnamed-chunk-11-1.png

R
coef(cvfit.m.ridge, s = "lambda.min")
## 6 x 1 sparse Matrix of class "dgCMatrix"
##                       1
## (Intercept)  2.55667083
## Pclass      -0.77816232
## title       -1.82390027
## Embarked     0.05556335
## FamilySized  0.59648771
## ticket.size -0.10899060
# Prediction on training set

PredTrain.M = predict(cvfit.m.ridge, newx=x.m, type="class")

table(cv.train.m$Survived, PredTrain.M, cv.train.m$title)
## , ,  = Master
## 
##      PredTrain.M
##        No Yes
##   No   11   0
##   Yes  15   3
## 
## , ,  = Mr
## 
##      PredTrain.M
##        No Yes
##   No  263   0
##   Yes  46   0
## 
## , ,  = Officer
## 
##      PredTrain.M
##        No Yes
##   No    7   0
##   Yes   2   0
# Prediction on validation set

PredTest.M = predict(cvfit.m.ridge, newx=data.matrix(cv.test.m[,1:5]), type="class")
table(cv.test.m$Survived, PredTest.M, cv.test.m$title)
## , ,  = Master
## 
##      PredTest.M
##        No Yes
##   No   14   0
##   Yes  19   3
## 
## , ,  = Mr
## 
##      PredTest.M
##        No Yes
##   No  349   0
##   Yes  63   0
## 
## , ,  = Officer
## 
##      PredTest.M
##        No Yes
##   No   11   0
##   Yes   3   0
# Prediction on test set

PredTest.M = predict(cvfit.m.ridge, newx=data.matrix(test.male[,1:5]), type="class")

table(PredTest.M, test.male$title)
##           
## PredTest.M Master  Mr Officer
##         No      4 104       6
#female

x.f = data.matrix(cv.train.f[,1:5])
y.f = cv.train.f$Survived

set.seed(356)
cvfit.f.ridge = cv.glmnet(x.f, y.f, 
                  family = "binomial", 
                  alpha = 0,
                  type.measure = "class")

cvfit.f.lasso = cv.glmnet(x.f, y.f, 
                  family = "binomial", 
                  alpha = 1,
                  type.measure = "class")

par(mfrow=c(1,2))
plot(cvfit.f.ridge, main = "Ridge")
plot(cvfit.f.lasso, main = "Lasso")

unnamed-chunk-11-2.png

R
coef(cvfit.f.ridge, s = "lambda.min")
## 6 x 1 sparse Matrix of class "dgCMatrix"
##                       1
## (Intercept)  3.08225218
## Pclass      -0.70311529
## title       -1.95919063
## Embarked    -0.16033817
## FamilySized  0.64243737
## ticket.size -0.04566194
# Ridge Model

# 予測します
PredTrain.F = predict(cvfit.f.ridge, newx=x.f, type="class")

table(cv.train.f$Survived, PredTrain.F, cv.train.f$title)
## , ,  = Master
## 
##      PredTrain.F
##        No Yes
##   No    8   0
##   Yes   8  10
## 
## , ,  = Mr
## 
##      PredTrain.F
##        No Yes
##   No  259   0
##   Yes  52   0
## 
## , ,  = Officer
## 
##      PredTrain.F
##        No Yes
##   No    8   0
##   Yes   3   0

confusionMatrix(cv.train.f$Survived, PredTrain.F)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  275   0
##        Yes  63  10
##                                          
##                Accuracy : 0.819          
##                  95% CI : (0.7744, 0.858)
##     No Information Rate : 0.9713         
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.2006         
##  Mcnemar's Test P-Value : 5.662e-15      
##                                          
##             Sensitivity : 0.8136         
##             Specificity : 1.0000         
##          Pos Pred Value : 1.0000         
##          Neg Pred Value : 0.1370         
##              Prevalence : 0.9713         
##          Detection Rate : 0.7902         
##    Detection Prevalence : 0.7902         
##       Balanced Accuracy : 0.9068         
##                                          
##        'Positive' Class : No             
## 
# Prediction on validation set

PredTest.F = predict(cvfit.f.ridge, newx=data.matrix(cv.test.f[,1:5]), type="class")

table(cv.test.f$Survived, PredTest.F, cv.test.f$title)
## , ,  = Master
## 
##      PredTest.F
##        No Yes
##   No   14   0
##   Yes  10  12
## 
## , ,  = Mr
## 
##      PredTest.F
##        No Yes
##   No  349   0
##   Yes  63   0
## 
## , ,  = Officer
## 
##      PredTest.F
##        No Yes
##   No   11   0
##   Yes   3   0

confusionMatrix(cv.test.f$Survived, PredTest.F)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  374   0
##        Yes  76  12
##                                           
##                Accuracy : 0.8355          
##                  95% CI : (0.7985, 0.8681)
##     No Information Rate : 0.974           
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.2036          
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.8311          
##             Specificity : 1.0000          
##          Pos Pred Value : 1.0000          
##          Neg Pred Value : 0.1364          
##              Prevalence : 0.9740          
##          Detection Rate : 0.8095          
##    Detection Prevalence : 0.8095          
##       Balanced Accuracy : 0.9156          
##                                           
##        'Positive' Class : No              
## 
# Ridge Model
# Prediction on training set

PredTrain.F = predict(cvfit.f.lasso, newx=x.f, type="class")

table(cv.train.f$Survived, PredTrain.F, cv.train.f$title)
## , ,  = Master
## 
##      PredTrain.F
##        No Yes
##   No    8   0
##   Yes   8  10
## 
## , ,  = Mr
## 
##      PredTrain.F
##        No Yes
##   No  259   0
##   Yes  52   0
## 
## , ,  = Officer
## 
##      PredTrain.F
##        No Yes
##   No    8   0
##   Yes   3   0

confusionMatrix(cv.train.f$Survived, PredTrain.F)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  275   0
##        Yes  63  10
##                                          
##                Accuracy : 0.819          
##                  95% CI : (0.7744, 0.858)
##     No Information Rate : 0.9713         
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.2006         
##  Mcnemar's Test P-Value : 5.662e-15      
##                                          
##             Sensitivity : 0.8136         
##             Specificity : 1.0000         
##          Pos Pred Value : 1.0000         
##          Neg Pred Value : 0.1370         
##              Prevalence : 0.9713         
##          Detection Rate : 0.7902         
##    Detection Prevalence : 0.7902         
##       Balanced Accuracy : 0.9068         
##                                          
##        'Positive' Class : No             
## 
# Prediction on validation set

PredTest.F = predict(cvfit.f.lasso, newx=data.matrix(cv.test.f[,1:5]), type="class")

table(cv.test.f$Survived, PredTest.F, cv.test.f$title)
## , ,  = Master
## 
##      PredTest.F
##        No Yes
##   No   14   0
##   Yes  10  12
## 
## , ,  = Mr
## 
##      PredTest.F
##        No Yes
##   No  349   0
##   Yes  63   0
## 
## , ,  = Officer
## 
##      PredTest.F
##        No Yes
##   No   11   0
##   Yes   3   0

confusionMatrix(cv.test.f$Survived, PredTest.F)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  374   0
##        Yes  76  12
##                                           
##                Accuracy : 0.8355          
##                  95% CI : (0.7985, 0.8681)
##     No Information Rate : 0.974           
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.2036          
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.8311          
##             Specificity : 1.0000          
##          Pos Pred Value : 1.0000          
##          Neg Pred Value : 0.1364          
##              Prevalence : 0.9740          
##          Detection Rate : 0.8095          
##    Detection Prevalence : 0.8095          
##       Balanced Accuracy : 0.9156          
##                                           
##        'Positive' Class : No              
## 
# Prediction on test set

PredTest.F = predict(cvfit.f.ridge, newx=data.matrix(test.female[,1:5]), type="class")

table(PredTest.F, test.female$title)
##           
## PredTest.F Miss Mrs
##        No    28  25
##        Yes   10   0

MySubmission.F<-cbind(cv.train.m$Survived, PredTrain.M)
MySubmission.M<-cbind(cv.train.f$Survived, PredTrain.F)
MySubmission<-rbind(MySubmission.M,MySubmission.F)
colnames(MySubmission) <- c('Actual_Survived', 'predict')
MySubmission<- as.data.frame(MySubmission)

confusionMatrix(MySubmission$Actual_Survived, MySubmission$predict)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  556   0
##        Yes 126  13
##                                          
##                Accuracy : 0.8187         
##                  95% CI : (0.788, 0.8467)
##     No Information Rate : 0.9813         
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.1417         
##  Mcnemar's Test P-Value : <2e-16         
##                                          
##             Sensitivity : 0.81525        
##             Specificity : 1.00000        
##          Pos Pred Value : 1.00000        
##          Neg Pred Value : 0.09353        
##              Prevalence : 0.98129        
##          Detection Rate : 0.80000        
##    Detection Prevalence : 0.80000        
##       Balanced Accuracy : 0.90762        
##                                          
##        'Positive' Class : No             
## 

SVM(線形SVM)

R
###コストパラメタの調整
set.seed(1274)
liner.tune=tune.svm(Survived~.,data=train_val1,kernel="linear",cost=c(0.01,0.1,0.2,0.5,0.7,1,2,3,5,10,15,20,50,100))

liner.tune
## 
## Parameter tuning of 'svm':
## 
## - sampling method: 10-fold cross validation 
## 
## - best parameters:
##  cost
##     3
## 
## - best performance: 0.1736502
###cost=3のとき、精度は82.7でベストパフォーマンスです。

###線形モデルをモデリングします
best.linear=liner.tune$best.model

##テストデータで検証します。
best.test=predict(best.linear,newdata=test_val1,type="class")

confusionMatrix(best.test,test_val1$Survived)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 97 21
##          1 12 47
##                                           
##                Accuracy : 0.8136          
##                  95% CI : (0.7483, 0.8681)
##     No Information Rate : 0.6158          
##     P-Value [Acc > NIR] : 1.058e-08       
##                                           
##                   Kappa : 0.5959          
##  Mcnemar's Test P-Value : 0.1637          
##                                           
##             Sensitivity : 0.8899          
##             Specificity : 0.6912          
##          Pos Pred Value : 0.8220          
##          Neg Pred Value : 0.7966          
##              Prevalence : 0.6158          
##          Detection Rate : 0.5480          
##    Detection Prevalence : 0.6667          
##       Balanced Accuracy : 0.7905          
##                                           
##        'Positive' Class : 0               
## 
###Linear model accuracy is 0.8136

XGBoost

R
library(xgboost)
library(MLmetrics)

train <- read_csv('../input/train.csv')
test  <- read_csv('../input/test.csv')

train$set <- "train"
test$set  <- "test"
test$Survived <- NA
full <- rbind(train, test)

full <- full %>%
    mutate(
      Age = ifelse(is.na(Age), mean(full$Age, na.rm=TRUE), Age),
      `Age Group` = case_when(Age < 13 ~ "Age.0012", 
                                 Age >= 13 & Age < 18 ~ "Age.1317",
                                 Age >= 18 & Age < 60 ~ "Age.1859",
                                 Age >= 60 ~ "Age.60Ov"))

full$Embarked <- replace(full$Embarked, which(is.na(full$Embarked)), 'S')

full <- full %>%
  mutate(Title = as.factor(str_sub(Name, str_locate(Name, ",")[, 1] + 2, str_locate(Name, "\\.")[, 1]- 1)))

full <- full %>%
  mutate(`Family Size`  = as.numeric(SibSp) + as.numeric(Parch) + 1,
         `Family Group` = case_when(
           `Family Size`==1 ~ "single",
           `Family Size`>1 & `Family Size` <=3 ~ "small",
           `Family Size`>= 4 ~ "large"
         ))

full <- full %>%
    mutate(Survived = case_when(Survived==1 ~ "Yes", 
                                Survived==0 ~ "No"))

full_2 <- full %>% 
  select(-Name, -Ticket, -Cabin, -set) %>%
  mutate(
    Survived = ifelse(Survived=="Yes", 1, 0)
  ) %>% 
  rename(AgeGroup=`Age Group`, FamilySize=`Family Size`, FamilyGroup=`Family Group`)


# OHE
ohe_cols <- c("Pclass", "Sex", "Embarked", "Title", "AgeGroup", "FamilyGroup")
num_cols <- setdiff(colnames(full_2), ohe_cols)

full_final <- subset(full_2, select=num_cols)

for(var in ohe_cols) {
  values <- unique(full_2[[var]])

  for(j in 1:length(values)) {
    full_final[[paste0(var,"_",values[j])]] <- (full_2[[var]] == values[j]) * 1
  }
}

submission <- TRUE

data_train <- full_final %>%
    filter(!is.na(Survived)) 

data_test  <- full_final %>% 
    filter(is.na(Survived))

set.seed(777)
ids <- sample(nrow(data_train))

# create folds for cv
n_folds <- ifelse(submission, 1, 5)
score <- data.table()
result <- data.table()

for(i in 1:n_folds) {
  if(submission) {
    x_train <- data_train %>% select(-PassengerId, -Survived)
    x_test  <- data_test %>% select(-PassengerId, -Survived)
    y_train <- data_train$Survived
  } else {
    train.ids <- ids[-seq(i, length(ids), by=n_folds)]
    test.ids  <- ids[seq(i, length(ids), by=n_folds)]

    x_train <- data_train %>% select(-PassengerId, -Survived)
    x_train <- x_train[train.ids,]

    x_test  <- data_train %>% select(-PassengerId, -Survived)
    x_test  <- x_test[test.ids,]

    y_train <- data_train$Survived[train.ids]
    y_test  <- data_train$Survived[test.ids]
  }

  x_train <- apply(x_train, 2, as.numeric)
  x_test <- apply(x_test, 2, as.numeric)

  if(submission) {
    nrounds <- 12
    early_stopping_round <- NULL
    dtrain <- xgb.DMatrix(data=as.matrix(x_train), label=y_train)
    dtest <- xgb.DMatrix(data=as.matrix(x_test))
    watchlist <- list(train=dtrain)
  } else {
    nrounds <- 3000
    early_stopping_round <- 100
    dtrain <- xgb.DMatrix(data=as.matrix(x_train), label=y_train)
    dtest <- xgb.DMatrix(data=as.matrix(x_test), label=y_test)
    watchlist <- list(train=dtrain, test=dtest)
  }

  params <- list("eta"=0.01,
                 "max_depth"=8,
                 "colsample_bytree"=0.3528,
                 "min_child_weight"=1,
                 "subsample"=1,
                 "objective"="reg:logistic",
                 "eval_metric"="auc")

  model_xgb <- xgb.train(params=params,
                         data=dtrain,
                         maximize=TRUE,
                         nrounds=nrounds,
                         watchlist=watchlist,
                         early_stopping_round=early_stopping_round,
                         print_every_n=2)

  pred <- predict(model_xgb, dtest)

  if(submission) {
    result <- cbind(data_test %>% select(PassengerId), Survived=round(pred, 0))
  } else {
    score <- rbind(score, 
                   data.frame(accuracy=Accuracy(round(pred, 0), y_test), best_iteration=model_xgb$best_iteration))
    temp   <- cbind(data_train[test.ids,], pred=pred)
    result <- rbind(result, temp)
  }
}

## [1]  train-auc:0.895887 
## [3]  train-auc:0.903410 
## [5]  train-auc:0.911064 
## [7]  train-auc:0.915367 
## [9]  train-auc:0.915924 
## [11] train-auc:0.914211 
## [12] train-auc:0.914563

head(result)
##   PassengerId Survived
## 1         892        0
## 2         893        0
## 3         894        0
## 4         895        0
## 5         896        1
## 6         897        0

SVM(非線形SVM)

R
######非線形SVMでモデリングします
set.seed(1274)
rd.poly=tune.svm(Survived~.,data=train_val1,kernel="radial",gamma=seq(0.1,5))

summary(rd.poly)
## 
## Parameter tuning of 'svm':
## 
## - sampling method: 10-fold cross validation 
## 
## - best parameters:
##  gamma
##    2.1
## 
## - best performance: 0.166608 
## 
## - Detailed performance results:
##   gamma     error dispersion
## 1   0.1 0.1680164 0.04245604
## 2   1.1 0.1680164 0.03983673
## 3   2.1 0.1666080 0.04166448
## 4   3.1 0.1666080 0.04166448
## 5   4.1 0.1666080 0.04166448

best.rd=rd.poly$best.model

###非線形kernelのSVMは良い精度ですね
pre.rd=predict(best.rd,newdata = test_val1)

confusionMatrix(pre.rd,test_val1$Survived)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 97 20
##          1 12 48
##                                           
##                Accuracy : 0.8192          
##                  95% CI : (0.7545, 0.8729)
##     No Information Rate : 0.6158          
##     P-Value [Acc > NIR] : 3.784e-09       
##                                           
##                   Kappa : 0.6093          
##  Mcnemar's Test P-Value : 0.2159          
##                                           
##             Sensitivity : 0.8899          
##             Specificity : 0.7059          
##          Pos Pred Value : 0.8291          
##          Neg Pred Value : 0.8000          
##              Prevalence : 0.6158          
##          Detection Rate : 0.5480          
##    Detection Prevalence : 0.6610          
##       Balanced Accuracy : 0.7979          
##                                           
##        'Positive' Class : 0               
## 
####Accurcay of test data using Non Liner model is 0.81
####これは、データをテストするためにサンプルより小さなセットを使用していることが原因である可能性があります

ロジステック回帰

R
contrasts(train_val1$Sex)
##        male
## female    0
## male      1

contrasts(train_val1$Pclass)
##   2 3
## 1 0 0
## 2 1 0
## 3 0 1
##The above shows how the varible coded among themself

##Lets run Logistic regression model
log.mod <- glm(Survived ~ ., family = binomial(link=logit), 
               data = train_val1)

###Check the summary
summary(log.mod)
## 
## Call:
## glm(formula = Survived ~ ., family = binomial(link = logit), 
##     data = train_val1)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.4187  -0.5944  -0.3937   0.5805   3.0414  
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        16.8752   624.0921   0.027 0.978428    
## Pclass2            -1.1968     0.3129  -3.824 0.000131 ***
## Pclass3            -2.1324     0.2721  -7.838 4.58e-15 ***
## titleMiss         -16.1021   624.0921  -0.026 0.979416    
## titleMr            -3.7422     0.5216  -7.175 7.24e-13 ***
## titleMrs          -16.0186   624.0921  -0.026 0.979523    
## titleOfficer       -4.3752     0.8595  -5.090 3.58e-07 ***
## Sexmale           -15.6157   624.0919  -0.025 0.980038    
## ticket.sizeSingle   2.0968     0.4082   5.137 2.79e-07 ***
## ticket.sizeSmall    2.0356     0.3870   5.260 1.44e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 950.86  on 713  degrees of freedom
## Residual deviance: 589.82  on 704  degrees of freedom
## AIC: 609.82
## 
## Number of Fisher Scoring iterations: 13

confint(log.mod)
##                        2.5 %     97.5 %
## (Intercept)       -80.363813         NA
## Pclass2            -1.821261 -0.5924824
## Pclass3            -2.676712 -1.6082641
## titleMiss                 NA 81.1580568
## titleMr            -4.806899 -2.7544131
## titleMrs                  NA 81.2072009
## titleOfficer       -6.200669 -2.7777761
## Sexmale                   NA 81.9299127
## ticket.sizeSingle   1.318753  2.9224495
## ticket.sizeSmall    1.294852  2.8160324
###Predict train data

train.probs <- predict(log.mod, data=train_val1,type =  "response")
table(train_val1$Survived,train.probs>0.5)
##    
##     FALSE TRUE
##   0   395   45
##   1    70  204

(395+204)/(395+204+70+45)
## [1] 0.8389356
###Logistic regression predicted train data with accuracy rate of 0.83 

test.probs <- predict(log.mod, newdata=test_val1,type =  "response")
table(test_val1$Survived,test.probs>0.5)
##    
##     FALSE TRUE
##   0    97   12
##   1    21   47
(97+47)/(97+12+21+47)
## [1] 0.8135593
###Accuracy rate of test data is 0.8135

2.8 機械学習アルゴリズムの評価

  • ランダムフォレストの精度 - 84.03%
  • 決定木の精度 - 83.75%
  • 非線形SVMの精度 - 81.92%
  • ラッソ-リッジ回帰の精度 - 81.90%
  • 線形SVMの精度 - 81.36%
  • ロジステック回帰の精度 - 81.36%

マーク - Oh Gowd、ランダムフォレストは84.03%の精度ですね。
ジェームズ - はい!
マーク - ありがとうございました。

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