12章 forcatsでファクタ

12.0 ライブラリの読み込み

library("tidyverse")
library("gridExtra")
library("stringr")

12.1 はじめに

練習問題はありません

12.2 ファクタを作る

練習問題はありません

12.3 総合的社会調査

練習問題1 rincome(報告所得)の分布を調べなさい。デフォルトの棒グラフを理解するのが難しい理由も答えなさい。

デフォルト設定でgeom_bar()を使うと、ラベルが重なってしまい、なんのカテゴリかわかりません。

ggplot(gss_cat, aes(rincome)) +
  geom_bar()

このような場合はラベルを回転させると、テキストが見やすくなります。

ggplot(gss_cat, aes(rincome)) +
  geom_bar() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

棒グラフにカウント数を表示させたい場合はgeom_text()を使います。テキストの位置は、vjustでも座標を指定してもどちらでもよいかと思います。カテゴリで色分けして、棒グラフを作る場合は、座標位置を指定したほうが柔軟かもしれません。

ggplot(gss_cat %>% count(rincome), aes(rincome , n, label = n)) +
  geom_bar(stat = "identity") +
  geom_text(aes(rincome , n + 200)) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

# ggplot(gss_cat %>% count(rincome), aes(rincome, n, label = n)) +
#   geom_bar(stat = "identity") +
#   geom_text(aes(rincome, n, vjust = -0.1), size = 2)+
#   theme(axis.text.x = element_text(angle = 45, hjust = 1))

もう少し改善するためにfct_recode()を使います。この関数は、カテゴリの値を修正することができます。ここでは、"Lt $1000"を"Less than $1000"に変更しています。また、ラベル名が長いので、見やすくするために座標を回転させています。

gss_cat %>%
  filter(!rincome %in% c("Not applicable")) %>%
  mutate(rincome = fct_recode(rincome,
                              "Less than $1000" = "Lt $1000")) %>%
  mutate(flg = rincome %in% c("Refused", "Don't know", "No answer")) %>%
  ggplot(aes(x = rincome, fill = flg)) +
  geom_bar() +
  coord_flip() +
  scale_y_continuous("Number of Respondents", labels = scales::comma) +
  scale_x_discrete("Respondent's Income") +
  scale_fill_manual(values = c("FALSE" = "#006E4F", "TRUE" = "gray")) + 
  theme_bw()

練習問題2 総合的社会調査で最も多いrelig、partyidは何か。

religはProtestantで、partyidはIndependentが最も多いようです。

gss_cat %>%
  count(relig) %>%
  arrange(desc(n))

# A tibble: 15 x 2
   relig                       n
   <fct>                   <int>
 1 Protestant              10846
 2 Catholic                 5124
 3 None                     3523
 4 Christian                 689
 5 Jewish                    388
 6 Other                     224
 7 Buddhism                  147
 8 Inter-nondenominational   109
 9 Moslem/islam              104
10 Orthodox-christian         95
11 No answer                  93
12 Hinduism                   71
13 Other eastern              32
14 Native american            23
15 Don't know                 15

gss_cat %>%
  count(partyid) %>%
  arrange(desc(n))

# A tibble: 10 x 2
   partyid                n
   <fct>              <int>
 1 Independent         4119
 2 Not str democrat    3690
 3 Strong democrat     3490
 4 Not str republican  3032
 5 Ind,near dem        2499
 6 Strong republican   2314
 7 Ind,near rep        1791
 8 Other party          393
 9 No answer            154
10 Don't know             1

fct_infreqやfct_revを使うことで簡単にファクタの水準を操作することが可能です。

p1 <- gss_cat %>% 
  ggplot(., aes(partyid %>% fct_infreq)) + geom_bar() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

p2 <- gss_cat %>% 
  ggplot(., aes(partyid %>% fct_infreq %>% fct_rev)) + geom_bar() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

grid.arrange(p1, p2, ncol = 2, nrow = 1)

練習問題3 どのreligにdenomが適用されるのか。表からどうやって見つけるか？どう視覚化するべきか？

文脈からdenomは、「プロテスタント」を指すことは明らかです

levels(gss_cat$denom)
 [1] "No answer"            "Don't know"          
 [3] "No denomination"      "Other"               
 [5] "Episcopal"            "Presbyterian-dk wh"  
 [7] "Presbyterian, merged" "Other presbyterian"  
 [9] "United pres ch in us" "Presbyterian c in us"
[11] "Lutheran-dk which"    "Evangelical luth"    
[13] "Other lutheran"       "Wi evan luth synod"  
[15] "Lutheran-mo synod"    "Luth ch in america"  
[17] "Am lutheran"          "Methodist-dk which"  
[19] "Other methodist"      "United methodist"    
[21] "Afr meth ep zion"     "Afr meth episcopal"  
[23] "Baptist-dk which"     "Other baptists"      
[25] "Southern baptist"     "Nat bapt conv usa"   
[27] "Nat bapt conv of am"  "Am bapt ch in usa"   
[29] "Am baptist asso"      "Not applicable"     

視覚化するのであれば、カテゴリの散布図でよいと思います。

gss_cat %>%
  count(relig, denom) %>%
  ggplot(aes(x = relig, y = denom, size = n)) +
  geom_point() +
  theme(axis.text.x = element_text(angle = 90))

12.4 ファクタの順序の変更

練習問題1 tvhoursの高い値は疑わしい。平均は適切なのか。

視覚化してみると、確かに10時間を超えるtv視聴時間があります。

gss_cat %>%
  filter(!is.na(tvhours)) %>%
  ggplot(aes(x = tvhours)) +
  geom_histogram(bins = gss_cat %>% 
                   filter(!is.na(tvhours)) %>% 
                   distinct(tvhours) %>% 
                   pull() %>% 
                   length())

このような場合、平均は外れ値に引っ張らてしまうため、中央値のほうが望ましいかもしれません。

m <- mean(gss_cat$tvhours, na.rm = TRUE)
md <- median(gss_cat$tvhours, na.rm = TRUE)

gss_cat %>%
  filter(!is.na(tvhours)) %>%
  ggplot(., aes(x = tvhours)) +
  geom_histogram(bins = gss_cat %>% 
                   filter(!is.na(tvhours)) %>% 
                   distinct(tvhours) %>% 
                   pull() %>% 
                   length()) +
  geom_vline(xintercept = m, col = "red") + 
  geom_vline(xintercept = md, col = "blue") 

練習問題2 gss_catの各ファクタについて、水準の順序が定まっているか調べなさい。

このデータセットには6個のファクタ型のカラムが存在しています。ここでは、levels()を使えば、水準を確認できますが、ここでは一気に視覚化して、内容を確認します。このプロットを見る限り、raceはカウント数で順序付けられており、rincomeは値の順番で順序付けられています。

x <- gss_cat %>% 
  keep(is.factor) %>% 
  names() %>%
  as.list()
            
plots <- x %>% 
  map( ~ ggplot(data = gss_cat) + 
         geom_bar(aes_string(x = .x)) + ylab(.x)+ 
         coord_flip()) 

grid.arrange(plots[[1]], plots[[2]], plots[[3]],
             plots[[4]], plots[[5]], plots[[6]], 
             ncol = 3, nrow = 2)

練習問題3 Not applicableをレベルの前に移動し、プロットの最下段に移動したのはなぜか。

質問の意図がいまいちよくわかっていません。書籍の中では下記のコードを利用し、"Not applicable"を最下層に配置しています。

gss_cat %>% 
  group_by(rincome) %>% 
  summarise(age = mean(age, na.rm = TRUE)) %>% 
  mutate(rincome = fct_relevel(rincome, "Not applicable")) %>% 
  ggplot(., aes(rincome, age)) + 
  geom_point() +
  coord_flip()

fct_relevel()自体は、指定したレベル順で水準を並び替えます。

mon <- paste0(1:12, "月")
factor(mon, levels = mon)
 [1] 1月  2月  3月  4月  5月  6月  7月  8月  9月  10月 11月 12月
Levels: 1月 2月 3月 4月 5月 6月 7月 8月 9月 10月 11月 12月

fct_relevel(mon, paste0(12:1, "月"))
 [1] 1月  2月  3月  4月  5月  6月  7月  8月  9月  10月 11月 12月
Levels: 12月 11月 10月 9月 8月 7月 6月 5月 4月 3月 2月 1月

12.5 ファクタの水準の変更

練習問題1 民主党員、共和党員、および独立党員として分類される人々の割合は、時間経過とともにどのように変化したか？

まずpartyidの内容が細かいので、指定されている粒度に変換します。fct_collapse()でカテゴリを丸めることが可能です。あとは年別に、割合を求めてプロットすれば推移が確認できます。

gss_cat %>%
  select(partyid, year) %>% 
  mutate(partyid =
      fct_collapse(partyid,
                   Other = c("No answer", "Don't know", "Other party"),
                   Republican = c("Strong republican", "Not str republican"),
                   Independent = c("Ind,near rep", "Independent", "Ind,near dem"),
                   Democrat = c("Not str democrat", "Strong democrat"))) %>%
  count(year, partyid) %>%
  group_by(year) %>%
  mutate(ratio = n / sum(n)) %>%
  ggplot(aes(year, ratio, col = fct_reorder2(partyid, year, ratio))) +
  geom_line() +
  labs(colour = "Party") + 
  theme_bw()

練習問題2 rincomeをより少数のカテゴリにまとめるにはどうすればよいか。

fct_collapse()とstr_c()を組み合わせることで、カテゴリを効率的に丸めることができます。ここでは5000単位で丸めます。

gss_cat %>%
  mutate(rincome =
      fct_collapse(rincome,
        `Unknown` = c("No answer", "Don't know", "Refused", "Not applicable"),
        `Lt $5000` = c("Lt $1000", str_c("$", c("1000", "3000", "4000"), " to ", c("2999", "3999", "4999"))),
        `$5000 to 10000` = str_c("$", c("5000", "6000", "7000", "8000"), " to ", c("5999", "6999", "7999", "9999")))) %>%
  ggplot(aes(x = rincome)) +
  geom_bar() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))