第26回のウェブ資料

W1 はじめに

• ggsankeyfier
• 連載第20回

W1.1 事前準備1

　このページは、データ解析環境Rを用いた作図実習を含みます。実習に取り組みたい方は、こちらのリンク先の「R1.010 R本体とRStudioとパッケージのインストール」および「R1.020 RStudioの基本的な利用法」を一通り行っておいて下さい。以下は、リンク先のスクショです。①、②の順に各自のOS用のものを行ってください（約3時間）。RまたはRStudioの基本的な利用法が理解できていれば、ここはスキップしてもかまいません。

W1.2 事前準備2

　ここでは、ggsankeyfierとtidyverseとopenxlsxのインストールを行います。3つのパッケージは、以下のコピペでインストールできます。openxlsxは、xlsx形式ファイルの読込時に必要なパッケージです。

if (!require("BiocManager", quietly = TRUE))     # BiocManagerパッケージがインストールされてなければ...
    install.packages("BiocManager")              # BiocManagerをインストールせよ
BiocManager::install("ggsankeyfier", update=F)   # パッケージのインストール（ggsankeyfier）
BiocManager::install("tidyverse", update=F)      # パッケージのインストール（tidyverse）
BiocManager::install("openxlsx", update=F)       # パッケージのインストール（openxlsx）

W1.3 エラー遭遇時の対処法

　ここはエラーに遭遇したヒト用の補足情報です。R本体のバージョンが古いと、上記スクリプトではうまくいかないことがあります。例えば、2025年4月3日現在のR本体の最新版は4.4.3ですが、バージョンが4.3.0以下ですとおそらくコケます。1つの対処法は、R本体のバージョンを上げて上記をやり直すことです。そしてもう1つの対処法は、現在利用中のRのままで以下を実行することです。

install.packages("ggsankeyfier", repos = "https://cloud.r-project.org/")
install.packages("tidyverse", repos = "https://cloud.r-project.org/")
install.packages("openxlsx", repos = "https://cloud.r-project.org/")

W2 サンキー図の具体例

　図1は、以下のスクリプトをコピペ実行すれば得られます。

W2.1 図1a タイタニック号沈没事故

　入力ファイル（JSLAB26_titanic.csv）は、ウィキペディアのタイタニック号沈没事故の犠牲者と生存者の内訳データから自作しています（W7.1）。

in_f <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/JSLAB26_titanic.csv" # 入力ファイル名

# 必要なパッケージをロード
library(tidyverse)                               # パッケージの読込
library(ggsankeyfier)                            # パッケージの読込

# 入力ファイルの読み込み
data <- read_csv(in_f)                           # in_fで指定したファイルの読込

# 前処理（描画させたい列情報の抽出とlong型への変換
matome <- pivot_stages_longer(                   # long型データへの変換
              data = data,                       # 入力はdataオブジェクト   
              stages_from = c("Outcome", "Sex", "Passengers"), # 描画させたいカテゴリ名情報
              values_from = "Freq")              # 頻度をカウントしたい列名情報

# 作図1（サンキー図の基本形まで作成した結果をgに格納）
pos <- position_sankey(v_space = "auto")         # 描画時の位置情報（ノード間の縦幅間隔は自動）
g <- ggplot(data = matome,                       # ggplot関数実行結果をgに格納。入力はmatomeオブジェクト
  mapping = aes(x = stage, y = Freq,             # matomeのstage列とFreq列をx軸とy軸として利用
                group = node, fill = node,       # groupとfillは、matome内のnode列で行う（変更不要）
                edge_id = edge_id,               # edge_idはmatome内のedge_id列（変更不要）
                connector = connector)) +        # connectorはmatome内のconnector列（変更不要）
  geom_sankeynode(position = pos) +              # ノード情報を追加
  geom_sankeyedge(position = pos)                # エッジ情報を追加

# 作図2-1（ノードに付随する情報を描画する際に利用する微調整用のパラメータ作成）
# y軸の高さは入力ファイルの行数次第なので、nrow(data)の何%程度上下にずらすかという感じの計算をしている
# nudge_xとnudge_yは、x軸とy軸それぞれの方向に少しずらしたい値です（nudgeは小突くという意味）
nudge_val_y <- sum(data$Freq)*0.025            　# y軸上の描画位置をベースラインから上下にずらしたい高さの幅情報
pos1 <- position_sankey(v_space = "auto",        # ノード名情報描画時の位置情報（ノード間の縦幅間隔は自動）
                        nudge_x = 0.06,          # ノード名情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = nudge_val_y)   # ノード名情報描画時の位置情報（y軸情報の位置をnudge_val_y上にずらす）
pos2 <- position_sankey(v_space = "auto",        # 頻度情報描画時の位置情報（ノード間の縦幅間隔は自動）
                        nudge_x = 0.06,          # 頻度情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = -nudge_val_y)  # 頻度情報描画時の位置情報（y軸情報の位置をnudge_val_y下にずらす）

# 作図2-2（基本形gをベースとして、ノードに付随する情報を追加した結果をg2に格納）
# stat = "sankeynode"は、描画するのがノード情報だという指令
# label = nodeは、描画するのがノード名だという指令
# label = Freqは、描画するのがノードに付随する頻度値だという指令
# position = pos1は、微調整用情報としてpos1を利用せよという指令
# position = pos2は、微調整用情報としてpos2を利用せよという指令
# hjust = 0は、文字を左揃えで描画せよという指令（デフォルトは中央揃え）
# size = 4は、サイズ4にせよという指令（この値に応じてnudge_yも適宜調整する）
g2 <- g + 
      geom_text(aes(label = node), stat = "sankeynode", position = pos1, hjust = 0, size = 4) + 
      geom_text(aes(label = Freq), stat = "sankeynode", position = pos2, hjust = 0, size = 4)

# 作図3（g2をベースとして、背景や凡例などを消すなどの調整を行った結果をg3に格納）
g3 <- g2 + theme_minimal() +                     # 背景を白に変更
      theme(panel.grid = element_blank(),        # グリッド線を消す
            legend.position = 'none',            # 凡例を消す
            axis.title = element_blank(),        # 軸のタイトルを消す
            axis.text.y = element_blank(),       # y軸のメモリ表示を消す
            axis.text.x = element_text(size = 15)) # x軸（カテゴリ名）はサイズ15にせよ
g3

W2.2 図1b 仮想薬剤応答解析結果

　入力ファイル（JSLAB26_medical.csv）は、W7.2で作成しています。

in_f <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/JSLAB26_medical.csv" # 入力ファイル名

# 必要なパッケージをロード
library(tidyverse)                               # パッケージの読込
library(ggsankeyfier)                            # パッケージの読込

# 入力ファイルの読み込み
data <- read_csv(in_f)                           # in_fで指定したファイルの読込

# 前処理（描画させたい列情報の抽出とlong型への変換
matome <- pivot_stages_longer(                   # long型データへの変換
              data = data,                       # 入力はdataオブジェクト   
              stages_from = c("年齢", "病院", "種類", "結果"), # 描画させたいカテゴリ名情報
              values_from = "頻度")              # 頻度をカウントしたい列名情報

# 作図1（サンキー図の基本形まで作成した結果をgに格納）
pos <- position_sankey(v_space = "auto",         # 描画時の位置情報（ノード間の縦幅間隔は自動）
                       order = "as_is")          # 描画時の位置情報（ノード名の並びはそのまま）
g <- ggplot(data = matome,                       # ggplot関数実行結果をgに格納。入力はmatomeオブジェクト
  mapping = aes(x = stage, y = 頻度,             # matomeのstage列と頻度列をx軸とy軸として利用
                group = node, fill = node,       # groupとfillは、matome内のnode列で行う（変更不要）
                edge_id = edge_id,               # edge_idはmatome内のedge_id列（変更不要）
                connector = connector)) +        # connectorはmatome内のconnector列（変更不要）
  geom_sankeynode(position = pos) +              # ノード情報を追加
  geom_sankeyedge(position = pos)                # エッジ情報を追加

# 作図2-1（ノードに付随する情報を描画する際に利用する微調整用のパラメータ作成）
# y軸の高さは入力ファイルの行数次第なので、nrow(data)の何%程度上下にずらすかという感じの計算をしている
# nudge_xとnudge_yは、x軸とy軸それぞれの方向に少しずらしたい値です（nudgeは小突くという意味）
nudge_val_y <- sum(data$頻度)*0.025            　# y軸上の描画位置をベースラインから上下にずらしたい高さの幅情報
pos1 <- position_sankey(v_space = "auto",        # ノード名情報描画時の位置情報（ノード間の縦幅間隔は自動）
                        order = "as_is",         # ノード名情報描画時の位置情報（項目名の並びはそのまま）
                        nudge_x = 0.06,          # ノード名情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = nudge_val_y)   # ノード名情報描画時の位置情報（y軸情報の位置をnudge_val_y上にずらす）
pos2 <- position_sankey(v_space = "auto",        # 頻度情報描画時の位置情報（ノード間の縦幅間隔は自動）
                        order = "as_is",         # ノード名情報描画時の位置情報（項目名の並びはそのまま）
                        nudge_x = 0.06,          # 頻度情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = -nudge_val_y)  # 頻度情報描画時の位置情報（y軸情報の位置をnudge_val_y下にずらす）

# 作図2-2（基本形gをベースとして、ノードに付随する情報を追加した結果をg2に格納）
# stat = "sankeynode"は、描画するのがノード情報だという指令
# label = nodeは、描画するのがノード名だという指令
# label = Freqは、描画するのがノードに付随する頻度値だという指令
# position = pos1は、微調整用情報としてpos1を利用せよという指令
# position = pos2は、微調整用情報としてpos2を利用せよという指令
# hjust = 0は、文字を左揃えで描画せよという指令（デフォルトは中央揃え）
# size = 4は、サイズ4にせよという指令（この値に応じてnudge_yも適宜調整する）
g2 <- g + 
      geom_text(aes(label = node), stat = "sankeynode", position = pos1, hjust = 0, size = 4) + 
      geom_text(aes(label = 頻度), stat = "sankeynode", position = pos2, hjust = 0, size = 4)

# 作図3（g2をベースとして、背景や凡例などを消すなどの調整を行った結果をg3に格納）
g3 <- g2 + theme_minimal() +                     # 背景を白に変更
      theme(panel.grid = element_blank(),        # グリッド線を消す
            legend.position = 'none',            # 凡例を消す
            axis.title = element_blank(),        # 軸のタイトルを消す
            axis.text.y = element_blank(),       # y軸のメモリ表示を消す
            axis.text.x = element_text(size = 15)) # x軸（カテゴリ名）はサイズ15にせよ
g3

W2.3 図1c 遺伝子クラスタリング結果

　入力ファイルは、連載第19回のW13で作成したものです。これは、拡張子がcsvではなく、複数のファイルに分かれているものを別々に読み込んで、tibble形式にする手順の例になります。

in_f1 <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/MBCdeg_K3.xlsx" # 入力ファイル名
in_f2 <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/MBCdeg_K4.xlsx" # 入力ファイル名
in_f3 <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/MBCdeg_K5.xlsx" # 入力ファイル名

# 必要なパッケージをロード
library(openxlsx)                                # パッケージの読込
library(tidyverse)                               # パッケージの読込
library(ggsankeyfier)                            # パッケージの読込

# 入力ファイルの読み込み
hoge1 <- read.xlsx(in_f1)                        # in_f1で指定したファイルの読込
hoge2 <- read.xlsx(in_f2)                        # in_f1で指定したファイルの読込
hoge3 <- read.xlsx(in_f3)                        # in_f1で指定したファイルの読込

# 前処理（必要な列のみの抽出）
res_K3 <- hoge1$`cls$cluster`                    # cls$cluster列のみを抽出
res_K4 <- hoge2$`cls$cluster`                    # cls$cluster列のみを抽出
res_K5 <- hoge3$`cls$cluster`                    # cls$cluster列のみを抽出

# 前処理（項目情報を見やすくするため"cluster"という文字列を連結）
cls_K3 <- str_c("cluster", res_K3)               # クラスタ番号の左側に文字列"cluster"を連結
cls_K4 <- str_c("cluster", res_K4)               # クラスタ番号の左側に文字列"cluster"を連結
cls_K5 <- str_c("cluster", res_K5)               # クラスタ番号の左側に文字列"cluster"を連結

# 前処理（tibble形式への変換）
data <- tibble(K3 = cls_K3,                      # cls_K3を列名をK3としてtibble形式で格納
               K4 = cls_K4,                      # cls_K4を列名をK4としてtibble形式で格納
               K5 = cls_K5,                      # cls_K5を列名をK5としてtibble形式で格納
               Freq = rep(1, nrow(hoge1)))       # 要素が全て1からなるベクトルを、列名をFreqとしてtibble形式で格納

# 前処理（描画させたい列情報の抽出とlong型への変換
matome <- pivot_stages_longer(                   # long型データへの変換
              data = data,                       # 入力はdataオブジェクト   
              stages_from = c("K3", "K4", "K5"), # 描画させたいカテゴリ名情報
              values_from = "Freq")              # 頻度をカウントしたい列名情報

# 作図1（サンキー図の基本形まで作成した結果をgに格納）
pos <- position_sankey(v_space = "auto",         # 描画時の位置情報（ノード間の縦幅間隔は自動）
                       order = "as_is")          # 描画時の位置情報（ノード名の並びはそのまま）
g <- ggplot(data = matome,                       # ggplot関数実行結果をgに格納。入力はmatomeオブジェクト
  mapping = aes(x = stage, y = Freq,             # matomeのstage列とFreq列をx軸とy軸として利用
                group = node, fill = node,       # groupとfillは、matome内のnode列で行う（変更不要）
                edge_id = edge_id,               # edge_idはmatome内のedge_id列（変更不要）
                connector = connector)) +        # connectorはmatome内のconnector列（変更不要）
  geom_sankeynode(position = pos) +              # ノード情報を追加
  geom_sankeyedge(position = pos)                # エッジ情報を追加

# 作図2-1（ノードに付随する情報を描画する際に利用する微調整用のパラメータ作成）
# y軸の高さは入力ファイルの行数次第なので、nrow(data)の何%程度上下にずらすかという感じの計算をしている
# nudge_xとnudge_yは、x軸とy軸それぞれの方向に少しずらしたい値です（nudgeは小突くという意味）
nudge_val_y <- sum(data$Freq)*0.025            　# y軸上の描画位置をベースラインから上下にずらしたい高さの幅情報
pos1 <- position_sankey(v_space = "auto",        # ノード名情報描画時の位置情報（ノード間の縦幅間隔は自動）
                        order = "as_is",         # ノード名情報描画時の位置情報（項目名の並びはそのまま）
                        nudge_x = 0.06,          # ノード名情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = nudge_val_y)   # ノード名情報描画時の位置情報（y軸情報の位置をnudge_val_y上にずらす）
pos2 <- position_sankey(v_space = "auto",        # 頻度情報描画時の位置情報（ノード間の縦幅間隔は自動）
                        order = "as_is",         # ノード名情報描画時の位置情報（項目名の並びはそのまま）
                        nudge_x = 0.06,          # 頻度情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = -nudge_val_y)  # 頻度情報描画時の位置情報（y軸情報の位置をnudge_val_y下にずらす）

# 作図2-2（基本形gをベースとして、ノードに付随する情報を追加した結果をg2に格納）
# stat = "sankeynode"は、描画するのがノード情報だという指令
# label = nodeは、描画するのがノード名だという指令
# label = Freqは、描画するのがノードに付随する頻度値だという指令
# position = pos1は、微調整用情報としてpos1を利用せよという指令
# position = pos2は、微調整用情報としてpos2を利用せよという指令
# hjust = 0は、文字を左揃えで描画せよという指令（デフォルトは中央揃え）
# size = 4は、サイズ4にせよという指令（この値に応じてnudge_yも適宜調整する）
g2 <- g + 
      geom_text(aes(label = node), stat = "sankeynode", position = pos1, hjust = 0, size = 4) + 
      geom_text(aes(label = Freq), stat = "sankeynode", position = pos2, hjust = 0, size = 4)

# 作図3（g2をベースとして、背景や凡例などを消すなどの調整を行った結果をg3に格納）
g3 <- g2 + theme_minimal() +                     # 背景を白に変更
      theme(panel.grid = element_blank(),        # グリッド線を消す
            legend.position = 'none',            # 凡例を消す
            axis.title = element_blank(),        # 軸のタイトルを消す
            axis.text.y = element_blank(),       # y軸のメモリ表示を消す
            axis.text.x = element_text(size = 15)) # x軸（カテゴリ名）はサイズ15にせよ
g3

W2.4 図1d メタゲノム系統推定結果

　入力ファイル（output_JSLAB24.xlsx）は、連載第24回のW4.4.3で作成したものです。

in_f <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/output_JSLAB24.xlsx" # 入力ファイル名

# 必要なパッケージをロード
library(openxlsx)                                # パッケージの読込
library(tidyverse)                               # パッケージの読込
library(ggsankeyfier)                            # パッケージの読込

# 入力ファイルの読み込み
hoge <- read.xlsx(in_f)                          # in_fで指定したファイルの読込

# 前処理（tibble形式への変換とフィルタリング）
data <- tibble(Phylum = hoge$Phylum,             # Phylum列の情報を列名をPhylumとしてtibble形式で格納
               Class = hoge$Class,               # Class列の情報を列名をClassとしてtibble形式で格納
               Order = hoge$Order,               # Order列の情報を列名をOrderとしてtibble形式で格納
               Family = hoge$Family,             # Family列の情報を列名をFamilyとしてtibble形式で格納
               Genus = hoge$Genus,               # Genus列の情報を列名をGenusとしてtibble形式で格納
               Species = hoge$Species,           # Species列の情報を列名をSpeciesとしてtibble形式で格納
               Freq = hoge$SRR6325813)           # SRR6325813列の情報を列名をFreqとしてtibble形式で格納
data.sub <- subset(data, Freq >= 300)            # Freq列が300以上の行のみ抽出

# 前処理（描画させたい列情報の抽出とlong型への変換
matome <- pivot_stages_longer(                   # long型データへの変換
              data = data.sub,                   # 入力はdata.sub
              stages_from = c("Phylum", "Class", "Order", "Family", "Genus", "Species"), # 描画させたいカテゴリ名情報
              values_from = "Freq")              # 頻度をカウントしたい列名情報

# 作図1（サンキー図の基本形まで作成した結果をgに格納）
pos <- position_sankey(v_space = "auto")         # 描画時の位置情報（ノード間の縦幅間隔は自動）
g <- ggplot(data = matome,                       # ggplot関数実行結果をgに格納。入力はmatomeオブジェクト
  mapping = aes(x = stage, y = Freq,             # matomeのstage列とFreq列をx軸とy軸として利用
                group = node, fill = node,       # groupとfillは、matome内のnode列で行う（変更不要）
                edge_id = edge_id,               # edge_idはmatome内のedge_id列（変更不要）
                connector = connector)) +        # connectorはmatome内のconnector列（変更不要）
  geom_sankeynode(position = pos) +              # ノード情報を追加
  geom_sankeyedge(position = pos)                # エッジ情報を追加

# 作図2-1（ノードに付随する情報を描画する際に利用する微調整用のパラメータ作成）
# y軸の高さは入力ファイルの行数次第なので、nrow(data)の何%程度上下にずらすかという感じの計算をしている
# nudge_xとnudge_yは、x軸とy軸それぞれの方向に少しずらしたい値です（nudgeは小突くという意味）
pos1 <- position_sankey(v_space = "auto",        # ノード名情報描画時の位置情報（ノード間の縦幅間隔は自動）
                        nudge_x = 0.06)          # ノード名情報描画時の位置情報（x軸情報の位置を0.06右にずらす）

# 作図2-2（基本形gをベースとして、ノードに付随する情報を追加した結果をg2に格納）
# stat = "sankeynode"は、描画するのがノード情報だという指令
# label = nodeは、描画するのがノード名だという指令
# label = Freqは、描画するのがノードに付随する頻度値だという指令
# position = pos1は、微調整用情報としてpos1を利用せよという指令
# position = pos2は、微調整用情報としてpos2を利用せよという指令
# hjust = 0は、文字を左揃えで描画せよという指令（デフォルトは中央揃え）
# size = 4は、サイズ4にせよという指令（この値に応じてnudge_yも適宜調整する）
g2 <- g + 
      geom_text(aes(label = node), stat = "sankeynode", position = pos1, hjust = 0, size = 3) 

# 作図3（g2をベースとして、背景や凡例などを消すなどの調整を行った結果をg3に格納）
g3 <- g2 + theme_minimal() +                     # 背景を白に変更
      theme(panel.grid = element_blank(),        # グリッド線を消す
            legend.position = 'none',            # 凡例を消す
            axis.title = element_blank(),        # 軸のタイトルを消す
            axis.text.y = element_blank(),       # y軸のメモリ表示を消す
            axis.text.x = element_text(size = 15, hjust = 0)) # x軸（カテゴリ名）はサイズ15にせよ
g3

W3 グラフ理論

• グラフ理論
• ggsankeyfier
  このページから見えているReference manualというところにあるggsankeyfier.pdfを開いて”edge”や”node”で文字列検索すると、多数ヒットすることがわかります。

W4 エッジの値

　図3は、以下のスクリプトをコピペ実行すれば得られます。

W4.1 図3a

　図1aとの違いは「作図2」の部分のみです。

in_f <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/JSLAB26_titanic.csv" # 入力ファイル名

# 必要なパッケージをロード
library(tidyverse)                               # パッケージの読込
library(ggsankeyfier)                            # パッケージの読込

# 入力ファイルの読み込み
data <- read_csv(in_f)                           # in_fで指定したファイルの読込

# 前処理（描画させたい列情報の抽出とlong型への変換
matome <- pivot_stages_longer(                   # long型データへの変換
              data = data,                       # 入力はdataオブジェクト   
              stages_from = c("Outcome", "Sex", "Passengers"), # 描画させたいカテゴリ名情報
              values_from = "Freq")              # 頻度をカウントしたい列名情報

# 作図1（サンキー図の基本形まで作成した結果をgに格納）
pos <- position_sankey(v_space = "auto")         # 描画時の位置情報（ノード間の縦幅間隔は自動）
g <- ggplot(data = matome,                       # ggplot関数実行結果をgに格納。入力はmatomeオブジェクト
  mapping = aes(x = stage, y = Freq,             # matomeのstage列とFreq列をx軸とy軸として利用
                group = node, fill = node,       # groupとfillは、matome内のnode列で行う（変更不要）
                edge_id = edge_id,               # edge_idはmatome内のedge_id列（変更不要）
                connector = connector)) +        # connectorはmatome内のconnector列（変更不要）
  geom_sankeynode(position = pos) +              # ノード情報を追加
  geom_sankeyedge(position = pos)                # エッジ情報を追加

# 作図2（基本形gをベースとして、エッジに付随する情報を追加した結果をg2に格納）
# v_space = "auto"は、縦幅間隔は自動にせよという指令
# direction = "forward"は、エッジの向きを順方向（左から右）で描画せよという指令
# stat = "sankeyedge"は、描画するのがエッジ情報だという指令
# label = Freqは、描画するのがエッジの値だという指令
# position = pos3は、微調整用情報としてpos3を利用せよという指令
# hjust = 0は、文字を左揃えで描画せよという指令（デフォルトは中央揃え）
# size = 4は、サイズ4にせよという指令
pos3 <- position_sankey(v_space = "auto", direction = "forward")
g2 <- g + geom_text(aes(label = Freq), stat = "sankeyedge", position = pos3, hjust = 0, size = 4)

# 作図3（g2をベースとして、背景や凡例などを消すなどの調整を行った結果をg3に格納）
g3 <- g2 + theme_minimal() +                     # 背景を白に変更
      theme(panel.grid = element_blank(),        # グリッド線を消す
            legend.position = 'none',            # 凡例を消す
            axis.title = element_blank(),        # 軸のタイトルを消す
            axis.text.y = element_blank(),       # y軸のメモリ表示を消す
            axis.text.x = element_text(size = 15)) # x軸（カテゴリ名）はサイズ15にせよ
g3

W4.2 図3b

　W4.1との違いは、「作図2」中のdirection = "backward"とhjust = 1の部分のみです。

in_f <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/JSLAB26_titanic.csv" # 入力ファイル名

# 必要なパッケージをロード
library(tidyverse)                               # パッケージの読込
library(ggsankeyfier)                            # パッケージの読込

# 入力ファイルの読み込み
data <- read_csv(in_f)                           # in_fで指定したファイルの読込

# 前処理（描画させたい列情報の抽出とlong型への変換
matome <- pivot_stages_longer(                   # long型データへの変換
              data = data,                       # 入力はdataオブジェクト   
              stages_from = c("Outcome", "Sex", "Passengers"), # 描画させたいカテゴリ名情報
              values_from = "Freq")              # 頻度をカウントしたい列名情報

# 作図1（サンキー図の基本形まで作成した結果をgに格納）
pos <- position_sankey(v_space = "auto")         # 描画時の位置情報（ノード間の縦幅間隔は自動）
g <- ggplot(data = matome,                       # ggplot関数実行結果をgに格納。入力はmatomeオブジェクト
  mapping = aes(x = stage, y = Freq,             # matomeのstage列とFreq列をx軸とy軸として利用
                group = node, fill = node,       # groupとfillは、matome内のnode列で行う（変更不要）
                edge_id = edge_id,               # edge_idはmatome内のedge_id列（変更不要）
                connector = connector)) +        # connectorはmatome内のconnector列（変更不要）
  geom_sankeynode(position = pos) +              # ノード情報を追加
  geom_sankeyedge(position = pos)                # エッジ情報を追加

# 作図2（基本形gをベースとして、エッジに付随する情報を追加した結果をg2に格納）
# v_space = "auto"は、縦幅間隔は自動にせよという指令
# direction = "backward"は、エッジの向きを逆方向（右から左）で描画せよという指令
# stat = "sankeyedge"は、描画するのがエッジ情報だという指令
# label = Freqは、描画するのがエッジの値だという指令
# position = pos3は、微調整用情報としてpos3を利用せよという指令
# hjust = 1は、文字を右揃えで描画せよという指令（デフォルトは中央揃え）
# size = 4は、サイズ4にせよという指令
pos3 <- position_sankey(v_space = "auto", direction = "backward")
g2 <- g + geom_text(aes(label = Freq), stat = "sankeyedge", position = pos3, hjust = 1, size = 4)

# 作図3（g2をベースとして、背景や凡例などを消すなどの調整を行った結果をg3に格納）
g3 <- g2 + theme_minimal() +                     # 背景を白に変更
      theme(panel.grid = element_blank(),        # グリッド線を消す
            legend.position = 'none',            # 凡例を消す
            axis.title = element_blank(),        # 軸のタイトルを消す
            axis.text.y = element_blank(),       # y軸のメモリ表示を消す
            axis.text.x = element_text(size = 15)) # x軸（カテゴリ名）はサイズ15にせよ
g3

W5 情報の細分化

W5.1 図4

　入力ファイル（JSLAB26_titanic2.csv）は、W7.3で作成しています。

in_f <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/JSLAB26_titanic2.csv" # 入力ファイル名

# 必要なパッケージをロード
library(tidyverse)                               # パッケージの読込
library(ggsankeyfier)                            # パッケージの読込

# 入力ファイルの読み込み
data <- read_csv(in_f)                           # in_fで指定したファイルの読込

# 前処理（描画させたい列情報の抽出とlong型への変換
matome <- pivot_stages_longer(                   # long型データへの変換
              data = data,                       # 入力はdataオブジェクト   
              stages_from = c("結末", "性別", "乗客"), # 描画させたいカテゴリ名情報
              values_from = "Freq")              # 頻度をカウントしたい列名情報

# 作図1（サンキー図の基本形まで作成した結果をgに格納）
pos <- position_sankey(v_space = "auto")         # 描画時の位置情報（ノード間の縦幅間隔は自動）
g <- ggplot(data = matome,                       # ggplot関数実行結果をgに格納。入力はmatomeオブジェクト
  mapping = aes(x = stage, y = Freq,             # matomeのstage列とFreq列をx軸とy軸として利用
                group = node, fill = node,       # groupとfillは、matome内のnode列で行う（変更不要）
                edge_id = edge_id,               # edge_idはmatome内のedge_id列（変更不要）
                connector = connector)) +        # connectorはmatome内のconnector列（変更不要）
  geom_sankeynode(position = pos) +              # ノード情報を追加
  geom_sankeyedge(position = pos)                # エッジ情報を追加

# 作図2-1（ノードに付随する情報を描画する際に利用する微調整用のパラメータ作成）
# y軸の高さは入力ファイルの行数次第なので、nrow(data)の何%程度上下にずらすかという感じの計算をしている
# nudge_xとnudge_yは、x軸とy軸それぞれの方向に少しずらしたい値です（nudgeは小突くという意味）
nudge_val_y <- 33                              　# y軸上の描画位置をベースラインから上下にずらしたい高さの幅情報
pos1 <- position_sankey(v_space = "auto",        # ノード名情報描画時の位置情報（ノード間の縦幅間隔は自動）
                        nudge_x = 0.06,          # ノード名情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = nudge_val_y)   # ノード名情報描画時の位置情報（y軸情報の位置をnudge_val_y上にずらす）
pos2 <- position_sankey(v_space = "auto",        # 頻度情報描画時の位置情報（ノード間の縦幅間隔は自動）
                        nudge_x = 0.06,          # 頻度情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = -nudge_val_y)  # 頻度情報描画時の位置情報（y軸情報の位置をnudge_val_y下にずらす）

# 作図2-2（基本形gをベースとして、ノードに付随する情報を追加した結果をg2に格納）
# stat = "sankeynode"は、描画するのがノード情報だという指令
# label = nodeは、描画するのがノード名だという指令
# label = Freqは、描画するのがノードに付随する頻度値だという指令
# position = pos1は、微調整用情報としてpos1を利用せよという指令
# position = pos2は、微調整用情報としてpos2を利用せよという指令
# hjust = 0は、文字を左揃えで描画せよという指令（デフォルトは中央揃え）
# size = 4は、サイズ4にせよという指令（この値に応じてnudge_yも適宜調整する）
g2 <- g + 
      geom_text(aes(label = node), stat = "sankeynode", position = pos1, hjust = 0, size = 4) + 
      geom_text(aes(label = Freq), stat = "sankeynode", position = pos2, hjust = 0, size = 4)

# 作図3（g2をベースとして、背景や凡例などを消すなどの調整を行った結果をg3に格納）
g3 <- g2 + theme_minimal() +                     # 背景を白に変更
      theme(panel.grid = element_blank(),        # グリッド線を消す
            legend.position = 'none',            # 凡例を消す
            axis.title = element_blank(),        # 軸のタイトルを消す
            axis.text.y = element_blank(),       # y軸のメモリ表示を消す
            axis.text.x = element_text(size = 15)) # x軸（カテゴリ名）はサイズ15にせよ
g3

W5.2 図5

　以下のスクリプトをコピペ実行すれば得られます。

in_f <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/JSLAB26_titanic2.csv" # 入力ファイル名

# 必要なパッケージをロード
library(tidyverse)                               # パッケージの読込
library(ggsankeyfier)                            # パッケージの読込

# 入力ファイルの読み込み
data <- read_csv(in_f)                           # in_fで指定したファイルの読込

# 前処理（描画させたい列情報の抽出とlong型への変換
matome <- pivot_stages_longer(                   # long型データへの変換
              data = data,                       # 入力はdataオブジェクト   
              stages_from = c("結末", "性別", "乗客"), # 描画させたいカテゴリ名情報
              values_from = "Freq")              # 頻度をカウントしたい列名情報

# 作図1（サンキー図の基本形まで作成した結果をgに格納）
pos <- position_sankey(v_space = "auto",         # 描画時の位置情報（ノード間の縦幅間隔は自動）
                       order = "as_is",          # 描画時の位置情報（ノード名の並びはそのまま）
                       align = "justify")        # 描画時の位置情報（カテゴリ間の高さは同じ）
g <- ggplot(data = matome,                       # ggplot関数実行結果をgに格納。入力はmatomeオブジェクト
  mapping = aes(x = stage, y = Freq,             # matomeのstage列とFreq列をx軸とy軸として利用
                group = node, fill = node,       # groupとfillは、matome内のnode列で行う（変更不要）
                edge_id = edge_id,               # edge_idはmatome内のedge_id列（変更不要）
                connector = connector)) +        # connectorはmatome内のconnector列（変更不要）
  geom_sankeynode(position = pos) +              # ノード情報を追加
  geom_sankeyedge(position = pos)                # エッジ情報を追加

# 作図3（g2をベースとして、背景や凡例などを消すなどの調整を行った結果をg3に格納）
g3 <- g + theme_minimal() +                      # 背景を白に変更
      theme(panel.grid = element_blank(),        # グリッド線を消す
            legend.text = element_text(size=12), # 凡例のサイズは12
            axis.title = element_blank(),        # 軸のタイトルを消す
            axis.text.y = element_blank(),       # y軸のメモリ表示を消す
            axis.text.x = element_text(size = 15)) # x軸（カテゴリ名）はサイズ15にせよ
g3

W6 積み上げ棒グラフとベン図

　入力ファイル（JSLAB26_titanic.csv）は、図1aのものと同じです。

in_f <- "https://www.iu.a.u-tokyo.ac.jp/kadota/book/JSLAB26_titanic.csv" # 入力ファイル名

# 必要なパッケージをロード
library(tidyverse)                               # パッケージの読込
library(ggsankeyfier)                            # パッケージの読込

# 入力ファイルの読み込み
data <- read_csv(in_f)                           # in_fで指定したファイルの読込

# 前処理（描画させたい列情報の抽出とlong型への変換
matome <- pivot_stages_longer(                   # long型データへの変換
              data = data,                       # 入力はdataオブジェクト   
              stages_from = c("Outcome", "Sex", "Passengers"), # 描画させたいカテゴリ名情報
              values_from = "Freq")              # 頻度をカウントしたい列名情報

# 作図1（サンキー図の基本形まで作成した結果をgに格納）
pos <- position_sankey()                         # 描画時の位置情報（ノード間の縦幅間隔は自動）
g <- ggplot(data = matome,                       # ggplot関数実行結果をgに格納。入力はmatomeオブジェクト
  mapping = aes(x = stage, y = Freq,             # matomeのstage列とFreq列をx軸とy軸として利用
                group = node, fill = node,       # groupとfillは、matome内のnode列で行う（変更不要）
                edge_id = edge_id,               # edge_idはmatome内のedge_id列（変更不要）
                connector = connector)) +        # connectorはmatome内のconnector列（変更不要）
  geom_sankeynode(position = pos)              # ノード情報を追加

# 作図2-1（ノードに付随する情報を描画する際に利用する微調整用のパラメータ作成）
# y軸の高さは入力ファイルの行数次第なので、nrow(data)の何%程度上下にずらすかという感じの計算をしている
# nudge_xとnudge_yは、x軸とy軸それぞれの方向に少しずらしたい値です（nudgeは小突くという意味）
nudge_val_y <- sum(data$Freq)*0.025            　# y軸上の描画位置をベースラインから上下にずらしたい高さの幅情報
pos1 <- position_sankey(nudge_x = 0.06,          # ノード名情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = nudge_val_y)   # ノード名情報描画時の位置情報（y軸情報の位置をnudge_val_y上にずらす）
pos2 <- position_sankey(nudge_x = 0.06,          # 頻度情報描画時の位置情報（x軸情報の位置を0.06右にずらす）
                        nudge_y = -nudge_val_y)  # 頻度情報描画時の位置情報（y軸情報の位置をnudge_val_y下にずらす）

# 作図2-2（基本形gをベースとして、ノードに付随する情報を追加した結果をg2に格納）
# stat = "sankeynode"は、描画するのがノード情報だという指令
# label = nodeは、描画するのがノード名だという指令
# label = Freqは、描画するのがノードに付随する頻度値だという指令
# position = pos1は、微調整用情報としてpos1を利用せよという指令
# position = pos2は、微調整用情報としてpos2を利用せよという指令
# hjust = 0は、文字を左揃えで描画せよという指令（デフォルトは中央揃え）
# size = 4は、サイズ4にせよという指令（この値に応じてnudge_yも適宜調整する）
g2 <- g + 
      geom_text(aes(label = node), stat = "sankeynode", position = pos1, hjust = 0, size = 4) + 
      geom_text(aes(label = Freq), stat = "sankeynode", position = pos2, hjust = 0, size = 4)

# 作図3（g2をベースとして、背景や凡例などを消すなどの調整を行った結果をg3に格納）
g3 <- g2 + theme_minimal() +                     # 背景を白に変更
      theme(legend.position = 'none',            # 凡例を消す
            axis.title.x = element_blank(),      # 軸のタイトルを消す
            axis.title.y = element_text(size = 15),# y軸タイトルはサイズ15にせよ
            axis.text.y = element_text(size = 10), # y軸名はサイズ10にせよ
            axis.text.x = element_text(size = 15)) # x軸（カテゴリ名）はサイズ15にせよ
g3

W7 補足（入力ファイル作成コード）

W7.1 図1aの入力ファイル

　タイタニック号沈没事故の犠牲者と生存者の内訳から、以下のような感じでべた書きで入力ファイル（JSLAB26_titanic.csv）を作成しています。

data <- NULL
# Children
data <- rbind(data, t(replicate(5, c("Survivor", "Child", "1st-class"))))
data <- rbind(data, t(replicate(1, c("Casualty", "Child", "1st-class"))))
data <- rbind(data, t(replicate(24, c("Survivor", "Child", "2nd-class"))))
data <- rbind(data, t(replicate(27, c("Survivor", "Child", "3rd-class"))))
data <- rbind(data, t(replicate(52, c("Casualty", "Child", "3rd-class"))))

# Female
data <- rbind(data, t(replicate(20, c("Survivor", "Female", "Crew"))))
data <- rbind(data, t(replicate(3, c("Casualty", "Female", "Crew"))))
data <- rbind(data, t(replicate(140, c("Survivor", "Female", "1st-class"))))
data <- rbind(data, t(replicate(4, c("Casualty", "Female", "1st-class"))))
data <- rbind(data, t(replicate(80, c("Survivor", "Female", "2nd-class"))))
data <- rbind(data, t(replicate(13, c("Casualty", "Female", "2nd-class"))))
data <- rbind(data, t(replicate(76, c("Survivor", "Female", "3rd-class"))))
data <- rbind(data, t(replicate(89, c("Casualty", "Female", "3rd-class"))))

# Male
data <- rbind(data, t(replicate(192, c("Survivor", "Male", "Crew"))))
data <- rbind(data, t(replicate(693, c("Casualty", "Male", "Crew"))))
data <- rbind(data, t(replicate(57, c("Survivor", "Male", "1st-class"))))
data <- rbind(data, t(replicate(118, c("Casualty", "Male", "1st-class"))))
data <- rbind(data, t(replicate(14, c("Survivor", "Male", "2nd-class"))))
data <- rbind(data, t(replicate(154, c("Casualty", "Male", "2nd-class"))))
data <- rbind(data, t(replicate(75, c("Survivor", "Male", "3rd-class"))))
data <- rbind(data, t(replicate(387, c("Casualty", "Male", "3rd-class"))))

# Add Freq
data <- cbind(data, rep(1, nrow(data)))
colnames(data) <- c("Outcome", "Sex", "Passengers", "Freq")

# Output
write.csv(x = data, file = "JSLAB26_titanic.csv", row.names = F)

W7.2 図1bの入力ファイル

data <- NULL
# under20
data <- rbind(data, t(replicate(5, c("20歳未満", "A病院", "薬剤1", "有効"))))
data <- rbind(data, t(replicate(8, c("20歳未満", "A病院", "薬剤1", "無効"))))
data <- rbind(data, t(replicate(2, c("20歳未満", "A病院", "薬剤1", "不明"))))
data <- rbind(data, t(replicate(2, c("20歳未満", "A病院", "薬剤2", "有効"))))
data <- rbind(data, t(replicate(2, c("20歳未満", "A病院", "薬剤2", "無効"))))
data <- rbind(data, t(replicate(10, c("20歳未満", "A病院", "薬剤2", "不明"))))
data <- rbind(data, t(replicate(2, c("20歳未満", "A病院", "偽薬", "有効"))))
data <- rbind(data, t(replicate(4, c("20歳未満", "A病院", "偽薬", "不明"))))
data <- rbind(data, t(replicate(3, c("20歳未満", "A病院", "偽薬", "無効"))))

# 成人
data <- rbind(data, t(replicate(15, c("20-65歳", "A病院", "薬剤1", "有効"))))
data <- rbind(data, t(replicate(22, c("20-65歳", "A病院", "薬剤1", "無効"))))
data <- rbind(data, t(replicate(7, c("20-65歳", "A病院", "薬剤1", "不明"))))
data <- rbind(data, t(replicate(11, c("20-65歳", "A病院", "薬剤2", "有効"))))
data <- rbind(data, t(replicate(17, c("20-65歳", "A病院", "薬剤2", "無効"))))
data <- rbind(data, t(replicate(15, c("20-65歳", "A病院", "薬剤2", "不明"))))
data <- rbind(data, t(replicate(2, c("20-65歳", "A病院", "偽薬", "有効"))))
data <- rbind(data, t(replicate(12, c("20-65歳", "A病院", "偽薬", "無効"))))
data <- rbind(data, t(replicate(10, c("20-65歳", "A病院", "偽薬", "不明"))))
data <- rbind(data, t(replicate(10, c("20-65歳", "B病院", "薬剤1", "有効"))))
data <- rbind(data, t(replicate(12, c("20-65歳", "B病院", "薬剤1", "無効"))))
data <- rbind(data, t(replicate(9, c("20-65歳", "B病院", "薬剤1", "不明"))))
data <- rbind(data, t(replicate(8, c("20-65歳", "B病院", "薬剤2", "有効"))))
data <- rbind(data, t(replicate(3, c("20-65歳", "B病院", "薬剤2", "無効"))))
data <- rbind(data, t(replicate(4, c("20-65歳", "B病院", "薬剤2", "不明"))))

# 高齢者
data <- rbind(data, t(replicate(5, c("65歳以上", "B病院", "薬剤1", "有効"))))
data <- rbind(data, t(replicate(8, c("65歳以上", "B病院", "薬剤1", "無効"))))
data <- rbind(data, t(replicate(2, c("65歳以上", "B病院", "薬剤1", "不明"))))
data <- rbind(data, t(replicate(2, c("65歳以上", "B病院", "薬剤2", "有効"))))
data <- rbind(data, t(replicate(2, c("65歳以上", "B病院", "薬剤2", "無効"))))
data <- rbind(data, t(replicate(10, c("65歳以上", "B病院", "薬剤2", "不明"))))
data <- rbind(data, t(replicate(8, c("65歳以上", "B病院", "偽薬", "無効"))))
data <- rbind(data, t(replicate(4, c("65歳以上", "B病院", "偽薬", "不明"))))

# Add Freq
data <- cbind(data, rep(1, nrow(data)))
colnames(data) <- c("年齢", "病院", "種類", "結果", "頻度")

# Output
write.csv(x = data, file = "JSLAB26_medical.csv", row.names = F)

W7.3 図4の入力ファイル

data <- NULL
# Children
data <- rbind(data, t(replicate(5, c("生存者", "1等船客の子供", "1等船客"))))
data <- rbind(data, t(replicate(1, c("犠牲者", "1等船客の子供", "1等船客"))))
data <- rbind(data, t(replicate(24, c("生存者", "2等船客の子供", "2等船客"))))
data <- rbind(data, t(replicate(27, c("生存者", "3等船客の子供", "3等船客"))))
data <- rbind(data, t(replicate(52, c("犠牲者", "3等船客の子供", "3等船客"))))

# Female
data <- rbind(data, t(replicate(20, c("生存者", "女性乗員", "乗員"))))
data <- rbind(data, t(replicate(3, c("犠牲者", "女性乗員", "乗員"))))
data <- rbind(data, t(replicate(140, c("生存者", "1等船客の女性", "1等船客"))))
data <- rbind(data, t(replicate(4, c("犠牲者", "1等船客の女性", "1等船客"))))
data <- rbind(data, t(replicate(80, c("生存者", "2等船客の女性", "2等船客"))))
data <- rbind(data, t(replicate(13, c("犠牲者", "2等船客の女性", "2等船客"))))
data <- rbind(data, t(replicate(76, c("生存者", "3等船客の女性", "3等船客"))))
data <- rbind(data, t(replicate(89, c("犠牲者", "3等船客の女性", "3等船客"))))

# Male
data <- rbind(data, t(replicate(192, c("生存者", "男性乗員", "乗員"))))
data <- rbind(data, t(replicate(693, c("犠牲者", "男性乗員", "乗員"))))
data <- rbind(data, t(replicate(57, c("生存者", "1等船客の男性", "1等船客"))))
data <- rbind(data, t(replicate(118, c("犠牲者", "1等船客の男性", "1等船客"))))
data <- rbind(data, t(replicate(14, c("生存者", "2等船客の男性", "2等船客"))))
data <- rbind(data, t(replicate(154, c("犠牲者", "2等船客の男性", "2等船客"))))
data <- rbind(data, t(replicate(75, c("生存者", "3等船客の男性", "3等船客"))))
data <- rbind(data, t(replicate(387, c("犠牲者", "3等船客の男性", "3等船客"))))

# Add Freq
data <- cbind(data, rep(1, nrow(data)))
colnames(data) <- c("結末", "性別", "乗客", "Freq")

# Output
write.csv(x = data, file = "JSLAB26_titanic2.csv", row.names = F)