はじめに
これはある意味「エクセルでモザイク画を作ってみた」とか「マインクラフトのゲーム内で計算機を作った」と同類の余興である (そしてスケールの観点からはこれらよりもだいぶ見劣りする). しかしもしかしたらこれを読んでるあなたも将来, 武装勢力に拘束され尋問され「RユーザならRグラフィックスで格ゲーのコマンド表を作ってみろ」と言われる1こともあるかもしれないからノウハウを公開する.
実際に作成したページは以下.
https://under-identified.hatenablog.com/entry/2021/05/04/184614under-identified.hatenablog.com
大まかな流れ
既存の格ゲーにあるようなボタンのアイコンつきで一覧表を作ってみたかった. そこで以下のようにした.
操作キーのアイコンを作る
すでに書いたように, はてなブログで大量の画像を扱うと操作が複雑になる (一応APIはある) ので, SVG 画像を直接埋め込むことにした.
お絵描きをするのは ggplot2 本来の用途ではないが, 比較的簡単に作れそうなので ggplot2 で 作成した. 以下がその抜粋である. このように, 画像そのものは ggplot2 の関数だけで描画できる.
require(tidyverse) d <- tibble( icon_num = factor(1:4, levels = 1:5), xbox = c("X", "Y", "A", "B"), key = c("T", "Y", "G", "H"), ps = c("□", "△", "❌", "○"), x = c(0, 1, 0, 1), y = c(1, 1, 0, 0) ) d_direction <- tibble( icon_num = factor(1:4, levels = 1:5), xbox = c("U", "D", "L", "R"), key = c("U", "D", "L", "R"), x = c(.5, .5, 0, 1), y = c(1, 0, .5, .5) ) d_direction %>% mutate(xbox := key %in% "D") %>% ggplot( aes( xend = x, x = 0.5, yend = y, y = .5, color = xbox ) ) + geom_segment(arrow = arrow(length = unit(20, units = "mm"), type = "closed"), lineend = "butt", size = 10, linejoin = "mitre") + scale_color_manual(guide = F, breaks = c(T, F), values = c("black", "grey")) + coord_fixed(xlim = c(0 -1/.pt, 1 + 1/.pt), ylim = c(0 - 1/.pt, 1 + 1/.pt)) + theme_void()
当初は文書のコンパイル時に都度画像を生成する予定だったが, 意外と処理時間がかかるのと, 使用されるキーはかなり限られるため, 予め必要な画像を全て作って保存しておいてから, キーの名前に対応して画像を読み込む関数を作ることにした. 画像の保存にはもちろん svglite パッケージを使用している. このような画像になる (ちょっと不格好だが気にしないでほしい).
あとは技名やコマンドの対応表を用意しておいて (これはゲーム中のスクリーンショットを元に書き起こすしかなかった), それを gt でアイコン付きの表にしてやればよい, そのはずだった….
gt が HTML タグをエスケープしてしまう
今回コマンド表を作る Hellish Quart というゲームでは特定のボタン操作でキャラクターのコマンド一覧ががらりと変わることがある. そのため, 1つのキャラクターのコマンド表内で, さらにコマンドを分類したほうが見やすい. その上で, 分類した見出しに, トリガーとなるボタンのアイコンもあればなお見やすいだろう.
しかし gt ではここにプレーンテキストしか使えなさそうである. これは R-Wakalang でも以前コメントしたことがある. gt は表の見出しやセルの値に HTML や Markdown 構文を使う変換用の関数がある. しかし group_by() または gt(..., groupname_col = ) でグループ化した時の, グループ名の見出しにそういう構文を埋め込む機能が用意されていない.
例えば以下のようにエスケープされてしまい, HTML タグとして機能しない.
d <- data.frame(x = rep(sprintf("<b>グループ%s</b>", 1:2), 2), y = 1:4) group_by(d, x) %>% gt()
| y |
|---|
| <b>グループ1</b> |
| 1 |
| 3 |
| <b>グループ2</b> |
| 2 |
| 4 |
既存の関数では rowname を指定して tab_row_group(label = ) に htmltools::html() などを使うことができるが, それだと今度は行名が強制的に表示されたままになってしまうほか, 使いづらい点がある.
結局いろいろ試した結果, gt_tbl オブジェクトの値を改ざんすることで対処するしかなさそうだった.
具体的には, _stub_df という要素に見出しが tbl 形式で格納されており, その中の group_label という列が実際に表示される見出しになるので, これを上書きする.
g <- group_by(d, x) %>% gt() g[["_stub_df"]][["group_label"]] <- map(g[["_stub_df"]][["group_label"]], ~html(.x)) g
| y |
|---|
| グループ1 |
| 1 |
| 3 |
| グループ2 |
| 2 |
| 4 |
この変換処理を含めた関数は以下のようになった. 入力の mode という列がグループ変数に対応する. リストとして代入する必要があるので purrr::map() を使っている点に注意.
to_table <- function(d, lr = F){ t <- d %>% mutate( name = paste(name_orig, paste0("<br>(", name, ")")), mode = factor(mode, levels = c("normal", "long", "lift", "high", "iron", "misc")) ) %>% dplyr::select(-name_orig) if(lr){ t <- t %>% mutate( common = is.na(lr), lr = if_else(common, "l", lr)) %>% pivot_wider(id_cols = c(mode, name, common), names_from = lr, values_from = command) %>% mutate(l = if_else(is.na(l), "x", l), r = if_else(common, "", if_else(is.na(r), "x", r))) %>% dplyr::select(-common) %>% mutate(across(c(l, r), replace_keys)) } else{ t <- dplyr::select(t, -one_of("lr")) %>% mutate(command = replace_keys(command)) } t <- t %>% arrange(mode) %>% group_by(mode) %>% gt() # HTMLをエスケープする方法として tab_row_group を使うものがあるが, rownames が表示されたままになる # 存在しないグループを指定するとエラー # よって内部データを改ざんするしかない g_headings <- list( normal = "通常時", long = "ロングガード時 - [スペース] 押しっぱなし", lift = "剣を立てている時 - [スペース] 押しっぱなし", iron = html( sprintf("「鉄の門」の構え時 - %s + [スペース] 押しっぱなし", paste(readLines("img/D.svg"), collapse = "\n")) ), high = html( sprintf("「上段」の構え時 (%s + [スペース] 押しっぱなし)", paste(readLines("img/U.svg"), collapse = "\n")) ), misc = html(" ") ) t$`_stub_df`[["group_label"]] <- map(t$`_stub_df`[["group_label"]], ~html(g_headings[[.x]])) if(lr){ t <- t %>% cols_label(name = "名称", l = "左足が前", r = "右足が前") %>% tab_spanner("コマンド", columns = c("l", "r")) %>% fmt_markdown(c("l", "r")) } else { t <- t %>% fmt_markdown(columns = "command") %>% cols_label(name = "名称", command = "コマンド") } t %>% fmt_markdown(columns = "name") %>% fmt_markdown(columns = "mode") }
アップロード
これだけ出力を整えれば, 後は R Markdown で HTML として生成することができる. そしてその気になれば Rpubs に投稿することもできる…
と言いたいところだが, 実はまだ良くわからない不具合がある. SVG をインラインで埋め込んでいると, たまに SVG の中に <p> タグが挟まってしまう. 特定できてはいないが pandoc のバグのような気がする. 今回はもう忙しいので手動で消した.
さらに細かい話
最近のはてなブログは記事あたり64万字を超えると「文字数が多すぎる」ということで投稿できない. 今回は画像を SVG 形式で貼り付けていたのと, gt パッケージが出力する HTML がかなり冗長であったのが原因でこの64万字制限に引っかかってしまった.
gt パッケージは, 特にCSSの記述がかなり冗長であり, 共通箇所も多い CSS を大量に吐き出す. そしてそれは表1つ1つに対してなされる. 結果的にこれを削除することで10万字くらい削減できた. しかし gt パッケージには「CSS を一切出力しない」というオプションは存在しないようだ. かといって毎回手作業で削除する (この記事は今後何度も更新する可能性が高い) のもヒューマンエラーの温床でしかなくばからしいので, 結局 xml2 パッケージを使用して <style>...</style> だけを削除する関数を自作した.
# gt から不要なHTMLタグを削除する plain_html_table <- function(gt){ x <- as_raw_html(gt, inline_css = F) %>% xml2::read_html() xml2::xml_remove(xml2::xml_find_all(x, "//style")) xml2::xml_child(xml2::xml_child(x)) %>% paste(collapse = "") %>% knitr::raw_html() }
こういう操作はたまにしかしないので, もっとスマートな方法があるかもしれない.
今回の対象となった “Hellish Quart” はまだアルファ版であり, 現在も新キャラクターが開発中である. よってさらにキャラクターが増えるとまた文字数制限に引っかかる可能性が高いので, さらなる改善の余地がある.
SVG 画像も共通部分が多いのでもう少し削減できそうな気がする.
2021/11/5 追記: よく調べたらSVG画像は <symbol></symbol>タグで登録して <use></use>タグで使い回せるらしい. これで上記の文字数制限は気にする必要はなさそうだ.
