R/factory_gt.R

In vincentarelbundock/gtsummary: Summary Tables and Plots for Statistical Models and Data: Beautiful, Customizable, and Publication-Ready

#' Internal function to build table with `gt`
#'
#' @inheritParams factory
#' @param output_file file path (character or NULL)
#' @param output_format character
#' @noRd
#' @return tbl_gt object
factory_gt <- function(tab,
                       align = NULL,
                       hrule = NULL,
                       hgroup = NULL,
                       notes = NULL,
                       title = NULL,
                       escape = TRUE,
                       output_format = "gt",
                       output_file = NULL,
                       ...) {

  insight::check_if_installed("gt", minimum_version = "0.5.0")

  # compute spans
  span_list <- get_span_gt(tab)
  column_names <- attr(span_list, "column_names")
  if (!is.null(column_names)) {
    colnames(tab) <- column_names
  }

  # create gt table object
  idx_col <- ncol(tab)
  colnames(tab)[is.na(colnames(tab))] <- ""
  colnames(tab) <- pad(colnames(tab), output_format = output_format)
  out <- gt::gt(tab, caption = title)

  # theme
  theme_ms <- getOption("modelsummary_theme_gt",
                        default = theme_ms_gt)
  out <- theme_ms(out,
                  output_format = output_format,
                  hrule = hrule,
                  hgroup = hgroup)

  # user-supplied notes at the bottom of table
  if (!is.null(notes)) {
    for (n in notes) {
      out <- gt::tab_source_note(out, source_note = n)
    }
  }

  if (length(span_list) > 0) {
    for (s in span_list) {
      out <- gt::tab_spanner(out,
                             label = s$label,
                             columns = tidyselect::all_of(s$columns),
                             level = s$level)
    }
  }

  # column alignment
  if (!is.null(align)) {
    left <- grep('l', align)
    center <- grep('c', align)
    right <- grep('r', align)
    out <- gt::cols_align(
      out, align = 'center', columns = tidyselect::all_of(center))
    out <- gt::cols_align(
      out, align = 'left', columns = tidyselect::all_of(left))
    out <- gt::cols_align(
      out, align = 'right', column = tidyselect::all_of(right))
  }

  # output
  if (is.null(output_file)) {

    if (identical(output_format, "html")) {
      out <- gt::as_raw_html(out)
    }

    if (identical(output_format, "latex")) {
      out <- gt::as_latex(out)
    }

    if (!is.null(getOption("modelsummary_orgmode")) &&
        output_format %in% c("html", "latex")) {
      out <- sprintf("#+BEGIN_EXPORT %s\n%s\n#+END_EXPORT", output_format, out)
      return(out)
    }

    if (output_format %in% c("default", "gt")) {
      return(out)
    }

  } else {
    gt::gtsave(out, output_file)
  }
}