Rで何かをしたり、読書をするブログ

政府統計の総合窓口のデータや、OECDやUCIやのデータを使って、Rの練習をしています。ときどき、読書記録も載せています。

UCI Machine Learning Repository の Bank Marketing のデータの分析3 - 各変数の yes の比率を調べて、カテゴリカル変数を数値変数に変換②

(Bing Image Creator で生成: プロンプト: Close up of Pink Cornus Florida flowers, background is white mountains, photo)

 

www.crosshyou.info

の続きです。残りの変数も調べていきます。

contact についてです。固定電話で話したか、携帯電話で話したか、です。

携帯電話が 65% で、不明が 29% です。不明の場合は yes の比率が低いですね。

これも数値データに変換してしまいます。

yes との相関係数は 0.148 でした。

次は、day です。日付です。

1日から31日までありますので、31のヒストグラムを描きました。yes との 相関は -0.028 となっていますので、月の前半(後半)のほうが yes が多い、ということはないようです。

次は month です。

3月にかけた電話は yes の比率が 52% と高いですが、5月の電話は 6.7% と低く、月によって差があるようです。これを数値データにします。

yes との相関係数は 0.204 です。

次の duration ですが、UCI のサイトの説明によると、これは削除したほうがいいようですので、削除します。

次は campaign です。この電話マーケティングのキャンペーン中にコンタクトした回数です。

最大値が 63 です。63回も電話したということですね。驚きです。

yes との相関係数は -0.0732 です。あまり関係ない、ということですね。

次は、pdays です。前回のキャンペーンからどのくらい日数がたっているかを示しています。-1 は今までキャンペーンの電話がなかったことを意味します。

ほとんどが -1 ですね。なので、pdays は -1 なら 0 でそれ以外なら 1 のダミー変数にしてしまいます。

次は、previous です。これは、以前のキャンペーンでコンタクトのあった回数です。

最大が 275 回というのは驚きですね。3rd Qu. が 0 なので、大半が 0 ですね。なので、= 0 なら 0, それ以外なら 1 のダミー変数にしてしまいます。

最後は poutcome です。これは前回のキャンペーンでの結果です。

前回のキャンペーンで success だった人は yes の比率が 65% ぐらいと高いですね。ただその割合は 3% しかデータセットにはありません。

poutcome を unkonw = 1, success = 4 のように数値型の変数に変換します。

yes との相関係数は 0.259 でした。

ここでいったん、summary() 関数で df を確認しておきましょう。

変数をダミー変数、純粋な数値変数、カテゴリカル変数を数値変数に変換したもの、という区分でわけると、

ダミー変数は、yes, default, housing, loan, pdays, previous です。

純粋な数値変数は、age, balance, day, campaign です。

カテゴリカル変数を数値変数に変換したものは、

job, marital, education, contact, month, poutcome です。

今回は以上です。

次回は

www.crosshyou.info

です。

 

初めから読むには、

www.crosshyou.info

です。

今回のコードは以下になります。

#
# contact について
df |> 
  count(contact) |> 
  mutate(prop = n / sum(n)) |> 
  arrange(desc(n))
df |> 
  group_by(contact) |> 
  summarize(average = mean(yes)) |> 
  arrange(average)
#
# contact を unknown = 1, telephone = 2, celliar = 3 にする
df <- df |> 
  mutate(contact = case_when(
    contact == "unknown" ~ 1,
    contact == "telephone" ~ 2,
    contact == "cellular" ~ 3
  ))
df |> 
  summarize(correlation = cor(yes, contact))
#
# day について
df |> 
  ggplot(aes(x = day, fill = factor(yes))) +
  geom_histogram(bins = 31)
df |> 
  summarize(correlation = cor(yes, day))
#
# month について
df |> 
  count(month) |> 
  mutate(prop = n / sum(n)) |> 
  arrange(desc(n))
df |> 
  group_by(month) |> 
  summarize(average = mean(yes)) |> 
  arrange(average)
#
# may = 1, mar = 12 にする
df <- df |> 
  mutate(month = case_when(
    month == "may" ~ 1,
    month == "jul" ~ 2,
    month == "jan" ~ 3,
    month == "nov" ~ 4,
    month == "jun" ~ 5,
    month == "aug" ~ 6,
    month == "feb" ~ 7,
    month == "apr" ~ 8,
    month == "oct" ~ 9,
    month == "sep" ~ 10,
    month == "dec" ~ 11,
    month == "mar" ~ 12
  ))
df |> 
  summarize(correlation = cor(yes, month))
#
# duration を削除
df <- df |> 
  select(-duration)
#
# campaign について
summary(df$campaign)
df |> 
  ggplot(aes(x = campaign, fill = factor(yes))) +
  geom_histogram()
df |> 
  summarize(correlation = cor(yes, campaign))
#
# pdays について
summary(df$pdays)
df |> 
  ggplot(aes(x = pdays, fill = factor(yes))) +
  geom_histogram()
df |> 
  summarize(correlation = cor(yes, pdays))
#
# pdays を = -1 なら 0, != -1 なら 1 のダミー変数にする
df <- df |> 
  mutate(pdays = if_else(pdays == -1, 0, 1))
#
# previous について
summary(df$previous)
df |> 
  ggplot(aes(x = previous, fill = factor(yes))) +
  geom_histogram()
df |> 
  summarize(correlation = cor(yes, previous))
#
# previous == 0 なら 0, それ以外なら 1 のダミー変数にする
df <- df |> 
  mutate(previous = if_else(previous == 0, 0, 1))
#
# poutcome について
df |> 
  count(poutcome) |> 
  mutate(prop = n / sum(n)) |> 
  arrange(n)
df |> 
  group_by(poutcome) |> 
  summarize(average = mean(yes)) |> 
  arrange(average)
#
# unknown = 1, success = 4 にする
df <- df |> 
  mutate(poutcome = case_when(
    poutcome == "unknown" ~ 1,
    poutcome == "failure" ~ 2,
    poutcome == "other" ~ 3,
    poutcome == "success" ~ 4
  ))
df |> 
  summarize(correlation = cor(yes, poutcome))
#
# df のサマリー
summary(df)
#