换行问题( )与 gtsummary 函数

问题描述 投票:0回答:1

我在尝试将换行符包含到

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")

gtsummary 交叉表

问题是否仅来自我的计算机?是否是由于最近的软件包更新所致?

line-breaks gtsummary
1个回答
0
投票

以下是如何在 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 输出:

Table 1 example

Table 2 example

© www.soinside.com 2019 - 2024. All rights reserved.