シンプソンパラドックスの可視化を3手法で【Excel／BI／R】

この記事は『CRESCO Advent Calendar 2018』24日目の記事です。

こんにちは。データアナリティクスチームの飯村北海です。

昨年に引き続き[PR]データ分析やっていますと言いながらも、Tableauを使用したダッシュボード開発のプロジェクトに参画しています。
が、Rを使った分析プロジェクトも少しずつ増えてきています。なので今回はR＋αの話でブログを書きたいと思います。

本当はTableau＋Rによる記事を描きたかったのですが、どうやらRにデータを渡すためには一度SUMなどの集約関数を使用しないといけないようなので、ちょっと当初の目論見から外れてしまったため、今回の記事はちょっと趣向を変えていくつか出ているBIツール等との比較記事を書いてみました。

シンプソンのパラドックス

本題の前に、突然ですが、「シンプソンのパラドックス」についてご存知でしょうか？

私自身、このキーワードを最近知った（参考文献.1）のですが、Wikipedia：シンプソンのパラドックス（2018年12月中旬の本記事執筆時）によると、

母集団での相関と、母集団を分割した集団での相関は、異なっている場合がある。つまり集団を2つに分けた場合にある仮説が成立しても、集団全体では正反対の仮説が成立することがある。

とのことです。

西内（2013）の「統計学が最強の学問である」の書籍の中でもこういった言及があります。

A校とB校の同じ学年の生徒に対して同じ模擬試験を受験させた。
男子生徒同士で比べるとA校の平均点はB校よりも5点高い。
女子生徒同士で比べるとA校の平均点はB校よりも5点高い。
A校とB校の平均点を全体で比較するとB校の平均点はA校よりも4点高かった。

※本書の中では層別解析でパラドックスは防げるものの、層の観点が増えてしまうと大変であるということで重回帰分析を勧めています。

シンプソンのパラドックスを回避する策等については本記事では言及はしませんが、つまるところ、「データの解釈をする際に、切り取る視点によって全く逆のことが言えてしまうことがある」ということのようです。

とはいえ、シンプソンのパラドックスを言葉で説明されても、漠然としているのではないでしょうか。ということで、実際にグラフを描いて確認してみたいと思います。また、今回はいくつかの手段で可視化を試みたいと思います。

可視化に使用するデータ

こちらです（最初の10件のみ表示しています）。表にするとこのような形になります。

NO	学校	性別	得点
1	A校	男性	45
2	A校	男性	63
3	A校	男性	55
4	A校	男性	68
5	A校	男性	60
6	A校	男性	66
7	A校	男性	64
8	A校	男性	71
9	A校	男性	46
10	A校	男性	56

学校列はA校/B校、性別列は男性/女性、得点列は100点満点のデータです。

これらは前述の西内（2013）の数字になるように下記のRで乱数を発生させています。微妙に端数が合わず、全体の平均がそろわなかったので、その後意図的にデータを手で調整しています。あまりスマートではなくスミマセン。

library(dplyr)
library(tibble)

# 平均値、分散を指定していい感じに作る
a_male <- round(rnorm(n = 160, mean = 60, sd = 10), 0)
a_female <- round(rnorm(n =  40, mean = 75, sd = 10), 0)
b_male <- round(rnorm(n =  40, mean = 55, sd = 10), 0)
b_female <- round(rnorm(n = 160, mean = 70, sd = 10), 0)

# その後、四捨五入しているので結局、微調整を手でしています。
a_male <- c(
  45, 63, 55, 68, 60, 66, 64, 71, 46, 56,
  71, 60, 42, 46, 53, 68, 72, 56, 64, 46,
  47, 66, 65, 55, 55, 49, 66, 60, 44, 64,
  60, 60, 34, 66, 63, 58, 62, 45, 66, 66,
  60, 64, 53, 58, 69, 59, 65, 55, 58, 57,
  76, 56, 67, 56, 76, 34, 53, 67, 49, 63,
  59, 44, 53, 63, 48, 59, 60, 66, 53, 58,
  40, 49, 56, 63, 57, 55, 74, 58, 61, 68,
  74, 63, 64, 68, 77, 49, 69, 69, 63, 56,
  67, 54, 49, 79, 60, 62, 63, 71, 71, 57,
  56, 70, 81, 81, 58, 57, 54, 69, 64, 70,
  56, 62, 66, 85, 63, 75, 59, 68, 65, 57,
  59, 69, 91, 78, 59, 60, 55, 48, 52, 55,
  52, 57, 70, 70, 58, 45, 49, 61, 46, 64,
  50, 57, 71, 65, 47, 69, 59, 72, 49, 54,
  71, 33, 61, 66, 53, 49, 47, 61, 57, 48)
a_female <- c(
  80, 73, 92, 98, 75, 72, 65, 72, 62, 63,
  83, 90, 82, 77, 79, 70, 73, 87, 72, 76,
  70, 76, 82, 72, 67, 68, 71, 54, 78, 74,
  90, 91, 74, 64, 63, 74, 77, 89, 63, 62)
b_male <- c(
  56, 64, 61, 60, 53, 66, 65, 51, 50, 54,
  50, 52, 51, 59, 59, 52, 61, 72, 42, 55,
  42, 58, 49, 59, 60, 36, 75, 48, 34, 64,
  53, 62, 46, 60, 47, 54, 59, 49, 55, 57)
b_female <- c(
  90, 80, 62, 73, 60, 76, 75, 68, 82, 82,
  67, 79, 71, 81, 54, 82, 65, 77, 71, 61,
  62, 76, 71, 76, 62, 90, 55, 64, 83, 92,
  66, 90, 71, 66, 80, 57, 63, 65, 71, 62,
  55, 52, 68, 72, 79, 81, 76, 65, 65, 76,
  75, 85, 74, 60, 59, 67, 63, 64, 81, 84,
  81, 81, 55, 76, 80, 69, 84, 57, 78, 72,
  63, 72, 82, 79, 58, 73, 52, 57, 58, 69,
  73, 70, 83, 76, 58, 92, 65, 65, 65, 59,
  80, 78, 68, 61, 64, 78, 62, 69, 81, 65,
  91, 79, 68, 74, 68, 67, 81, 83, 67, 92,
  67, 84, 75, 67, 67, 53, 62, 55, 68, 74,
  65, 77, 75, 70, 68, 56, 74, 60, 65, 61,
  54, 69, 68, 71, 67, 62, 66, 80, 69, 74,
  69, 59, 69, 79, 69, 64, 67, 56, 66, 78,
  85, 83, 53, 56, 56, 80, 53, 55, 70, 53)

# 表を作る関数
create_table <- function(male, female, school){
 table_male <- tibble::tibble(male) %>%
 dplyr::rename(得点 = male) %>%
 dplyr::mutate(性別 = "男性")

 table_female <- tibble::tibble(female) %>%
 dplyr::rename(得点 = female) %>%
 dplyr::mutate(性別 = "女性")

 return(dplyr::bind_rows(table_male, table_female) %>%
 dplyr::mutate(学校 = school))
}

# A校とB校をユニオンする
data <- dplyr::bind_rows(
 create_table(a_male, a_female, "A校"),
 create_table(b_male, b_female, "B校")
 ) %>%
 dplyr::select(学校, 性別, 得点)

# データの保存は省略

library(dplyr)

library(tibble)

# 平均値、分散を指定していい感じに作る

a_male <- round(rnorm(n = 160, mean = 60, sd = 10), 0)

a_female <- round(rnorm(n = 40, mean = 75, sd = 10), 0)

b_male <- round(rnorm(n = 40, mean = 55, sd = 10), 0)

b_female <- round(rnorm(n = 160, mean = 70, sd = 10), 0)

# その後、四捨五入しているので結局、微調整を手でしています。

a_male <- c(

45, 63, 55, 68, 60, 66, 64, 71, 46, 56,

71, 60, 42, 46, 53, 68, 72, 56, 64, 46,

47, 66, 65, 55, 55, 49, 66, 60, 44, 64,

60, 60, 34, 66, 63, 58, 62, 45, 66, 66,

60, 64, 53, 58, 69, 59, 65, 55, 58, 57,

76, 56, 67, 56, 76, 34, 53, 67, 49, 63,

59, 44, 53, 63, 48, 59, 60, 66, 53, 58,

40, 49, 56, 63, 57, 55, 74, 58, 61, 68,

74, 63, 64, 68, 77, 49, 69, 69, 63, 56,

67, 54, 49, 79, 60, 62, 63, 71, 71, 57,

56, 70, 81, 81, 58, 57, 54, 69, 64, 70,

56, 62, 66, 85, 63, 75, 59, 68, 65, 57,

59, 69, 91, 78, 59, 60, 55, 48, 52, 55,

52, 57, 70, 70, 58, 45, 49, 61, 46, 64,

50, 57, 71, 65, 47, 69, 59, 72, 49, 54,

71, 33, 61, 66, 53, 49, 47, 61, 57, 48)

a_female <- c(

80, 73, 92, 98, 75, 72, 65, 72, 62, 63,

83, 90, 82, 77, 79, 70, 73, 87, 72, 76,

70, 76, 82, 72, 67, 68, 71, 54, 78, 74,

90, 91, 74, 64, 63, 74, 77, 89, 63, 62)

b_male <- c(

56, 64, 61, 60, 53, 66, 65, 51, 50, 54,

50, 52, 51, 59, 59, 52, 61, 72, 42, 55,

42, 58, 49, 59, 60, 36, 75, 48, 34, 64,

53, 62, 46, 60, 47, 54, 59, 49, 55, 57)

b_female <- c(

90, 80, 62, 73, 60, 76, 75, 68, 82, 82,

67, 79, 71, 81, 54, 82, 65, 77, 71, 61,

62, 76, 71, 76, 62, 90, 55, 64, 83, 92,

66, 90, 71, 66, 80, 57, 63, 65, 71, 62,

55, 52, 68, 72, 79, 81, 76, 65, 65, 76,

75, 85, 74, 60, 59, 67, 63, 64, 81, 84,

81, 81, 55, 76, 80, 69, 84, 57, 78, 72,

63, 72, 82, 79, 58, 73, 52, 57, 58, 69,

73, 70, 83, 76, 58, 92, 65, 65, 65, 59,

80, 78, 68, 61, 64, 78, 62, 69, 81, 65,

91, 79, 68, 74, 68, 67, 81, 83, 67, 92,

67, 84, 75, 67, 67, 53, 62, 55, 68, 74,

65, 77, 75, 70, 68, 56, 74, 60, 65, 61,

54, 69, 68, 71, 67, 62, 66, 80, 69, 74,

69, 59, 69, 79, 69, 64, 67, 56, 66, 78,

85, 83, 53, 56, 56, 80, 53, 55, 70, 53)

# 表を作る関数

create_table <- function(male, female, school){

table_male <- tibble::tibble(male) %>%

dplyr::rename(得点 = male) %>%

dplyr::mutate(性別 = "男性")

table_female <- tibble::tibble(female) %>%

dplyr::rename(得点 = female) %>%

dplyr::mutate(性別 = "女性")

return(dplyr::bind_rows(table_male, table_female) %>%

dplyr::mutate(学校 = school))

}

# A校とB校をユニオンする

data <- dplyr::bind_rows(

create_table(a_male, a_female, "A校"),

create_table(b_male, b_female, "B校")

) %>%

dplyr::select(学校, 性別, 得点)

# データの保存は省略

クロス集計してみると下記になります。

学校	区分	男性	女性	全体
A校	人数	160	40	200
A校	平均点	60	75	63
B校	人数	40	160	200
B校	平均点	55	70	67

この表を見ると上記と引用部分と同じように男女それぞれで、A校がB校よりも5点高いものの、全体ではB校がA校よりも4点高いことがわかりますね。

データの可視化

それではここからデータの可視化をしていきたいと思います。タイトルの通り、ExcelとBIツール2種（Power BI & Tableau Desktop）を利用したグラフ、そして最後にRによるggplot2パッケージを利用したグラフを作ってみたいと思います。

作るイメージとしてはデータのばらつきをみたいので散布図のようなものを学校別、性別に分けることになります。

上記のデータを再び確認していただくとわかりますが、学校、性別は尺度でいうところの名義尺度（Tableauならディメンション、不連続データ）、得点は比例尺度（Tableauならメジャー、連続データ）となっています。このデータを可視化する際には不連続 × 連続のデータを可視化することになります。

使用するグラフのモジュールによってはこの不連続 × 連続のフォーマットに対応していない場合にちょっと工夫が必要になってきます。その場合はその都度補足をしたいと思います。

Microsoft Excelによる可視化

説明不要のマイクロソフト社のエクセルですね。メニューの挿入でグラフを作成して行きます。

エクセルでは軸を自動で指定して分割して表を作ってくれないため、いきなりですが散布図のY軸に得点、X軸に学校、系列に性別を指定して作成することになりました。

また、そもそも上記のtidyなデータ（いわゆる縦持ちのデータ）ではエクセルでグラフが描けないので系列ごとに加工をしています。A校とB校それぞれのX値の基準をを10と30とし、ジッター（揺らぎ）感を出すためにRANDOM関数を使用して加算しています。下のX軸のタイトルのようなものはテキストオブジェクトを追加で指定しています。系列のデータラベルなどを1つずつ出していくのはカスタマイズできる反面、操作が面倒ですね。下記のような加工をしています。

左からオリジナル、系列男性、系列女性、系列男性平均、系列女性平均、系列全体平均となっています。確認のためピボットテーブルも一番右にあります。

さて、出来上がったグラフはこのようになります。

Microsoft Excelによるシンプソンのパラドックスサンプルグラフ

メリット

MS製品なので手軽に使える（入手もしやすい）
慣れている人が多いので学習コストが低い
プロパティを設定することで割とカスタマイズがしやすい。

デメリット

データの加工は手作業で大変
データを置く場所が自由すぎるため、加工前後でデータの管理がしにくい
Mac OS用のエクセルはWindows用とコードを統一してから（使い勝手も含めて）不具合が多くないですか？

ということでエクセルのグラフを作成してみました。

Microsoft Power BIによる可視化

次はマイクロソフト社のBIツールであるPower BIを使用してグラフを作成してみました。Power BIもデフォルトで用意されているモジュールに不連続 × 連続に対応しているものがないのでエクセル同様に散布図を駆使して作成しました。A校とB校それぞれのX値の基準をを0と6とし、下記のような列Power BI上で追加しています。

X軸に入れるため、乱数などで位置を調整した変数「_校」を使用

また、エクセルとは異なり、グラフに対する系列を追加はできないため、ビジュアルをいくつかに分けて作成しています。

出来上がったグラフはこのようになります。

Microsoft Power BIによるシンプソンのパラドックスサンプルグラフ。左側のグラフ、平均のグラフは性別と全体の2枚を重ねて表示させています（そのため右側の凡例の順序が全体が2番目になってしまっています）。

メリット

Microsoft製品なので、Excelライクに使用が可能

デメリット

カスタムビジュアルをインポートしなければならない（ポジティブに捉えればマーケットプレイスから無限の可能性が広がる）のでもう少しデフォルトのセットを増やしてほしい

Tableau Desktopによる可視化

BIで有名なTableau社のソフトウェアです。普段はTableauを使用して可視化をしているので自分にとっては使いやすいのですが、こちらは不連続 × 連続に対応しているため比較的楽に作成できそうです。ただし同じ値がある場合、集計してしまうので個別に表示させるところで少し躓いてしまいました（JITTER処理の位置が同じ値は同じ場所に配置されてしまっていた）。

Tableau Desktopによるシンプソンのパラドックスサンプルグラフ。一番作りやすいグラフでした。

メリット

操作性が良い
学習コンテンツが充実

デメリット

データ加工はTableau Prepなど別に必要
有償（予算次第ですね！）

とはいえ、まずは無料のTableau Publicを使用して試してみるのも良いのではないでしょうか（一番最後にサンプルは掲載しています）。
*保存したデータは公開されますのでトライアルの際はご注意ください。

R & ggplot2パッケージによる可視化

Rではggplot2パッケージ（Grammar of Graphicsに基づいた記法）を使用して描画できるのでこちらを使用してグラフを作成してみました。普段はTableauばかりでggplot2パッケージをフル活用できていないため色々と調べることも多く大変でした。

R & ggplot2パッケージによるシンプソンのパラドックスサンプルグラフ。ggplotの細かい設定はRのコードをご参照ください。

長くなってスミマセン。

library(ggplot2)

# プロパティとして使用する項目の関数
properties <- function() {
  prop <- NULL
  prop$add_mean_A_x <- "平均 A校"
  prop$add_mean_A_y <- round(mean(data[data$学校 == "A校", ]$得点), 0)
  prop$add_mean_B_x <- "平均 B校"
  prop$add_mean_B_y <- round(mean(data[data$学校 == "B校", ]$得点), 0)

  prop$add_mean_a_male_x <- "平均 A校"
  prop$add_mean_a_male_y <- round(mean(data[data$学校 == "A校" &
                                            data$性別 == "男性", ]$得点), 0)
  prop$add_mean_b_male_x <- "平均 B校"
  prop$add_mean_b_male_y <- round(mean(data[data$学校 == "B校" &
                                            data$性別 == "男性", ]$得点), 0)

  prop$add_mean_a_female_x <- "平均 A校"
  prop$add_mean_a_female_y <- round(mean(data[data$学校 == "A校" &
                                            data$性別 == "女性", ]$得点), 0)
  prop$add_mean_b_female_x <- "平均 B校"
  prop$add_mean_b_female_y <- round(mean(data[data$学校 == "B校" &
                                            data$性別 == "女性", ]$得点), 0)
  return(prop)
}

# ggplotで描画する関数
my_ggplot <- function(data, prop) {
  g <- ggplot2::ggplot(
    data = data,
    mapping = ggplot2::aes(
      x = data$学校,
      y = data$得点)) + # ベースとなるデータの指定
    ggplot2::geom_jitter(
      size = 4,
      alpha = 0.5,
      height = 0,
      width = 0.2,
      mapping = ggplot2::aes(
        shape = data$性別,
        colour = data$性別
      )
    ) + # 揺らぎを持たせたグラフ描画
    ggplot2::scale_color_manual(values = c("#E60012", "#124DAE")) + # 配色指定
    ggplot2::annotate(
      geom = "point", x = prop$add_mean_A_x, y = prop$add_mean_A_y,
      size = 4, shape = 15, alpha = 0.7) + # A校の平均
    ggplot2::annotate(
      geom = "point", x = prop$add_mean_B_x, y = prop$add_mean_B_y,
      size = 4, shape = 15, alpha = 0.7) + # B校の平均
    ggplot2::annotate(
      geom = "point", x = prop$add_mean_a_male_x, y = prop$add_mean_a_male_y,
      size = 4, shape = 17, alpha = 0.7, colour = "#124DAE") + # A校男性の平均
    ggplot2::annotate(
      geom = "point", x = prop$add_mean_b_male_x, y = prop$add_mean_b_male_y,
      size = 4, shape = 17, alpha = 0.7, colour = "#124DAE") + # B校男性の平均
    ggplot2::annotate(
      geom = "point", x = prop$add_mean_a_female_x, y = prop$add_mean_a_female_y,
      size = 4, shape = 19, alpha = 0.7, colour = "#E60012") + # A校女性の平均
    ggplot2::annotate(
      geom = "point", x = prop$add_mean_b_female_x, y = prop$add_mean_b_female_y,
      size = 4, shape = 19, alpha = 0.7, colour = "#E60012") + # B校女性の平均
    ggplot2::annotate(
      geom = "text", family = "Meiryo", size = 3,
      x = c("平均 A校", "平均 B校"),
      y = c(prop$add_mean_A_y + 5, prop$add_mean_B_y - 5),
      label = c(paste0("平均 A校:", prop$add_mean_A_y),
                paste0("平均 B校:", prop$add_mean_B_y))) + # A校の平均
    annotate(
      geom = "text",  family = "Meiryo", size = 3,
      x = c("平均 A校", "平均 B校"),
      y = c(prop$add_mean_a_male_y - 5, prop$add_mean_b_male_y - 5),
      label = c(
        paste0("平均 A校(男性):", prop$add_mean_a_male_y),
        paste0("平均 B校(男性):", prop$add_mean_b_male_y))) + # 男性の平均
    ggplot2::annotate(
      geom = "text",  family = "Meiryo", size = 3,
      x = c("平均 A校", "平均 B校"),
      y = c(prop$add_mean_a_female_y + 5, prop$add_mean_b_female_y + 5),
      label = c(
        paste0("平均 A校(女性):", prop$add_mean_a_female_y),
        paste0("平均 B校(女性):", prop$add_mean_b_female_y))) + # 女性の平均
    ggplot2::xlab("学校と平均") + # X軸のラベル
    ggplot2::ylab("得点") + # Y軸のラベル
    ggplot2::scale_y_continuous(
      breaks = seq(0, 100, by = 10),
      limits = c(0,100),
      minor_breaks = NULL) + # 縦軸の書式設定
    ggplot2::theme_minimal(base_family = "Meiryo") + # テーマとフォント
    ggplot2::theme(legend.title = element_blank(),
          axis.title.x = element_text(size = rel(1.5)),
          axis.title.y = element_text(size = rel(1.5)),
          axis.text.x = element_text(size = rel(1.5)),
          axis.text.y = element_text(size = rel(1.5)),
          panel.grid.major.x = element_blank()) # 凡例と縦軸の削除

  return(g)

}

# 描画
print(my_ggplot(data, properties()))

100

101

102

library(ggplot2)

# プロパティとして使用する項目の関数

properties <- function() {

prop <- NULL

prop$add_mean_A_x <- "平均 A校"

prop$add_mean_A_y <- round(mean(data[data$学校 == "A校", ]$得点), 0)

prop$add_mean_B_x <- "平均 B校"

prop$add_mean_B_y <- round(mean(data[data$学校 == "B校", ]$得点), 0)

prop$add_mean_a_male_x <- "平均 A校"

prop$add_mean_a_male_y <- round(mean(data[data$学校 == "A校" &

data$性別 == "男性", ]$得点), 0)

prop$add_mean_b_male_x <- "平均 B校"

prop$add_mean_b_male_y <- round(mean(data[data$学校 == "B校" &

data$性別 == "男性", ]$得点), 0)

prop$add_mean_a_female_x <- "平均 A校"

prop$add_mean_a_female_y <- round(mean(data[data$学校 == "A校" &

data$性別 == "女性", ]$得点), 0)

prop$add_mean_b_female_x <- "平均 B校"

prop$add_mean_b_female_y <- round(mean(data[data$学校 == "B校" &

data$性別 == "女性", ]$得点), 0)

return(prop)

}

# ggplotで描画する関数

my_ggplot <- function(data, prop) {

g <- ggplot2::ggplot(

data = data,

mapping = ggplot2::aes(

x = data$学校,

y = data$得点)) + # ベースとなるデータの指定

ggplot2::geom_jitter(

size = 4,

alpha = 0.5,

height = 0,

width = 0.2,

mapping = ggplot2::aes(

shape = data$性別,

colour = data$性別

)

) + # 揺らぎを持たせたグラフ描画

ggplot2::scale_color_manual(values = c("#E60012", "#124DAE")) + # 配色指定

ggplot2::annotate(

geom = "point", x = prop$add_mean_A_x, y = prop$add_mean_A_y,

size = 4, shape = 15, alpha = 0.7) + # A校の平均

ggplot2::annotate(

geom = "point", x = prop$add_mean_B_x, y = prop$add_mean_B_y,

size = 4, shape = 15, alpha = 0.7) + # B校の平均

ggplot2::annotate(

geom = "point", x = prop$add_mean_a_male_x, y = prop$add_mean_a_male_y,

size = 4, shape = 17, alpha = 0.7, colour = "#124DAE") + # A校男性の平均

ggplot2::annotate(

geom = "point", x = prop$add_mean_b_male_x, y = prop$add_mean_b_male_y,

size = 4, shape = 17, alpha = 0.7, colour = "#124DAE") + # B校男性の平均

ggplot2::annotate(

geom = "point", x = prop$add_mean_a_female_x, y = prop$add_mean_a_female_y,

size = 4, shape = 19, alpha = 0.7, colour = "#E60012") + # A校女性の平均

ggplot2::annotate(

geom = "point", x = prop$add_mean_b_female_x, y = prop$add_mean_b_female_y,

size = 4, shape = 19, alpha = 0.7, colour = "#E60012") + # B校女性の平均

ggplot2::annotate(

geom = "text", family = "Meiryo", size = 3,

x = c("平均 A校", "平均 B校"),

y = c(prop$add_mean_A_y + 5, prop$add_mean_B_y - 5),

label = c(paste0("平均 A校:", prop$add_mean_A_y),

paste0("平均 B校:", prop$add_mean_B_y))) + # A校の平均

annotate(

geom = "text", family = "Meiryo", size = 3,

x = c("平均 A校", "平均 B校"),

y = c(prop$add_mean_a_male_y - 5, prop$add_mean_b_male_y - 5),

label = c(

paste0("平均 A校(男性):", prop$add_mean_a_male_y),

paste0("平均 B校(男性):", prop$add_mean_b_male_y))) + # 男性の平均

ggplot2::annotate(

geom = "text", family = "Meiryo", size = 3,

x = c("平均 A校", "平均 B校"),

y = c(prop$add_mean_a_female_y + 5, prop$add_mean_b_female_y + 5),

label = c(

paste0("平均 A校(女性):", prop$add_mean_a_female_y),

paste0("平均 B校(女性):", prop$add_mean_b_female_y))) + # 女性の平均

ggplot2::xlab("学校と平均") + # X軸のラベル

ggplot2::ylab("得点") + # Y軸のラベル

ggplot2::scale_y_continuous(

breaks = seq(0, 100, by = 10),

limits = c(0,100),

minor_breaks = NULL) + # 縦軸の書式設定

ggplot2::theme_minimal(base_family = "Meiryo") + # テーマとフォント

ggplot2::theme(legend.title = element_blank(),

axis.title.x = element_text(size = rel(1.5)),

axis.title.y = element_text(size = rel(1.5)),

axis.text.x = element_text(size = rel(1.5)),

axis.text.y = element_text(size = rel(1.5)),

panel.grid.major.x = element_blank()) # 凡例と縦軸の削除

return(g)

}

# 描画

print(my_ggplot(data, properties()))

メリット

高いカスタマイズ性
自由（フリー）なソフトウェア

デメリット

「完全に無保証」
覚えること（プロパティ設定≒コードで追加していく）が多いので敷居が高い？
マニュアルは英語のものが多い

まとめ

シンプソンのパラドックスについて概要を確認しました。そしてその例としてサンプルデータを使用して、Excel、Power BI、Tableau、Rで可視化をしてデータのばらつきを確認しました。

いずれも男性や女性といった視点でみるとそれぞれの平均点はA校が高いものの、全体の平均点はB校が高いということになっています。性別で見たときに人数がそれぞれの学校で異なっているため、全体平均で見ると平均点が逆転しているということがグラフから見て取れるのではないでしょうか。

いずれのツールで作成したグラフも似せて作ることはできましたが、ツールの製品仕様やモジュールによっていろいろと工夫をしなければならないことがお判りいただけたかと思いますし、それぞれの特徴についてもなんとなくご理解いただけたのではないでしょうか。[PR]データ分析で普段気づかなかったことを明らかにし、課題解決につなげていきたいですね！

本記事がみなさんのお役に立てれば幸いです。

それでは
Happy Holidays!

参考書籍

伊藤徹郎, 2018, データサイエンティスト養成読本ビジネス活用編, 技術評論社, p.107-108
西内啓, 2013, 統計学が最強の学問である, ダイヤモンド社, p.180-184

おまけ

TableauのグラフはこちらのTableau Publicでも公開しています。

シンプソンパラドックスの可視化を3手法で【Excel／BI／R】

シンプソンのパラドックス

可視化に使用するデータ