TOYBOX

データサイエンティストのおもちゃ箱

「Google流資料作成術」のイケてる「散布図」を「R」で再現してみた

はじめに

先日より「Google流資料作成術」を読み進めています。タイトルが如何にもといった感じで敬遠していたのですが、実際に読んでみると、ストーリーの一部としてデータを伝えるための可視化のポイントや例が盛り沢山でかなりの良書だと感じました。いずれ可視化の考え方などもまとめてみたいなと思います。(原書のタイトルは「storytelling with data」らしいので個人的にはそっちの方が分かりやすくて良かったのになと、、、)

さて、ここでは「Google流資料作成術」の良い感じのグラフをR(ggplot)で再現してみることにします。手始めに可視化の基本的な例として取り上げられることの多い散布図からいってみましょう。実務で使うことも考慮して、ggplotの図を重ね合わせるという特性を活かした以下のようなプロセスを意識して作成していきます。

  1. ベースとなるプロットを作成

  2. アンハイライト

  3. 強調したいポイントをハイライト&ラベル付け

  4. 体裁を整える

ライブラリの読み込み&可視化用設定

先に可視化用の設定を済ませておきましょう。日本語フォントの表示で少し沼ってしまったのですが、こちらの記事が非常に参考になりました。ggplotの日本語表示で悩まれている方はご一読を進めます。

# ライブラリの読み込み
if (!require("pacman")) install.packages("pacman"); library(pacman)
p_load(tidyverse)
p_load(gt)
p_load(gghighlight)
p_load(ggrepel)
p_load(ggthemes)
p_load(datapasta)

# 日本語フォントの設定
p_load(systemfonts)
p_load_gh("Gedevan-Aleksizde/fontregisterer")
fontregisterer::get_standard_ja_fonts()
theme_set(theme_classic(base_family = "Hiragino Sans"))
update_geom_defaults("text", list(family = theme_get()$text$family))
update_geom_defaults("label", list(family = theme_get()$text$family))
update_geom_defaults("text_repel", list(family = theme_get()$text$family))
update_geom_defaults("label_repel", list(family = theme_get()$text$family))

# 文字列を縦書きに変換
tategaki <- function(x){
  x %>% 
    str_replace_all("ー", "丨") %>% 
    str_wrap(width = 1)
}

# カラーパレット
my_gray = "#c0c0c0"
my_red = "#dc3923"
my_green = "#109618"
my_blue = "#3366cc"
my_orange = "#ff9900"
my_lightblue = "#0099c6"
my_pink = "#dd4477"

散布図

設定が終わったところで早速散布図を作成していきましょう。散布図は2種類のデータの対応関係を直感的に把握する際に有効な可視化の方法です。縦軸、横軸にそれぞれの目盛りをとり、対応するデータを点としてプロットします。

まずはデータを用意します。

# データ
raw_dat <- tibble::tribble(
  ~Miles.Driven, ~Cost.Per.Mile,
           1100,        "$2.40",
           1177,        "$2.80",
           1239,        "$2.20",
           1294,        "$2.50",
           1378,        "$1.90",
           1481,        "$2.00",
           1540,        "$2.20",
           1712,        "$1.35",
           1650,        "$2.00",
           1817,        "$1.30",
           1971,        "$1.20",
           1984,        "$1.10",
           2135,        "$1.35",
           2211,        "$1.30",
           2225,        "$1.30",
           2200,        "$1.20",
           2256,        "$1.10",
           2311,        "$1.20",
           2180,        "$1.20",
           2463,        "$1.40",
           2465,        "$1.20",
           1850,        "$1.20",
           2581,        "$1.10",
           2618,        "$0.80",
           2627,        "$1.10",
           2750,        "$1.00",
           2837,        "$1.32",
           3061,        "$1.25",
           3111,        "$1.12",
           3001,        "$1.00",
           3201,        "$1.34",
           3395,        "$1.65",
           3456,        "$2.20",
           3498,        "$1.80",
           3564,        "$1.90",
           3757,        "$1.70"
  )

次にプロット用にデータを前処理します。

# プロット用のデータ
dat_plot <- 
  raw_dat %>% 
  rename(x = "Miles.Driven", y = "Cost.Per.Mile") %>% 
  mutate(y = parse_number(y))

このデータをもとにベースとなるプロットを作成します。

# ベースとなるプロット
p1 <- 
  dat_plot %>% 
  ggplot() + # 可視化をスタート
  aes(x = x, y = y) + # キャンパスを用意
  geom_point() # 散布図を描く

p1

f:id:y_sako:20210223160533p:plain

ここで、強調したい部分を目立たせるために全体をアンハイライトしておきます。

# グレーアウトする
p2 <- 
  p1 + 
  geom_point(color = my_gray) + 
  theme_unhilighted()

p2

f:id:y_sako:20210223161917p:plain

平均の情報を追加します。

# 平均を計算しておく
dat_mean <-
  dat_plot %>% 
  summarise(x_mean = mean(x),
            y_mean = mean(y))

# 平均の情報を追加
p3 <-
  p2 + 
  # 平均点を追加
  geom_point(dat_mean, mapping = aes(x = x_mean, y = y_mean), size = 3) +
  # 平均のラベルを追加
  geom_text_repel(dat_mean, mapping = aes(x = x_mean, y = y_mean, label = "平均"),segment.color = "white") +
  # 平均線を追加
  geom_hline(yintercept = dat_mean$y_mean, linetype = "dashed")

p3

f:id:y_sako:20210223162116p:plain

さらに、yが平均より大きい値をハイライトして強調します。

# yが平均より大きい値
dat_highlight <- 
  dat_plot %>% 
  filter(y > dat_mean$y_mean)

# ハイライト
p4 <- 
  p3 + 
  geom_point(dat_highlight, mapping = aes(x = x, y = y), color = "orange")

p4

f:id:y_sako:20210223162247p:plain

最後にプロット全体の体裁を整えて完成です。

# 体裁を整えて完成
p5 <- 
  p4 + 
  # タイトル
  ggtitle("走行距離によるマイルあたりのコスト") +
  theme(plot.title = element_text(hjust = 0.5, face = "bold")) +
  # x軸
  xlab("1か月あたりの走行距離") + 
  scale_x_continuous(breaks = seq(0, 4000, by = 1000), limits = c(0,4100), expand = c(0,0)) +
  # y軸
  ylab(tategaki("1マイルあたりのコスト")) + 
  theme(axis.title.y = element_text(angle = 0, vjust= 0.5)) + 
  scale_y_continuous(breaks = seq(0, 3, by = 0.5), 
                     labels = paste0("$", sprintf("%3.2f", seq(0, 3, by = 0.5))),
                     limits = c(0,3), 
                     expand = c(0, 0))

p5

f:id:y_sako:20210223162349p:plain