R/tt_tabularray.R

In tinytable: Simple and Configurable Tables in 'HTML', 'LaTeX', 'Markdown', 'Word', 'PNG', 'PDF', and 'Typst' Formats

setMethod(
  f = "tt_eval",
  signature = "tinytable_tabularray",
  definition = function(x, ...) {
    template <- readLines(
      system.file("templates/tabularray.tex", package = "tinytable")
    )

    ncols <- ncol(x)
    nrows <- nrow(x)

    tall <- FALSE
    if (length(x@caption) > 0) tall <- TRUE
    if (length(x@notes) > 0) tall <- TRUE

    # placement
    if (length(x@placement) == 1) {
      assert_string(x@placement)
      # dollar sign to avoid [H][H] when we style multiple times
      template <- sub(
        "\\\\begin\\{table\\}",
        sprintf("\\\\begin{table}[%s]\n", x@placement),
        template
      )
    }

    # body: main
    if (length(colnames(x)) > 0) {
      header <- paste(colnames(x), collapse = " & ")
      header <- paste(header, "\\\\")
    } else {
      header <- NULL
    }
    body <- apply(as.data.frame(x@table_dataframe), 1, paste, collapse = " & ")
    body <- paste(body, "\\\\")

    # theme: booktabs
    th <- x@theme[[1]]
    if (
      is.null(th) || is.function(th) || isTRUE(th %in% c("default", "striped"))
    ) {
      if (length(colnames(x)) > 0) {
        # %% are important to distinguish between potentially redundant data rows
        header[length(header)] <- paste(
          header[length(header)],
          "\\midrule %% TinyTableHeader"
        )
      }
    }

    # body: finish
    idx <- grep("\\$tinytable_BODY", template)
    out <- c(
      template[1:(idx - 1)],
      header,
      body,
      template[(idx + 1):length(template)]
    )

    out <- trimws(out)
    out <- paste(out, collapse = "\n")

    if (length(x@caption) > 0) {
      spec <- sprintf("caption={%s},", x@caption[1])
      out <- tabularray_insert(out, content = spec, type = "outer")
    }

    if (length(x@width) == 0) {
      tabularray_cols <- rep("Q[]", ncol(x))
    } else if (length(x@width) == 1) {
      tabularray_cols <- rep("X[]", ncol(x))
      spec <- sprintf("width={%s\\linewidth},", round(x@width, 4))
      out <- tabularray_insert(out, content = spec, type = "inner")
    } else if (length(x@width) > 1) {
      tabularray_cols <- sprintf("X[%s]", x@width)
      spec <- sprintf("width={%s\\linewidth},", round(sum(x@width), 4))
      out <- tabularray_insert(out, content = spec, type = "inner")
    }

    # colspec (we don't need rowspec)
    colspec <- sprintf("colspec={%s},", paste(tabularray_cols, collapse = ""))
    out <- tabularray_insert(out, content = colspec, type = "inner")

    # notes
    if (length(x@notes) > 0) {
      if (length(x@caption) == 0) {
        # otherwise an empty caption is created automatically
        out <- tabularray_insert(
          out,
          content = "entry=none,label=none",
          type = "outer"
        )
      }
      if (is.null(names(x@notes))) {
        lab <- sapply(seq_along(x@notes), function(k) strrep(" ", k - 1))
      } else {
        lab <- NULL
        pad <- 0
        for (i in seq_along(x@notes)) {
          # tabularray requires unique labels, but multiple blanks work
          if (names(x@notes)[i] == "") {
            lab[i] <- strrep(" ", pad) # not sure why -1 is necessary in tabularray
            pad <- pad + 1
          } else {
            lab[i] <- names(x@notes)[i]
          }
        }
      }
      notes <- sapply(x@notes, function(n) if (is.list(n)) n$text else n)
      for (k in seq_along(notes)) {
        spec <- sprintf("note{%s}={%s}", lab[k], notes[k])
        out <- tabularray_insert(out, content = spec, type = "outer")
      }
    }

    if (isTRUE(tall)) {
      out <- sub("\\begin{tblr}", "\\begin{talltblr}", out, fixed = TRUE)
      out <- sub("\\end{tblr}", "\\end{talltblr}", out, fixed = TRUE)
    }

    x@table_string <- out
    x@body <- body

    return(x)
  }
)