我在尝试将换行符包含到
gtsummary
函数的参数中时遇到问题,如 statistic
的 tbl_summary()
参数或 update
的 modify_header()
。这有点奇怪,因为到目前为止它一直有效,并且包文档表明这是这样做的方法......
这是一个可重现的示例:
## loading packages ##
library(dplyr)
library(gtsummary)
## gtsummary table ##
trial %>% tbl_summary(include = c("trt","stage","grade"),
by = "trt",
statistic = all_categorical() ~ "{p}% \n ({n})", # \n does not pass "({n})" to next line...
missing = "no") %>%
modify_header(update =list(all_stat_cols() ~ "**{level}** \n ({p}%, \n N = {n})"), # and here as well...
text_interpret = "md")
问题是否仅来自我的计算机?是否是由于最近的软件包更新所致?
以下是如何在 Quarto 文档的 gt_summary 表的 Latex PDF 输出中添加换行符的示例:
---
title: "Title"
format:
pdf:
keep-tex: true
keep-md: true
header-includes:
\usepackage{makecell}
html: default
odt: default
---
\newpage
# Section 1
```{r}
#| echo: false
#| warning: false
library(tidyverse)
library(gtsummary)
library(gt)
library(stringr)
#' Modify a tbl_summary's header to use newlines
#' Header made by level (L) and number of observations (N)
#'
#' @param x A tbl_summary object
#'
#' @return None
#'
#' @export
my_modify_header_LN <- function(x) {
header_fmt_LN <- function() {
if(knitr::is_latex_output()) {
str <- "\\makecell{{\\textbf{{{level}}} \\\\\\\\ N = {n}}}"
} else if (knitr::is_html_output()) {
str <- "**{level}** <br/> N = {n}"
} else {
str <- "**{level}** N = {n}"
}
}
return(
modify_header(x,
all_stat_cols() ~ header_fmt_LN())
)
}
#' Modify a tbl_summary's header to use newlines
#' Header made by level (L), number of observations (N) and percentage over total (P)
#'
#' @param x A tbl_summary object
#'
#' @return None
#'
#' @export
my_modify_header_LNP <- function(x) {
header_fmt_LNP <- function() {
if(knitr::is_latex_output()) {
str <- paste0("\\makecell{{\\textbf{{{level}}} ",
"\\\\\\\\ ",
"N = {n} ",
"\\\\\\\\ ",
"({style_percent(p)}%)}}")
} else if (knitr::is_html_output()) {
str <- paste0("**{level}** ",
"<br/> ",
"N = {n} ",
"<br/> ",
"({style_percent(p)}%)")
} else {
str <- paste0("**{level}** \n",
"N = {n} \n",
"({style_percent(p)}%)")
}
return(str)
}
return(
modify_header(x,
all_stat_cols() ~ header_fmt_LNP())
)
}
#' Print a tbl_summary table
#'
#' @param data A tbl_summary object
#'
#' @return None
#'
#' @export
my_print_table <- function(data) {
fix_footnote <- function(s) {
# If we are not knitting to latex, return immediately
if(!knitr::is_latex_output()) {
return(s)
}
# Put footnote back into the `makecell` command
s <- s |> stringr::str_replace_all(
r"(\\makecell\{(.+?)((?:\\\\.+?)+)\}(.+?)(?=&|\\\\|$))",
r"(\\makecell{\1\2\3})")
return(s)
}
# Use as_gt backend
data <- data |> gtsummary::as_gt()
# In case of LaTeX, revert the escaping done by gt::as_latex
# see: https://github.com/rstudio/gt/issues/1912
if(knitr::is_latex_output()) {
pats <- c(
"\\\\textbackslash\\{\\}"="\\\\",
"\\\\\\{"="{",
"\\\\\\}"="}",
"\\{\\[\\}"="[",
"\\{\\]\\}"="]"
)
data <- data |>
gt::as_latex() |>
as.character() |>
str_replace_all(pats) |>
fix_footnote() |>
knitr::asis_output()
}
return(data)
}
```
```{r}
#| label: tbl-label-1
#| echo: false
#| output: asis
#| tbl-cap: "**Table caption**"
trial |>
select(trt, age, grade) |>
tbl_summary(by = trt) |>
add_p() |>
my_modify_header_LN() |>
my_print_table()
```
```{r}
#| label: tbl-label-2
#| echo: false
#| output: asis
#| tbl-cap: "**Table caption**"
trial |>
select(trt, age, grade) |>
tbl_summary(by = trt) |>
add_p() |>
my_modify_header_LNP() |>
my_print_table()
```
渲染的 PDF 输出: