Rで総当たり戦などの組み合わせデータを tidy に扱う
Katagiri, Satoshi (片桐 智志)
概要
- 先日, R-wakalang でそういう質問があったのでもう一度まとめた.
- 1年に1回くらいの頻度で自分も似たようなことをすることがあるがそのたびに何か便利なパッケージがないかと探すも見つからないやつ
はじめに
タイトルに書いたように, 何かのスポーツ競技の対戦を総当たり戦で行った結果, あるいは相関行列など, 組み合わせまたは (重複) 順列を表現するデータを R で扱うときの方法について書く. 単に行列の形で全ての結果が与えられた場合は特に難しくないのでわざわざ説明する意義はほとんどないが, 今回きっかけとなった質問ではそうでない, 少し厄介なケースである. しかし私も似たようなことをする必要が過去にあったのでこの問題について書いてみる.
問題設定と解決法
要件
今回の回答例の再現に必要なのは, 入力データの加工に関しては tidyverse の現時点で最新のバージョン (dplyr v1.0.6, tibble v3.1.2, tidyr v1.1.3, stringr 1.4.0, forcats v0.5.1, purrr v0.3.4) のみ. グラフの作成には ggplot2 (v3.3.5) が必要. また, 計算量の削減やコードの短さに特化したものではない (それぞれの基準での最適解はおそらく別に存在する). しいて言うなら「tidyverse を使って書く上での見通しの良さ」をなんとなく重視した例である.
ペアに対してスコアが1つの場合
今回は特に, 元の質問者の意図を反映して, 組み合わせの重複する部分を削除したデータフレームが与えられている場合をまず考える.
(
d <- data.frame(
comb = c("AA", "AB", "AC", "AD", "DB", "DC", "BC", "BB", "CC", "DD"),
score = c(5, 3, 1, 1, 2, 4, 4, 4, 5, 5)
)
)## comb score
## 1 AA 5
## 2 AB 3
## 3 AC 1
## 4 AD 1
## 5 DB 2
## 6 DC 4
## 7 BC 4
## 8 BB 4
## 9 CC 5
## 10 DD 5この comb 列の2文字は A-D の4つの組み合わせ1を表している (以降これを ID と呼ぶ). この ID は競技会の選手名でもチーム名でも好きなものに置き換えて考えれば良い. この ID のペアごとのスコア (score 列) をマトリクス状のヒートマップで表現したい, というのが今回の問題設定.
結論から言うと, こういった形式のデータを変換することを目的としたパッケージは見つけられなかったため, tidyverse の関数を使って変換する方法を紹介する. (私の知らない分野ではこういうフォーマットで扱うのが習慣になっているのかもしれないが, 私が知らないことは知りようがない.)
となると comb の組み合わせを分解して2つの変数にする必要があるが, 単に comb を2つのID列に分割するだけではうまくいかない2. 例えば以下のように, 直接 comb の1文字目と2文字目を var1, var2 に分割する (おそらく質問者が当初得た結果?) と, 以下のように行列が三角配置にならない.
d2 <- mutate(
d,
var1 = substr(comb, 1, 1),
var2 = substr(comb, 2, 2)
)
ggplot(
d2,
aes(x = var1, y = var2, fill = score, label = score)
) + geom_tile() +
geom_text(color = "white") +
scale_y_discrete(limits = rev)
以下は私が当初提案した回答例から少し調整したもの. comb を各要素ごとにソートする (例: BA を AB にする) ことで, 三角行列状に配置されない問題を解決するというものである. ここでは map_chr() を使って要素ごとにソートをしている3
d_tidy <- mutate(
d,
comb = map_chr(str_split(comb, ""), ~paste(sort(.), collapse = "")),
var1 = substr(comb, 1, 1),
var2 = substr(comb, 2, 2)
)この時点で, d_tidy は ggplot2 などで扱いやすい tidy な形式となる. なお, もし入力データの時点で重複がある (例: comb に AB, BA 両方ある) 場合は, データに矛盾がない限りは, この直後に unique() を使えば重複を削除できる.
さらに微修正して図にする.
# AA, BB など対角成分がない場合を想定, この例では結果にあまり影響なし
d_tidy <- with(
d_tidy,
expand_grid(
var1 = unique(c(var1, var2)),
var2 = unique(c(var1, var2))
)
) %>%
left_join(d_tidy, on = c("var1", "var2")) %>%
mutate(var1 = fct_inorder(var1), var2 = fct_inorder(var2))## Joining, by = c("var1", "var2")g <- ggplot(
d_tidy,
aes(x = var1, y = var2, fill = score, label = score)
) +
geom_tile() +
geom_label(fill="white")
g## Warning: Removed 6 rows containing missing values (geom_label).
comb を分解しているのは str_split() の部分なので, 例えばもし comb 列が A-A, A-B のようにハイフンで分けられているなら str_split(comb, "-") とすることで区切ることができる.
もう少し見た目にこだわってみる. 上図は,
- 行列が左下を基準としているが, この手のマトリクスは右上か左下に揃えることが多い
- 得点の大きな数値ほど, 色が薄くなっている
- 正方形になっていない
- “var1,” “var2” というラベルは不要
- 凡例も不要
- 背景のグリッドも不要
ので, 見づらいかもしれない. これらも比較的簡単に修正できる (右上に揃えたい場合はさかのぼって x = var2, y = var1 を指定するか, coord_trans を使いかつ limits = rev を x 軸のスケールに使用する.). なおこの設定はこのあとの用例でも使い回せるように1つのオブジェクトにまとめておく.
design <- list(
scale_x_discrete(position = "top"),
scale_y_discrete(limits = rev),
scale_fill_distiller(guide = "none", direction = 1),
coord_fixed(),
theme_minimal(),
theme(axis.title = element_blank(), panel.grid = element_blank())
)
g + design## Warning: Removed 6 rows containing missing values (geom_label).
むしろマス目が描かれてないと不安ならば, 以下のように geom_tile(color = "black") を追加するとよい.
ggplot(
d_tidy,
aes(x = var2, y = var1, fill = score, label = score)
) +
geom_tile(color = "black") +
geom_label(fill = "white") +
design## Warning: Removed 6 rows containing missing values (geom_label).
また, ID が A, B, C, D ではなかったり (例えば選手名とかチーム名とか), 任意の並び順にしたい場合は, var1, var2 を factor 型に変更する必要があるだろう.
双行列である場合
次のケース. 対戦結果ならば, IDの組み合わせに対応する値もまた組み合わせになっているかもしれない. つまり, 以下のような双行列4で表せるようなデータの対処法を考えてみる.
\[ \begin{bmatrix} & (1, 2) & (1, 1) \\ (2, 1) & & (1, 4) \\ (1, 1) & (4, 1) \end{bmatrix} \]
そうなると上記のように ID の組み合わせのみ分解するのでは不十分である. テキストデータなどから取り込んだ想定で, 対戦結果が文字で与えられていることにしてみる. 最初のデータセットを改変したサンプルを使う.
(
d <- data.frame(
comb = c("A-B", "A-C", "A-D", "D-B", "D-C", "B-C"),
score = c("1-5", "3-2", "3-3", "1-1", "1-0", "10-1")
)
)## comb score
## 1 A-B 1-5
## 2 A-C 3-2
## 3 A-D 3-3
## 4 D-B 1-1
## 5 D-C 1-0
## 6 B-C 10-1最初の例のように comb の ID の順序だけを変えた場合, score との対応がおかしくなるので方法を変える必要がある. (もうすこしシンプルな方法がありそうな気がするが) 先ほどの例と同じように comb の ID の順序を調整して変化があれば score の順序も調整するという処理ににした.
(
d_reordered <- d %>% mutate(
comb2 = map_chr(str_split(comb, "-"), ~paste(sort(.), collapse = "-")),
score = if_else(comb == comb2, score, map_chr(str_split(score, "-"), ~paste(.[2], .[1], sep="-"))),
score1 = map_dbl(str_split(score, "-"), ~as.numeric(.[1])),
score2 = map_dbl(str_split(score, "-"), ~as.numeric(.[2])),
var1 = map_chr(str_split(comb2, "-", ), ~.[1]),
var2 = map_chr(str_split(comb2, "-"), ~.[2])
)
)## comb score comb2 score1 score2 var1 var2
## 1 A-B 1-5 A-B 1 5 A B
## 2 A-C 3-2 A-C 3 2 A C
## 3 A-D 3-3 A-D 3 3 A D
## 4 D-B 1-1 B-D 1 1 B D
## 5 D-C 0-1 C-D 0 1 C D
## 6 B-C 10-1 B-C 10 1 B Cあとはスカラの場合とほとんど同じ. ただしスコアの順序で誤解を招かないよう注意が必要で, ここでは aes(x = var2, y = var1) になっている.
d_tidy <- with(
d_reordered,
expand_grid(
var1 = unique(c(var1, var2)),
var2 = unique(c(var1, var2))
)
) %>%
left_join(d_reordered, on = c("var1", "var2")) %>%
mutate(var1 = fct_inorder(var1), var2 = fct_inorder(var2))## Joining, by = c("var1", "var2")g <- ggplot(
d_tidy,
aes(x = var2, y = var1, fill = score, label = score)
) +
geom_tile() +
geom_label(fill="white") +
scale_y_discrete(limits = rev)
g## Warning: Removed 10 rows containing missing values (geom_label).
これだと色分けの意味がほぼないので得点差で色分けしてみる (ついでにデザインも調整する)
g <- ggplot(
mutate(d_tidy, diff = abs(score1 - score2)),
aes(x = var2, y = var1, fill = diff, label = score)
) +
geom_tile() +
geom_label(fill = "white")
g + design +
labs(title = "対戦結果")## Warning: Removed 10 rows containing missing values (geom_label).
三角成分だけでなく全面埋めたいなら, 例えば以下のようにする.
(
d_full <-
with(d_reordered, expand_grid(var1 = unique(c(var1, var2)), var2 = unique(c(var1, var2)))) %>%
left_join(
bind_rows(
d_reordered,
rename(d_reordered, var1 = var2, var2 = var1, score1 = score2, score2 = score1)
) %>% dplyr::select(-comb, -comb2, -score),
by = c("var1", "var2")
)
)## # A tibble: 16 x 4
## var1 var2 score1 score2
## <chr> <chr> <dbl> <dbl>
## 1 A A NA NA
## 2 A B 1 5
## 3 A C 3 2
## 4 A D 3 3
## 5 B A 5 1
## 6 B B NA NA
## 7 B C 10 1
## 8 B D 1 1
## 9 C A 2 3
## 10 C B 1 10
## 11 C C NA NA
## 12 C D 0 1
## 13 D A 3 3
## 14 D B 1 1
## 15 D C 1 0
## 16 D D NA NAggplot(d_full,
aes(x = var2, var1,
fill = abs(score1 - score2),
label = if_else(is.na(score1), NA_character_, paste(score1, score2, sep = "-"))
)
) +
geom_tile() +
geom_label(color = "white") +
geom_abline(intercept = length(unique(d_full$var1)) + 1, slope = -1, color = "white") +
design +
scale_fill_continuous(name = "得点差") +
theme(legend.position = "bottom") +
labs(title = "予選Xブロックの試合結果")## Scale for 'fill' is already present. Adding another scale for 'fill', which
## will replace the existing scale.## Warning: Removed 4 rows containing missing values (geom_label).
入力の時点で行列になっている場合
別の状況として考えられるのは, これまでの例のようにIDの組み合わせに縮約されたデータフレームではなく, 結果が最初から行列として与えられている場合である. 例えば総当たり戦の試合結果が xlsx ファイルで書かれた表で与えられたとか, 行列形式で与えられたほうがおそらく簡単だと思う. というかこちらのほうが自然なので, よっぽど組み合わせが膨大で圧縮しないと扱うのが大変である場合を除いて, 変に加工してよこさないようお願いしたほうが良いだろう.
set.seed(42)
m <- cor(data.frame(A = rnorm(10), B = rnorm(10), C = rnorm(10), D = rnorm(10)))
m## A B C D
## A 1.0000000 -0.3749289 0.44005103 -0.40371575
## B -0.3749289 1.0000000 -0.15334380 0.46477742
## C 0.4400510 -0.1533438 1.00000000 -0.06002371
## D -0.4037158 0.4647774 -0.06002371 1.00000000ここまでで紹介したように ggplot2 の geom_tile() で描画したい場合は, pivot_longer で変換する. また, 三角成分だけにしたい場合は lower.tri(m) <- NA または upper.tri(m) <- NA を使用する.
(
d_longer <- m %>% as.data.frame %>% rownames_to_column() %>%
pivot_longer(cols = -rowname)
)## # A tibble: 16 x 3
## rowname name value
## <chr> <chr> <dbl>
## 1 A A 1
## 2 A B -0.375
## 3 A C 0.440
## 4 A D -0.404
## 5 B A -0.375
## 6 B B 1
## 7 B C -0.153
## 8 B D 0.465
## 9 C A 0.440
## 10 C B -0.153
## 11 C C 1
## 12 C D -0.0600
## 13 D A -0.404
## 14 D B 0.465
## 15 D C -0.0600
## 16 D D 1ggplot(d_longer, aes(x = rowname, y = name, fill = value, label = round(value, 2))) +
geom_tile() + geom_label(fill = "white") +
design
ただし, 行列の図示に関しては専用の関数・パッケージがいくつか存在する.
例えば基本パッケージの stats::heatmap は行列をもとにヒートマップを表示し, 相関係数の大きい組み合わせをデンドログラム (樹形図) で強調する. ただしこの例だとその効果がわかりにくい.
heatmap(m)
このタイプのグラフは相関係数や混同行列 (confusion matrix) のヒートマップ表示に使われるため, 特定の用途に特化したパッケージが複数存在する.5
自分で組み合わせを生成したい時
既に使用しているように, ID の全てのペアの組み合わせ (重複順列) を生成するには tidyr::expand_grid() が便利だろう. 重複や同じIDのペアを除外したいなら, combn(n, 2) で permutation \(\binom{n}{2}\) 通りの順列に対応する行列を出力することができる.
combn(LETTERS[1:4], 2)## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] "A" "A" "A" "B" "B" "C"
## [2,] "B" "C" "D" "C" "D" "D"これは matrix なので転置してデータフレームに変換すると使いやすい.
このケースでは AA, BB なども含まれるので正確には順列になるが, どちらも同じ方法で可能.↩︎
元の質問者が「試してみたがうまくいかなかったコード」はそもそも私の環境では再現できなかったが, おそらく tidyr のバージョン違いが原因だろう. 回答の本筋とは関係ないためこの問題の追及はしない.↩︎
rowwise()を使うとかmapの時点では行列として保持しておくとかいろいろバリエーションは思いつくが, 大まかな流れとしては要素ごとに組み合わせIDのソートが必要.↩︎ところで双行列 (bimatrix) で検索してもゲーム理論関連の話ばかり現れるのだが, これは一般的に数学で使われている用語ではないのだろうか?↩︎
今回のテーマから少しずれるが, 相関関係の可視化に関して言えば,
pairs()GGally::ggpairsなど, データフレームから散布図行列を表示する関数もある.↩︎