Rで解析：３要素の関係を示す！三角ダイアグラムをプロット「ggtern」パッケージ

3要素の相対的な割合を表現する図として薬学、化学、遺伝学、ゲーム理論、鉱物学などでは三角ダイアグラム(ternary diagrams)が利用されています。大変有効な表現方法だと思います。

「ggplot2」システムを利用して三角ダイアグラムを手軽にプロットできる「ggtern」パッケージを紹介します。かなり多くのコマンドが収録されているだけでなく、細かい体裁の調整が可能です。

パッケージバージョンは3.4.1。windows11のR version 4.2.2で確認しています。

パッケージのインストール

#パッケージのインストール
install.packages("ggtern")

実行コマンド

詳細はコメント、パッケージのヘルプを確認してください。

#ライブラリの読み込み
library("ggtern")

###データ例の作成#####
#tidyverseパッケージがなければインストール
if(!require("tidyverse", quietly = TRUE)){
  install.packages("tidyverse");require("tidyverse")
}
#viridisパッケージがなければインストール
if(!require("viridis", quietly = TRUE)){
  install.packages("viridis");require("viridis")
}
set.seed(1234)
TestData <- tibble(X = runif(30),
                   Y = runif(30),
                   Z = runif(30))
########

#三角ダイアグラムの基本を作成:ggternコマンド
TerDia <- ggtern(data = TestData, aes(X, Y, Z))
#内容確認
#TerDia

#TerDiaに「geom_point」「geom_line」を追加
TerDiaPoint <- TerDia +
  geom_point(col = "blue") +
  geom_line(col = "red")
#三角ダイアグラムの基本が完成
#以降「TerDiaPoint」を調整していきます
TerDiaPoint

#収録テーマを紹介
TerDiaPoint +
  #青緑茶の色合いを適応:theme_rgbwコマンド
  theme_rgbw() + 
  #他の色合いのテーマ
  #theme_gray(),theme_dark(),theme_rgbg(),
  #theme_tropical(),theme_bluedark(),theme_bluelight(),
  #theme_bvbw(),theme_bvbg()
  
  #矢印長さを調整:theme_arrowlengthコマンド1
  #開始,終了:startオプション;0-1,初期値:getOption("tern.arrow.start")
  #finishオプション;0-1,初期値:getOption("tern.arrow.start")
  theme_arrowlength(start = 0.5, finish = 1)
  #以下矢印に関するテーマ
  #theme_arrowsmall(),theme_arrowshort(),theme_arrownormal(),
  #theme_arrowdefault(),theme_arrowlarge()
  
#指定した辺から線を引く:geom_Tline/geom_Lline/geom_Rlineコマンド
#開始位置:T|L|Rinterceptオプション;0-1
#矢印設定:arrowオプション;ggplot2::arrow()コマンドと組み合わせる
TerDiaPoint +
  #左から右側:geom_Tlineコマンド
  geom_Tline(Tintercept = .5, arrow = ggplot2::arrow(),
             colour = "yellow", size = 1.5) +
  #底辺から右側:geom_Llineコマンド
  geom_Lline(Lintercept = .2, arrow = ggplot2::arrow(),
             colour = "#4b61ba", size = 1.5) +
  #右側から底辺:geom_Rlineコマンド
  geom_Rline(Rintercept = .1, arrow = ggplot2::arrow(),
             colour = "#a87963", size = 1.5)

#データ分布をグラデーションで表示:stat_density_ternコマンド
#変換方式:baseオプション;identity:直接的なデカルト空間,
#ilr:アイソメトリック対数比
ggtern(data = TestData, aes(X, Y, Z)) +
  stat_density_tern(geom = "polygon",
                    aes(fill = ..level..),
                    base = "ilr") +
  scale_fill_viridis()

#データ分布を六角形で表示:stat_geom_hex_ternコマンド
#ビンを設定:binwidthオプション;0-1
TerDiaPoint +
  geom_hex_tern(binwidth = 0.1) +
  scale_fill_viridis()
               
#図を回転:theme_rotateコマンド
#度数:degreesオプション
TerDiaPoint + 
  theme_rotate(degrees = 90)

#外周に矢印を追加:theme_showarrowsコマンド
TerDiaPoint +
  theme_showarrows()

#各外周矢印のラベル名を変更:Tarrowlab/Larrowlab/Rarrowlabコマンド
TerDiaPoint +
  theme_showarrows() +
  #右側
  Tarrowlab(label = "からだに") +
  #左側
  Larrowlab(label = "いいもの") +
  #底辺側
  Rarrowlab(label = "たまに更新") 

#各頂点のラベル名を変更:Tlab/Llab/Rlabコマンド
TerDiaPoint +
  #上
  Tlab(label = "からだに") +
  #左下
  Llab(label = "いいもの") +
  #右下
  Rlab(label = "たまに\n更新") 

#各シンボルから各辺へ線を引く:geom_Tmark,_Lmark,_Rmark,_crosshair_ternコマンド
TmTerDiaPoint <- TerDiaPoint + geom_Tmark(col = "#4b61ba") + 
  labs(title = "geom Tmark")
LmTerDiaPoint <- TerDiaPoint + geom_Lmark(col = "#a87963") +
  labs(title = "geom Lmark")
RmTerDiaPoint <- TerDiaPoint + geom_Rmark(col = "#505457") + 
  labs(title = "geom Rmark")
CHTerDiaPoint <- TerDiaPoint + geom_crosshair_tern(col = "#deb7a0") +
  labs(title = "geom chrosshair tern")
#内容確認
grid.arrange(TmTerDiaPoint, LmTerDiaPoint, RmTerDiaPoint, CHTerDiaPoint)

#各頂点から線を引く:geom_Tisoprop,geom_Lisoprop,geom_Risopropコマンド
#位置を指定:valueオプション
TpTerDiaPoint <- TerDiaPoint +
  geom_Tisoprop(col = "#4b61ba", value = c(.4, .6)) +
  labs(title = "geom Tisoprop")
LpTerDiaPoint <- TerDiaPoint +
  geom_Lisoprop(col = "#a87963", value = c(.4, .6)) +
  labs(title = "geom Lisoprop")
RpTerDiaPoint <- TerDiaPoint +
  geom_Risoprop(col = "#505457", value = c(.4, .6)) +
  labs(title = "geom Risoprop")
TLRTerDiaPoint <- TerDiaPoint +
  geom_Tisoprop(col = "#4b61ba", value = c(.4, .6)) +
  geom_Risoprop(col = "#505457", value = c(.4, .6)) +
  geom_Lisoprop(col = "#a87963", value = c(.4, .6)) +
  labs(title = "ALL isoprop")
#確認
grid.arrange(TpTerDiaPoint, LpTerDiaPoint, RpTerDiaPoint, TLRTerDiaPoint)