R Markdownで表を作成するときに便利なのが、kableとkableExtraパッケージです。これらを使うと、見やすい表にフットノートを簡単に追加できます。
その際、footnote_marker_〇〇()
関数を使うと、脚注マーカーとして数字・記号・アルファベットを指定できます。
しかし、アルファベットマーカーは通常「a → z」方向に付与されるため、「z → aの逆順でマーカーを付けたい」と思った方もいるかもしれません。
今回は、footnote_marker_alphabet()
とfootnote()
関数を改造してPDF出力時にフットノートマーカーを z から a の順で表示する方法を紹介します。
ソースコードを確認
まずは、footnote_marker_alphabet()
とfootnote()
関数の内部処理を理解するために、kableExtraのソースコードを確認します。
footnote_marker_alphabet()
とfootnote_table_maker()
関数では、アルファベットマーカーを付与する際にletters を参照しています。
footnote_marker_alphabet <- function(x, format, double_escape = FALSE) {
if (missing(format) || is.null(format)) {
if (knitr::is_latex_output()) {
format <- "latex"
} else {
format <- "html"
}
}
if (is.numeric(x)) x <- letters[x]
if (format == "html") {
return(paste0("<sup>", x, "</sup>"))
} else if (!double_escape) {
return(paste0("\\textsuperscript{", x, "}"))
} else {
return(paste0("\\\\textsuperscript{", x, "}"))
}
}
footnote_table_maker <- function(format, footnote_titles, footnote_contents,
symbol_manual) {
if (is.null(symbol_manual)) {
number_index <- read.csv(system.file("symbol_index.csv",
package = "kableExtra"))
if (format == "latex") {
symbol_index <- number_index$symbol.latex
} else {
symbol_index <- number_index$symbol.html
}
} else {
symbol_index <- symbol_manual
}
if (!is.null(footnote_contents$general)) {
footnote_contents$general <- data.frame(
index = "",
footnote = footnote_contents$general
)
}
if (!is.null(footnote_contents$number)) {
footnote_contents$number <- data.frame(
index = as.character(1:length(footnote_contents$number)),
footnote = footnote_contents$number
)
}
if (!is.null(footnote_contents$alphabet)) {
footnote_contents$alphabet <- data.frame(
index = letters[1:length(footnote_contents$alphabet)],
footnote = footnote_contents$alphabet
)
}
if (!is.null(footnote_contents$symbol)) {
footnote_contents$symbol <- data.frame(
index = symbol_index[1:length(footnote_contents$symbol)],
footnote = footnote_contents$symbol
)
}
out <- list()
out$contents <- footnote_contents
out$titles <- footnote_titles
return(out)
}
このベクトルを単純に rev()
関数で反転させることでz → a 方向へのマーカー付与が可能になりそうです。
書き換え
新しいスクリプトを用意して、kableExtra
の内部関数を.GlobalEnv
にロード
# 全内部関数をグローバル環境にロード
invisible(
lapply(
ls(namespace <- getNamespace("kableExtra"),
all.names = TRUE),
function(f) assign(f,
get(f, envir = namespace),
envir = .GlobalEnv)
)
)
次に、元関数と競合を避けるためにfootnote_marker_alphabet_rev
として関数を定義し、lettersをrev(letters)
に変更
#
footnote_marker_alphabet_rev <- function(x, format, double_escape = FALSE) {
if (missing(format) || is.null(format)) {
if (knitr::is_latex_output()) {
format <- "latex"
} else {
format <- "html"
}
}
if (is.numeric(x)) x <- rev(letters)[x]
if (format == "html") {
return(paste0("<sup>", x, "</sup>"))
} else if (!double_escape) {
return(paste0("\\textsuperscript{", x, "}"))
} else {
return(paste0("\\\\textsuperscript{", x, "}"))
}
}
同じように、footnote_rev
を定義して、footnote_table_maker
をrev(letters)
をセットしたfootnote_table_maker_revに入れ替え
footnote_rev <- function(kable_input,
general = NULL,
number = NULL,
alphabet = NULL,
symbol = NULL,
footnote_order = c("general", "number",
"alphabet", "symbol"),
footnote_as_chunk = FALSE,
escape = TRUE,
threeparttable = FALSE,
fixed_small_size = FALSE,
general_title = "Note: ",
number_title = "",
alphabet_title = "",
symbol_title = "",
title_format = "italic",
symbol_manual = NULL
) {
kable_format <- attr(kable_input, "format")
if (kable_format %in% c("pipe", "markdown")) {
kable_input <- md_table_parser(kable_input)
kable_format <- attr(kable_input, "format")
}
if (!kable_format %in% c("html", "latex")) {
warning("Please specify format in kable. kableExtra can customize either ",
"HTML or LaTeX outputs. See https://haozhu233.github.io/kableExtra/ ",
"for details.")
return(kable_input)
}
if (length(alphabet) > 26) {
alphabet <- alphabet[1:26]
warning("Please don't use more than 26 footnotes in table_footnote ",
"alphabet. Use number instead.")
}
if (length(symbol) > 20) {
symbol <- symbol[1:20]
warning("Please don't use more than 20 footnotes in table_footnote ",
"symbol. Use number instead.")
}
footnote_titles <- list(
general = general_title, number = number_title,
alphabet = alphabet_title, symbol = symbol_title
)
footnote_contents <- list(
general = general, number = number, alphabet = alphabet, symbol = symbol
)
notnull <- names(footnote_contents)[!sapply(footnote_contents, is.null)]
if (length(notnull) == 0) {return(kable_input)}
footnote_order <- footnote_order[footnote_order %in% notnull]
footnote_titles <- footnote_titles[footnote_order]
footnote_contents <- footnote_contents[footnote_order]
if (escape) {
if (kable_format == "html") {
footnote_contents <- lapply(footnote_contents, escape_html)
footnote_titles <- lapply(footnote_titles, escape_html)
} else {
footnote_contents <- lapply(footnote_contents, escape_latex2)
footnote_contents <- lapply(footnote_contents, linebreak)
footnote_titles <- lapply(footnote_titles, escape_latex2)
footnote_titles <- lapply(footnote_titles, linebreak)
}
}
title_format <- match.arg(title_format, c("italic", "bold", "underline"),
several.ok = TRUE)
footnote_titles <- lapply(footnote_titles, footnote_title_format,
kable_format, title_format)
footnote_table <- footnote_table_maker_rev(
kable_format, footnote_titles, footnote_contents, symbol_manual
)
if (kable_format == "html") {
return(footnote_html(kable_input, footnote_table, footnote_as_chunk))
}
if (kable_format == "latex") {
return(footnote_latex(kable_input, footnote_table, footnote_as_chunk,
threeparttable, fixed_small_size))
}
}
footnote_title_format <- function(x, format, title_format) {
if (x == "") return(x)
if (format == "html") {
title_style <- ""
if ("italic" %in% title_format) {
title_style <- paste0(title_style, "font-style: italic;")
}
if ("bold" %in% title_format) {
title_style <- paste0(title_style, "font-weight: bold;")
}
if ("underline" %in% title_format) {
title_style <- paste0(title_style, "text-decoration: underline;")
}
return(paste0(
'<span style="', title_style, '">', x, '</span>'
))
} else {
if ("italic" %in% title_format) {
x <- paste0("\\\\textit\\{", x, "\\}")
}
if ("bold" %in% title_format) {
x <- paste0("\\\\textbf\\{", x, "\\}")
}
if ("underline" %in% title_format) {
x <- paste0("\\\\underline\\{", x, "\\}")
}
return(x)
}
}
footnote_table_maker_rev <- function(format, footnote_titles, footnote_contents,
symbol_manual) {
if (is.null(symbol_manual)) {
number_index <- read.csv(system.file("symbol_index.csv",
package = "kableExtra"))
if (format == "latex") {
symbol_index <- number_index$symbol.latex
} else {
symbol_index <- number_index$symbol.html
}
} else {
symbol_index <- symbol_manual
}
if (!is.null(footnote_contents$general)) {
footnote_contents$general <- data.frame(
index = "",
footnote = footnote_contents$general
)
}
if (!is.null(footnote_contents$number)) {
footnote_contents$number <- data.frame(
index = as.character(1:length(footnote_contents$number)),
footnote = footnote_contents$number
)
}
if (!is.null(footnote_contents$alphabet)) {
# 逆順のアルファベット (z to a) を使用
footnote_contents$alphabet <- data.frame(
index = rev(letters)[1:length(footnote_contents$alphabet)],
footnote = footnote_contents$alphabet
)
}
if (!is.null(footnote_contents$symbol)) {
footnote_contents$symbol <- data.frame(
index = symbol_index[1:length(footnote_contents$symbol)],
footnote = footnote_contents$symbol
)
}
out <- list()
out$contents <- footnote_contents
out$titles <- footnote_titles
return(out)
}
# HTML
footnote_html <- function(kable_input, footnote_table, footnote_as_chunk) {
kable_attrs <- attributes(kable_input)
important_nodes <- read_kable_as_xml(kable_input)
body_node <- important_nodes$body
kable_xml <- important_nodes$table
new_html_footnote <- html_tfoot_maker(footnote_table, footnote_as_chunk)
xml_add_child(kable_xml, new_html_footnote)
xml2::xml_set_attr(kable_xml, "style",
paste0(xml2::xml_attr(kable_xml, "style"),
"border-bottom: 0;"))
out <- as_kable_xml(body_node)
attributes(out) <- kable_attrs
if (!"kableExtra" %in% class(out)) class(out) <- c("kableExtra", class(out))
return(out)
}
html_tfoot_maker <- function(footnote_table, footnote_as_chunk) {
footnote_types <- names(footnote_table$contents)
footnote_text <- c()
for (i in footnote_types) {
footnote_text <- c(footnote_text, html_tfoot_maker_(
footnote_table$contents[[i]], footnote_table$titles[[i]], i,
footnote_as_chunk))
}
footnote_text <- paste0(
"<tfoot>", paste0(footnote_text, collapse = ""), "</tfoot>"
)
footnote_node <- read_html(footnote_text, options = c("RECOVER", "NOERROR"))
return(xml_child(xml_child(footnote_node, 1), 1))
}
html_tfoot_maker_ <- function(ft_contents, ft_title, ft_type, ft_chunk) {
footnote_text <- apply(ft_contents, 1, function(x) {
paste0('<sup>', x[1], '</sup> ', x[2])
})
if (ft_title != "") {
title_text <- ft_title
footnote_text <- c(title_text, footnote_text)
}
if (!ft_chunk) {
footnote_text <- paste0(
'<tr><td style="padding: 0; " colspan="100%">',
footnote_text, '</td></tr>'
)
} else {
footnote_text <- paste0(
'<tr><td style="padding: 0; " colspan="100%">',
paste0(footnote_text, collapse = " "),
'</td></tr>'
)
}
return(footnote_text)
}
# LaTeX
footnote_latex <- function(kable_input, footnote_table, footnote_as_chunk,
threeparttable, fixed_small_size) {
table_info <- magic_mirror(kable_input)
out <- solve_enc(kable_input)
footnote_text <- latex_tfoot_maker(footnote_table, footnote_as_chunk,
table_info$ncol, threeparttable)
if (threeparttable) {
if (table_info$tabular %in% c("longtable", "longtabu") ) {
out <- sub(paste0("\\\\begin\\{", table_info$tabular, "\\}"),
paste0("\\\\begin{ThreePartTable}\n\\\\begin{TableNotes}",
ifelse(footnote_as_chunk, "[para]", ""),
ifelse(fixed_small_size,"\n\\\\small\n","\n"), footnote_text,
"\n\\\\end{TableNotes}\n\\\\begin{",
table_info$tabular, "}"),
out)
out <- sub(paste0("\\\\end\\{",table_info$tabular, "\\}"),
paste0("\\\\end{", table_info$tabular,
"}\n\\\\end{ThreePartTable}"),
out)
if (table_info$booktabs) {
out <- sub(bottomrule_regexp, "\\1\n\\\\insertTableNotes", out)
} else {
out <- sub("\\\\hline\n\\\\end\\{longtable\\}",
"\\\\hline\n\\\\insertTableNotes\n\\\\end\\{longtable\\}",
out)
}
} else {
if (table_info$tabular == "tabu") {
stop("Please use `longtable = T` in your kable function. ",
"Full width threeparttable only works with longtable.")
}
out <- sub(paste0("\\\\begin\\{", table_info$tabular, "\\}"),
paste0("\\\\begin{threeparttable}\n\\\\begin{",
table_info$tabular, "}"),
out)
out <- sub(table_info$end_tabular,
paste0("\\\\end{", table_info$tabular,
"}\n\\\\begin{tablenotes}",
ifelse(footnote_as_chunk, "[para]", ""),
ifelse(fixed_small_size,"\n\\\\small\n","\n"), footnote_text,
"\n\\\\end{tablenotes}\n\\\\end{threeparttable}"),
out)
}
} else {
if (table_info$booktabs) {
out <- sub(bottomrule_regexp,
paste0("\\1\n", footnote_text), out)
} else {
out <- sub(table_info$end_tabular,
paste0(footnote_text, "\n\\\\end{", table_info$tabular, "}"),
out)
}
}
out <- structure(out, format = "latex", class = "knitr_kable")
attr(out, "kable_meta") <- table_info
return(out)
}
latex_tfoot_maker <- function(footnote_table, footnote_as_chunk, ncol,
threeparttable) {
footnote_types <- names(footnote_table$contents)
footnote_text <- c()
if (threeparttable) {
for (i in footnote_types) {
footnote_text <- c(footnote_text, latex_tfoot_maker_tpt_(
footnote_table$contents[[i]], footnote_table$titles[[i]],
footnote_as_chunk, ncol))
}
} else {
for (i in footnote_types) {
footnote_text <- c(footnote_text, latex_tfoot_maker_(
footnote_table$contents[[i]], footnote_table$titles[[i]],
footnote_as_chunk, ncol))
}
}
footnote_text <- paste0(footnote_text, collapse = "\n")
return(footnote_text)
}
latex_tfoot_maker_ <- function(ft_contents, ft_title, ft_chunk, ncol) {
footnote_text <- apply(ft_contents, 1, function(x) {
if (x[1] == "") {
x[2]
} else {
paste0('\\\\textsuperscript{', x[1], '} ', x[2])
}
})
if (ft_title != "") {
title_text <- ft_title
footnote_text <- c(title_text, footnote_text)
}
if (!ft_chunk) {
footnote_text <- paste0(
'\\\\multicolumn{', ncol, '}{l}{\\\\rule{0pt}{1em}', footnote_text, '}\\\\\\\\'
)
} else {
footnote_text <- paste0(
'\\\\multicolumn{', ncol, '}{l}{\\\\rule{0pt}{1em}',
paste0(footnote_text, collapse = " "),
'}\\\\\\\\'
)
}
return(footnote_text)
}
latex_tfoot_maker_tpt_ <- function(ft_contents, ft_title, ft_chunk, ncol) {
footnote_text <- apply(ft_contents, 1, function(x) {
if (x[1] == "") {
paste0('\\\\item ', x[2])
} else {
paste0('\\\\item[', x[1], '] ', x[2])
}
})
if (ft_title != "") {
title_text <- paste0('\\\\item ', ft_title, ' ')
footnote_text <- c(title_text, footnote_text)
}
footnote_text <- paste0(footnote_text, collapse = "\n")
# if (!ft_chunk) {
# footnote_text <- paste0(footnote_text, collapse = "\n")
# } else {
# footnote_text <- paste0(footnote_text, collapse = " ")
# }
return(footnote_text)
}
作成したスクリプトは保存して、Rmarkdownファイルのsetupチャンクで読み込みます
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
source("~footnote_rev.R")
```
表出力の確認
```{r labelname1, echo=FALSE, warning=FALSE, message=FALSE, results='asis'}
#Input data
data <- data.frame(col1 = c(letters[1:4]),
col2 = c(1:4))
colnames(data)[1] <- paste0(colnames(data)[1], footnote_marker_alphabet_rev(1))
colnames(data)[2] <- paste0(colnames(data)[2], footnote_marker_alphabet_rev(2))
#Table output
data %>%
kable(
format = "latex",
escape = FALSE,
caption = "\\label{labelname1}タイトルをここに入れてください.",
booktabs = TRUE,
align = "c",
linesep = ""
) %>%
kable_styling(
latex_options = "hold_position",
position = "left",
full_width = FALSE
) %>%
column_spec(
1:length(data),
width = c("7.5cm","7.5cm"),
latex_valign = "m"
) %>%
footnote_rev(
general_title = "",
general = c(
"フットノート1をここに入力",
"フットノート2をここに入力."),
alphabet = c("zから始まる","yから始まる")
) %>%
print()
```

PDF出力では正常に動作し、脚注マーカーがz, y, x…と逆順に表示されました。
なお、HTML出力での挙動は未確認です。
この記事が、どなたかの研究や制作の一助になれば幸いです。

Amazonアフィリエイトでブログ運営しています。
応援いただけると嬉しいです。

ネスカフェ 香味焙煎 ひとときの贅沢 スティック ブラック 20P,箱,レギュラー ソリュブル コーヒー,個包装

AHMAD TEA(アーマッドティー) クラシックセレクション ティーバッグ 20袋