RでIR #04 奨学金とサンキーダイアグラム

執筆者：塚本浩太 (＊1)

公開日：2020/09/18

カテゴリ：

#教学IR（学修成果・学生調査・学生支援・EMなど）

#データ収集・準備・分析・可視化、各種ソフト利用におけるテクニック

#RでIR

hr.icon

奨学金とサンキーダイアグラム

https://gyazo.com/26d224e0de0f458e68b8e2f88459799c

上のグラフのように、ある状態からある状態への移行した数量を川幅の長さで表現したようなグラフはサンキーダイアグラムやリバープロットと呼ばれています。

なんとなくかっちょいいし、使ってみたいと思っても意外と作図するのが面倒で、見る機会はあっても使う機会はあまりないかもしれません。

今回はRのplotlyパッケージを使い、学部生の１年次から４年次の奨学金の受給状況（+退学状況）を、サンキーダイアグラムで可視化する方法について書きます。よりよい方法や問題点などあれば教えていただければ幸いです。

(1) 想定する架空の元データと、作図に必要なデータ

今回は、学部生の１年次から４年次の奨学金の受給状況（+退学状況）をサンキーダイアグラムにするのですが、以下のような縦型の架空のデータがあることを想定します。

学生のIDがあり、学生の学年（Year）ごとにどのような奨学金を受給しているかがScholarshipに入っています。Scholarship欄には退学の情報も追加していれてあります。rowidは通番です。

https://gyazo.com/227b8ddb260f15289c182c5eaab20c02

Scholarshipに入る値は、簡単のため、”学内給付奨学金”、”学内貸与奨学金”、”学外給付奨学金”、”学外貸与奨学金”、”退学”の５種類に整理したものとします (*2)。

赤枠で囲んだところのように、同じ学生が同時期に２つの奨学金を受給しているようなケースももちろんあると思います(*3)。

これが想定している架空のデータですが、サンキーダイアグラムを作図する上で必要なデータは、以下のような形になります。

https://gyazo.com/3b4151ca8c74b57e1495284436519bd1

要するに川の各流れの幅の数値（流量）が必要なので、

年次１に学外給付奨学金を受給して、年次２に学外給付奨学金を受給をした人は１人、

年次１に学外給付奨学金を受給して、年次２に学内貸与奨学金を受給をした人は１人、

・・・

年次３に奨学金無しで、年次４に奨学無しの人は１人

といった集計表を作ることになります。

(2) 作業の手順

今回は、同じ学生が同時期に２つの奨学金を受給しているような場合は優先順位の高い種別の方でカウントをするという方法を取ります。奨学金の種別によって優先順位を決めるため、データの整理の手順は以下のように少し遠回りになります。

① ダミー変数化

https://gyazo.com/ec24e3492542b38e259d4585caeea7a5

② 奨学金種別の優先順位付け

https://gyazo.com/8cb6543c6763b33646b4bbca61922aeb

③ 横型のデータの作成

https://gyazo.com/106bf86743d33c675a3ae1f5a67be9fe

④ 各流れの流量の集計

https://gyazo.com/62fd0c3124fb986334c879bea6eed0ed

⑤ plotlyで作図できる形に変換

https://gyazo.com/7f186f78603ddeb4e7cb7ee2913654ad

(3)Rでの作業

それでは、(2)で見た流れに沿ってRでの作業方法を見ていきます。

まず、必要なパッケージのインストール・読み込みをします。

code:パッケージのインストールと読み込み

# まだインストールしていない場合はまずインストールします。

install.packages("tidyverse") #データ処理・可視化用

install.packages("caret") #ダミー変数作成用

install.packages("plotly") #plotlyの作図用（今回はサンキーダイアグラム用）

# インストールしてあればパッケージの読み込みをします。

library(tidyverse)

library(caret)

library(plotly)

次に、架空の元データを読み込んでください。

code:架空の元データの読み込み

id <- c("X0001","X0001","X0001","X0001","X0001","X0001","X0001","X0002","X0002","X0002","X0002","X0003","X0003","X0003","X0004","X0004","X0004","X0004","X0005","X0005","X0005","X0005","X0006","X0006","X0006","X0007","X0007","X0007","X0007","X0008","X0008","X0008","X0008","X0009","X0010","X0010","X0010","X0010")

year <- c("1","2","3","4","2","3","4","1","2","3","4","1","2","3","1","2","3","4","1","2","3","4","2","3","4","1","2","3","4","1","2","3","4","2","1","2","3","4")

scholarship <-c("学内給付奨学金","学内給付奨学金","学内給付奨学金","学内給付奨学金","学内貸与奨学金","学内貸与奨学金","学外給付奨学金","学内給付奨学金","退学","退学","退学","学内給付奨学金","学内貸与奨学金","学内貸与奨学金","学外給付奨学金","学外給付奨学金","学外給付奨学金","学外給付奨学金","学外貸与奨学金","学外貸与奨学金","学外貸与奨学金","学外貸与奨学金","学外貸与奨学金","学外貸与奨学金","学外貸与奨学金","学内貸与奨学金","学内貸与奨学金","退学","退学","学外貸与奨学金","学外貸与奨学金","学内貸与奨学金","学内貸与奨学金","学内貸与奨学金","学外給付奨学金","学内貸与奨学金","学内貸与奨学金","学外給付奨学金")

scholarship <- factor(scholarship,levels =c("学内給付奨学金","学内貸与奨学金","学外給付奨学金","学外貸与奨学金","退学"))

df.scholarship <- data.frame(ID=id, Year=year, Scholarship=scholarship)

df.scholarship <- df.scholarship %>% mutate(rowid = as.numeric(rownames(df.scholarship)))

これで架空のデータができました。

https://gyazo.com/cab06d94506523c69563e20104ae8355

それでは早速手順に沿ってサンキーダイアグラムを作っていきましょう。

① ダミー変数化

https://gyazo.com/d454bd8322ddb3a29a35aba6c0d88cd7

読み込んだデータについてcaretパッケージのdummyVars関数を使ってダミー変数化します。caretは機械学習をするのに便利なパッケージで、機械学習を行うための前処理に使える関数も多く揃えています。

code:ダミー変数化

# ダミー変数の作成

# Scholarshipの部分をダミー変数化します。

df.scholarship_dummy <- dummyVars(~Scholarship,df.scholarship)

df.scholarship_dummy2 <- as.data.frame(predict(df.scholarship_dummy,df.scholarship))

こんな感じで、Scholarship部分がダミー変数になっています。

Scholarship部分しかないので、元のデータとくっつけます。

code:元データと結合

# 結合

df.scholarship2 <- data.frame(df.scholarship,df.scholarship_dummy2)

次のような形になりました。

https://gyazo.com/6260beaedbcadec0c1b8c3f5dd367209

元が縦型データなので、赤枠部分のように同じIDで同じ学年でも２行になってしまっているので、集計をして、同じIDで同じ学年なら１行になるようにします。

code:集計

# 集計

df.scholarship2_g<- df.scholarship2 %>% group_by(ID,Year) %>%

summarise(学内給付奨学金 = sum(Scholarship.学内給付奨学金),

学内貸与奨学金 = sum(Scholarship.学内貸与奨学金),

学外給付奨学金 = sum(Scholarship.学外給付奨学金),

学外貸与奨学金 = sum(Scholarship.学外貸与奨学金),

退学 = sum(Scholarship.退学))　%>%

ungroup()

次のような形のとおり、同じIDで同じ学年なら１行にまとまりました。

https://gyazo.com/6beafa9667c6d44ebbd658d5b9a40473

② 奨学金種別の優先順位付け

https://gyazo.com/1a7e8214fd63658849426e3c89824f60

先程整理したデータを見てみると、X0001さんは年次２のときに学内給付奨学金と学内貸与奨学金を同時に受給しています。今回は簡単のためにサンキーダイアグラムにする際に、同時期に重複して受給をしている方については奨学金の種別に優先順位を決めて、優先順位が高い方でカウントすることにします。

https://gyazo.com/074175cb4a53e6047718ac03a3d21124

今回の優先順位は、"学内給付奨学金" > "学内貸与奨学金" > "学外給付奨学金" > "学外貸与奨学金"とします。本当のデータであれば退学と他の奨学金が重複することももちろんありえますが（２年次に何らか奨学金を受給していたが途中で退学するケースなど）、今回のデータは簡単のためそのような重複はないので、奨学金の種別だけ重複に対する処理を考えます。

code:優先順位付

# 優先順位付

df.scholarship3 <- df.scholarship2_g %>%

mutate(学内貸与奨学金 = if_else(学内給付奨学金 +学内貸与奨学金 > 学内貸与奨学金, 0,if_else(学内貸与奨学金 > 0,1,0)),

学外給付奨学金 = if_else(学内給付奨学金 +学内貸与奨学金 +学外給付奨学金 > 学外給付奨学金, 0,if_else(学外給付奨学金 > 0,1,0)),

学外貸与奨学金 = if_else(学内給付奨学金 +学内貸与奨学金 +学外給付奨学金 +学外貸与奨学金 > 学外貸与奨学金, 0,if_else(学外貸与奨学金 > 0,1,0)))

少し冗長なやり方かもしれませんが、データの形で見ると左側の奨学金種別ですでに１が出ていたら、それより右側の奨学金種別では0に置き換えるということをしています。

X0001は2年時と3年次に本当は”学内貸与奨学金”も受給していて１になっていたのですが、同時に受給している”学内給付奨学金”の方が優先順位が高いので、”学内貸与奨学金”の値は0に変えました。

https://gyazo.com/0972127e8823287b53bd782ce5a0650a

③ 横型のデータの作成

https://gyazo.com/106bf86743d33c675a3ae1f5a67be9fe

さらに後の処理のために、年次ごとにデータを整形します。今はダミー変数になっていますが、まず年次ごとに受給した奨学金の種別が値になるようにします。

code:年次ごとのデータの整理

# 年次ごとのデータの整理

## 年次1

df.scholarship_nenji1 <- df.scholarship3 %>%

filter(Year == 1) %>%

select(-Year) %>%

gather(key = "年次1", value = "採否", - ID) %>%

filter(採否 ==1) %>%

select(-採否)

## 年次2

df.scholarship_nenji2 <- df.scholarship3 %>%

filter(Year == 2) %>%

select(-Year) %>%

gather(key = "年次2", value = "採否", - ID) %>%

filter(採否 ==1) %>%

select(-採否)

## 年次3

df.scholarship_nenji3 <- df.scholarship3 %>%

filter(Year == 3) %>%

select(-Year) %>%

gather(key = "年次3", value = "採否", - ID) %>%

filter(採否 ==1) %>%

select(-採否)

## 年次4

df.scholarship_nenji4 <- df.scholarship3 %>%

filter(Year == 4) %>%

select(-Year) %>%

gather(key = "年次4", value = "採否", - ID) %>%

filter(採否 ==1) %>%

select(-採否)

次のような４つのデータができました。

https://gyazo.com/69f1b54ffcbfdc61a8ae91bf25c5366a

これをつなげて横型のデータを整えます。まず対象となる学生のIDを重複なしのユニークな値にして、それに各年次のデータをつなげていく方法です。

code:横型データの整形

# ユニークIDの作成

UniqueID <- data.frame(ID = as.character(unique(df.scholarship$ID)))

# 結合

df.scholarship_join1 <- left_join(UniqueID,df.scholarship_nenji1,by="ID")

df.scholarship_join2 <- left_join(df.scholarship_join1,df.scholarship_nenji2,by="ID")

df.scholarship_join3 <- left_join(df.scholarship_join2,df.scholarship_nenji3,by="ID")

df.scholarship_join_all <- left_join(df.scholarship_join3,df.scholarship_nenji4,by="ID")

# 空欄は奨学金の受給が無い状態なので、空欄を”無し”に置き換えます。

df.scholarship_join_allis.na(df.scholarship_join_all) <- "無し"

# 後で各年次の奨学金受給の名前が川の流れの起点と終点になるのですが、年次がはっきりとわかるように値の前に”年次Y_”を加えます。

df.scholarship_join_all <- df.scholarship_join_all %>%

mutate(年次1 = paste0("年次1_", 年次1),

年次2 = paste0("年次2_", 年次2),

年次3 = paste0("年次3_", 年次3),

年次4 = paste0("年次4_", 年次4))

次のような横型のデータができました。

https://gyazo.com/78f7a3361d5552853bcc9e517bd9a14a

④ 各流れの流量の集計

https://gyazo.com/62fd0c3124fb986334c879bea6eed0ed

横型に変換したデータを使って、

年次１に学外給付奨学金を受給して、年次２に学外給付奨学金を受給をした人は１人、

年次１に学外給付奨学金を受給して、年次２に学内貸与奨学金を受給をした人は１人、

・・・

年次３に奨学金無しで、年次４に奨学無しの人は１人

といった集計表を、各年次の移行タイミングごとに作ります。

code:各流量の集計

# 年次1から年次2の集計

df.scholarship_sum1 <- df.scholarship_join_all %>%

ungroup() %>%

group_by(年次1,年次2) %>%

summarise(人数 = n()) %>%

rename(source = 年次1, target = 年次2)

# 年次2から年次3の集計

df.scholarship_sum2 <- df.scholarship_join_all %>%

ungroup() %>%

group_by(年次2,年次3) %>%

summarise(人数 = n()) %>%

rename(source = 年次2, target = 年次3)

# 年次3から年次4の集計

df.scholarship_sum3 <- df.scholarship_join_all %>%

ungroup() %>%

group_by(年次3,年次4) %>%

summarise(人数 = n()) %>%

rename(source = 年次3, target = 年次4)

これで各流量の計算ができました。

https://gyazo.com/30429af0645060a0b2ace9b7e3f8bafb

⑤ plotlyで作図できる形に変換

https://gyazo.com/7f186f78603ddeb4e7cb7ee2913654ad

まず④で作った年次が移行するタイミングごとに集計した流量のデータを縦につなぎます。

code:流量を縦に結合

# 縦長に結合

df.scholarship_bind <- bind_rows(df.scholarship_sum1 ,df.scholarship_sum2)

df.scholarship_sakey <- bind_rows(df.scholarship_bind ,df.scholarship_sum3) %>% ungroup()

縦長に結合されました。

https://gyazo.com/0bcb76fe78ea426ad6b8fc65b8384758

いよいよサンキーダイアグラムを作成するための最終的な整形です。

サンキーダイアグラムの各流れの起点や終点になる点をnodeといいます。グラフを作成するために流し込むデータとして、まずこのnodeに関するデータを作成する必要があります（どんなノードがあるのか、0からの通番を振ってノードの名前を整理したデータが必要です。）。

code:nodeの作成

# nodeの作成

## nodeになり得るのは起点と終点なので、起点と終点のデータをすべてくっつけます。

node <-c(df.scholarship_sakey$source,df.scholarship_sakey$target)

## 重複があるので、まずユークな値にします。

node <- data.frame(nodename = unique(node)) %>%

## nodeに番号を振ります。この番号付けは0から始めなくてはいけないので要注意です。

mutate(num =row_number()-1) %>%

## nodeの色を付けます。ここでは受給なしなら灰色、退学なら赤、他は青にします。

mutate(colors = if_else(nodename %in% c("年次1_無し","年次2_無し","年次3_無し","年次4_無し"), "grey",

if_else(nodename %in% c("年次1_退学","年次2_退学", "年次3_退学", "年次4_退学"),"red", "steelblue")))

次のようなデータができました（colorsはなくても作図はできます）。

https://gyazo.com/3c120645451fc8a97cb21717758d2c12

次に川の流れデータの整理です。

code:川の流れの色の指定

# 川の流れの色を指定する変数colorsを作ります。

## 色はrgba値で指定します。rgba(#,#,#,#)という形ですが、最初の３つ値で色を指定し、最後の１値で透明度を指定します。１が透明設定なしで、0が完全に透明（無色）になります。今回は透明度は0.3にします。

##　青色　rgba(70,130,180,0.3)

##　灰色　rgba(128,128,128,0.3)

##　赤　　rgba(255,0,0,0.3)　で設定します。

df.scholarship_sakey <-df.scholarship_sakey %>%

mutate(colors =

if_else(source %in% c("年次1_無し","年次2_無し","年次3_無し","年次4_無し"),

"rgba(128,128,128,0.3)",

if_else(source %in% c("年次1_退学","年次2_退学", "年次3_退学", "年次4_退学"),

"rgba(255,0,0,0.3)",

"rgba(70,130,180,0.3)")))

サンキーダイアグラムに流し込む流量のデータではnodeの名前が数字になっていなければいけないので先程nodeで振った番号に置き換えます。

code:流量データのnode名を番号に変更

# まず置き換えがしやすいように以下の２つのデータを作っておきます。

node %>% select(-colors) %>% rename(source = nodename)

node_s <- node %>% select(-colors) %>% rename(source = nodename)

node_t <- node %>% select(-colors) %>% rename(target = nodename)

# 番号に置き換えます。

df.scholarship_sakey_1 <- left_join(df.scholarship_sakey,node_s, by="source") %>% select(-source) %>% rename(source = num)

df.scholarship_sakey_2 <- left_join(df.scholarship_sakey_1 ,node_t, by="target") %>% select(-target) %>% rename(target = num)

これで準備は整いました。

(4)サンキーダイアグラムの作図

早速作図をしてみます。

code:サンキーダイアグラムの作図

plotly::plot_ly(

type = "sankey",

domain = list(x = c(0,1), y = c(0,1)),

# nodeの設定をします。

node = list(

## nodeの指定

label = node$nodename,

## nodeの色の指定（指定しなければデフォルトの色になります）

color = node$colors),

# 川の流れの設定をします。

link = list(

## 起点の指定

source = df.scholarship_sakey_2$source,

## 終点の指定

target = df.scholarship_sakey_2$target,

## 流量の指定

value = df.scholarship_sakey_2$人数,

## 色の指定（指定しなければデフォルトの色になります）

color = df.scholarship_sakey_2$colors)) %>%

# plotlyで作図した時に出てくる表示モードを変更するオプションを非表示にします。

config(displayModeBar = F)

これでグラフができました。

https://gyazo.com/74e5f8960e33b4b62bb5830c0c7546f6

(5) 注意点

plotlyで作成するサンキーダイアグラムにはいくつか注意点があります。

① マウスオーバー

plotlyで作成したグラフはマウスオーバーすると数値などが表示されます。Rmarkdownなどを使ってhtmlで出力すれば、この機能を使えます（もちろん、このページのように静止画で貼り付けていたらこの機能は使えません）。

https://gyazo.com/a5685690f476ad627c1ec7f9f474ecec

② 　nodeの順番

plotlyで作成したサンキーダイアグラムのnodeの順番は指定ができないようです。ただ、これもドラッグ＆ドロップで動かすことはできます。静止画で共有するのであれば、自分でいい順番に動かしてから静止画に保存するのがいいかもしれません。

https://gyazo.com/6861c8297141e81f5d08181b2199be00

③　htmlで保存した場合の元データの漏洩

これが一番注意しなければいけない点ですが、①でマウスオーバーしてデータが表示されるというのはつまり、htmlで保存した場合、その中に元データが入っているということです。

今回plotlyの中に入れているデータは、nodeとdf.scholarship_sakey_2でどちらも個人が特定できるようなデータではありませんが、plotlyを使う際には注意が必要です。

https://gyazo.com/f723cc176a79f3ed374ef8e863482688

(6) まとめ

Tableauなどを用いてもなかなか、サンキーダイアグラムを作成するのはハードルが高いと思いますが、今回Rでサンキーダイアグラムを作成する流れについて書きました。

例にあげた奨学金の分析という意味ではもっと気をつけなければいけない観点が多いと思いますが、ここでは単純なケースで技術的な面を重点に置いて紹介しました。

もっと複雑になってしまい簡単にはできませんが、例えばカリキュラム・ツリーを検証する際に、どのような経路で科目の履修をしているか、サンキーダイアグラムで可視化できたら面白いかもしれません。

hr.icon

注

(＊1) この内容は私個人の見解であり、所属組織の見解ではありません。

(＊2) 実務では、奨学金に関するテーブルと、退学などの在籍区分に関するテーブルは分かれていると思いますので、前処理が必要だと思います。

(＊3) この架空データではないのですが、同じ人が同時期に奨学金を受給して、その後退学といったケースもあると思います。また、今回は受給の有無だけを見ていますが、応募の有無も重要な観点になるでしょう。例えば、ある奨学金に応募して、不採択だったので退学ということは残念ながら十分ありえるので、同じ時期に、不採択→退学か継続在籍の流れを見るのも重要だと思われます。

※当コラムの文責及び著作権は、すべて投稿者に帰属します。