Fix unit display for t1kable

.github/workflows/check-standard.yaml → .github/workflows/R-CMD-check.yaml

@@ -37,12 +37,6 @@ jobs:
       - uses: r-lib/actions/setup-tinytex@v2
       - run: tlmgr --version
 
-      #- name: Install additional LaTeX packages
-      #  run: |
-      #    tlmgr update --self
-      #    tlmgr install titlesec
-      #    tlmgr list --only-installed
-
       - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
@@ -58,4 +52,3 @@ jobs:
         with:
           upload-snapshots: true
           build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
-

.github/workflows/test-coverage.yaml

@@ -0,0 +1,62 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+
+name: test-coverage.yaml
+
+permissions: read-all
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr, any::xml2
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          cov <- covr::package_coverage(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+          print(cov)
+          covr::to_cobertura(cov)
+        shell: Rscript {0}
+
+      - uses: codecov/codecov-action@v5
+        with:
+          # Fail if error if not on PR, or if on PR and token is given
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }}
+          files: ./cobertura.xml
+          plugins: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

DESCRIPTION

@@ -14,8 +14,19 @@ Description: Create HTML tables of descriptive statistics, as one would expect
 License: GPL-3
 Depends: R (>= 3.5.0)
 Imports: stats,Formula,knitr,htmltools,yaml,methods
-Suggests: boot,MatchIt,rmarkdown,printr,kableExtra,flextable,officer,Hmisc,survey
+Suggests: 
+    boot,
+    flextable,
+    kableExtra,
+    MatchIt,
+    officer,
+    printr,
+    rmarkdown,
+    Hmisc,
+    survey,
+    testthat (>= 3.0.0)
 VignetteBuilder: knitr
 Language: en-US
 Encoding: UTF-8
 RoxygenNote: 7.3.3
+Config/testthat/edition: 3

R/t1kable.R

@@ -0,0 +1,100 @@
+#' Convert a \code{table1} object to \code{kabelExtra}.
+#'
+#' @param x An object returned by \code{\link{table1}}.
+#' @param booktabs Passed to \code{kbl} (default \code{TRUE}).
+#' @param ... Other options passed to \code{kbl}.
+#' @param format Passed to \code{kbl} (optional).
+#' @param align Passed to \code{kbl} (optional). The default is to left align
+#' the labels (first column) and center everything else.
+#' @param bold.headers Should the column headers be bolded?
+#' @return A \code{kabelExtra} object.
+#' @note The \code{kableExtra} package needs to be installed for this to work.
+#' @export
+t1kable <- function(x, booktabs=TRUE, ..., format, align, bold.headers=TRUE) {
+  if (!requireNamespace("kableExtra", quietly = TRUE)) {
+    stop("This function requires package 'kableExtra'. Please install it and try again.", call.=FALSE)
+  }
+  if (missing(format) || is.null(format)) {
+    format <- if (knitr::is_latex_output()) "latex" else "html"
+  }
+  default.align <- missing(align)
+
+  obj <- attr(x, "obj", exact=TRUE)
+  with(obj, {
+    rlh <- if (is.null(rowlabelhead) || rowlabelhead=="") "\U{00A0}" else rowlabelhead
+    i <- lapply(contents, function(y) {
+      if (all(y[1,, drop=TRUE] == "")) {
+        nrow(y) - 1
+      } else {
+        nrow(y)
+      }
+    })
+    z <- lapply(contents, function(y) {
+      if (all(y[1,, drop=TRUE] == "")) {
+        y <- as.data.frame(y[-1,, drop=FALSE], stringsAsFactors=FALSE)
+        y2 <- data.frame(x=rownames(y), stringsAsFactors=FALSE)
+      } else {
+        y2 <- data.frame(x="", stringsAsFactors=FALSE)
+      }
+      y <- cbind(setNames(y2, rlh), y)
+      y
+    })
+    if (format == "html") {
+      names(i) <- labels$variables
+    } else {
+      names(i) <- vapply(X = labels$variables, FUN = names, FUN.VALUE = "")
+    }
+    df <- do.call(rbind, z)
+
+    if (format == "html") {
+      cn <- c(rlh, headings)
+    }
+    # Create multiline header
+    if (format == "latex") {
+      # Use the non-HTML version of headings, if any
+      if (!is.null(names(headings))) {
+        headings <- names(headings)
+      }
+      cn <- c(rlh, headings)
+      cn <- kableExtra::linebreak(cn, align="c")
+
+      # Escape '%', but nothing else(?)
+      df <- as.data.frame(gsub("%", "\\\\%", as.matrix(df)))
+    }
+
+    # Use the default alignment, first column left and others centered
+    if (default.align) {
+      align <- c("l", rep("c", ncol(df)-1))
+    }
+
+    rownames(df) <- NULL
+    out <- kableExtra::kbl(df,
+                           format    = format,
+                           align     = align,
+                           col.names = cn,
+                           row.names = FALSE,
+                           escape    = FALSE,
+                           booktabs  = booktabs,
+                           caption   = caption,
+                           ...
+    )
+    out <- kableExtra::pack_rows(out, index=i, escape = FALSE)
+
+    if (.isTRUE(bold.headers)) {
+      out <- kableExtra::row_spec(out, 0, bold=TRUE) # Bold column headers
+    }
+
+    if (!is.null(groupspan)) {
+      groupspan <- setNames(groupspan, labels$groups)
+      zzz <- ncol(df) - sum(groupspan) - 1
+      out <- kableExtra::add_header_above(out, bold=bold.headers,
+                                          data.frame(c(" ", names(groupspan), rep(" ", zzz)), c(1, groupspan, rep(1, zzz))))
+    }
+
+    if (!is.null(footnote)) {
+      out <- kableExtra::footnote(out, general=footnote, general_title="")
+    }
+
+    out
+  })
+}