Merge pull request #2 from stopsack/dev

Release 0.6.1

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

@@ -2,7 +2,7 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master]
+    branches: [main, dev]
   pull_request:
   # CRON jobs only run on the default branch of the repo
   schedule:
@@ -24,9 +24,9 @@ jobs:
         config:
           - {os: macos-latest,   r: 'release'}
           - {os: windows-latest, r: 'release'}
-          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          #- {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
-          - {os: ubuntu-latest,   r: 'oldrel-1'}
+          #- {os: ubuntu-latest,   r: 'oldrel-1'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

DESCRIPTION

@@ -1,16 +1,15 @@
 Package: rifttable
 Type: Package
 Title: Results Tables to Bridge the Rift Between Epidemiologists and Their Data
-Version: 0.6.0
+Version: 0.6.1
 Authors@R:
     person(given = "Konrad H.",
            family = "Stopsack",
            role = c("aut", "cre"),
            email = "[email protected]",
            comment = c(ORCID = "0000-0002-0722-1311"))
-Description: The rifttable package creates a presentation-ready stratified 
-    results tables for epidemiologists, containing both descriptive and 
-    inferential statistics.
+Description: Presentation-ready stratified results tables for epidemiologists, 
+    containing both descriptive and inferential statistics.
 License: GPL (>= 3)
 Encoding: UTF-8
 LazyData: true
@@ -22,7 +21,7 @@ Imports:
     broom (>= 0.7.0),
     dplyr (>= 1.0.8),
     purrr, 
-    risks (>= 0.4.0),
+    risks (>= 0.4.2),
     rlang (>= 0.4.0),
     stats,
     survival,

NEWS.md

@@ -1,3 +1,29 @@
+# rifttable 0.6.1
+
+* New functionality:
+  + Cox models (`type = "hr"`) allow for `weights`, clustering, and `robust` 
+    standard errors.
+  + Argument `ratio_digits_decrease`: By default, decrease number of decimal
+    digits shown for ratios by 1 digit for ratios > 3 and by 2 digits for ratios
+    > 10. Leads to rounded ratios and confidence intervals of `1.23`, `3.4`, and 
+    `11`.
+  + `rt_gt()` now indents the first column and applies markdown formatting to it 
+    by default.
+* New FAQ vignette.
+* Bug fixes:
+  + Binary outcomes returned `NA` instead of `0` in unstratified tables
+    with all-null outcome.
+  + `type = "maxfu"` ignored `digits` and `diff_digits`.
+  + Allow for different `exposure` (strata labels) and `arguments` in one table.
+  + Show unstratified estimate if `exposure` is `""`, not just for `NA`.
+* Internal:
+  + `rt_gt()`: suppress random `id` of gt tables to keep git diff slim.
+  + Keep variables `.event`, `.outcome`, etc. available under their original 
+    names.
+  + Require {risks} >= 0.4.2.
+  + Examples load the `breastcancer` dataset from the risks package.
+
+
 # rifttable 0.6.0
 
 * Breaking changes: 
@@ -14,8 +40,8 @@
 * New function `table1_design()`: Generate design of a descriptive "Table 1."
 * New `outcome` option `"variable@level"` for categorical variables that
   displays `level` as a binary outcome. Used by `table1_design()`.
-* Unstratified tables displaying the trend/linear slope (`trend` variable in the
-  `design`) without an `exposure`.
+* Support unstratified tables displaying the trend/linear slope (`trend` 
+  variable in the `design`) without an `exposure`.
 * More customization:
   + `rifttable(reference = ...)`: Label for the reference category.
   + `design$ci`: Width of confidence intervals.

R/estimate_event_time.R

@@ -217,7 +217,7 @@ estimate_event_time <- function(
         dplyr::summarize(
           res = paste(format_round(
             max(.data$.time),
-            digits = 0)))
+            digits = digits)))
     },
     "surv" =,
     "surv (ci)" =,

R/estimate_regress_binary.R

@@ -7,8 +7,9 @@
 #' @param to Separator character(s) for confidence interval bounds
 #' @param is_trend If called on a continous (trend) variable
 #' @param type Estimand
-#' @param ratio_digits Digits for ratios
 #' @param risk_digits Digits for risks
+#' @param ratio_digits Digits for ratios
+#' @param ratio_digits_decrease Fewer digits for elevated ratios
 #' @param nmin Suppress counts below
 #' @param exposure Name of exposure variable
 #' @param outcome Name of outcome variable
@@ -32,6 +33,7 @@ estimate_regress_binary <- function(
     risk_percent,
     risk_digits,
     ratio_digits,
+    ratio_digits_decrease,
     is_trend,
     nmin,
     na_rm,
@@ -61,6 +63,9 @@ estimate_regress_binary <- function(
       type %in% c("rd", "rd_joint"),
       true = risk_digits,
       false = ratio_digits))
+  if(type %in% c("rd", "rd_joint")) {
+    ratio_digits_decrease <- NULL
+  }
   bootrepeats <- find_argument(
     arguments = arguments,
     which_argument = "bootrepeats",
@@ -132,6 +137,7 @@ estimate_regress_binary <- function(
         true = 100,
         false = 1),
       digits = digits,
+      ratio_digits_decrease = ratio_digits_decrease,
       pattern = pattern,
       xlevels = xlevels,
       reference = dplyr::if_else(

R/estimate_regress_continuous.R

@@ -8,6 +8,7 @@
 #' @param is_trend If called on a continous (trend) variable
 #' @param type Estimand
 #' @param ratio_digits Digits for ratios
+#' @param ratio_digits_decrease Fewer digits for elevated ratios
 #' @param diff_digits Digits for differences
 #' @param nmin Suppress counts below
 #' @param exposure Name of exposure variable
@@ -29,6 +30,7 @@ estimate_regress_continuous <- function(
     digits,
     risk_percent,
     ratio_digits,
+    ratio_digits_decrease,
     diff_digits,
     is_trend,
     nmin,
@@ -55,6 +57,9 @@ estimate_regress_continuous <- function(
       type %in% c("diff", "diff_joint", "quantreg", "quantreg_joint"),
       true = diff_digits,
       false = ratio_digits))
+  if(type %in% c("diff", "diff_joint", "quantreg", "quantreg_joint")) {
+    ratio_digits_decrease <- NULL
+  }
   tau <- find_argument(
     arguments = arguments,
     which_argument = "tau",
@@ -189,6 +194,7 @@ estimate_regress_continuous <- function(
       is_trend = is_trend,
       multiply = 1,
       digits = digits,
+      ratio_digits_decrease = ratio_digits_decrease,
       pattern = pattern,
       xlevels = xlevels,
       reference = dplyr::if_else(

R/estimate_regress_cox.R

@@ -7,6 +7,7 @@
 #' @param is_trend If called on a continous (trend) variable
 #' @param type Estimand
 #' @param ratio_digits Digits for ratios
+#' @param ratio_digits_decrease Fewer digits for elevated ratios
 #' @param nmin Suppress counts below
 #' @param exposure Name of exposure variable
 #' @param na_rm Remove observations with missing outcome data
@@ -28,6 +29,7 @@ estimate_regress_cox <- function(
     confounders,
     digits,
     ratio_digits,
+    ratio_digits_decrease,
     is_trend,
     nmin,
     na_rm,
@@ -50,6 +52,20 @@ estimate_regress_cox <- function(
   digits <- find_rounding_digits(
     digits = digits,
     default = ratio_digits)
+  coxph_weights <- find_argument(
+    arguments = arguments,
+    which_argument = "weights",
+    is_numeric = FALSE,
+    default = NULL)
+  if(!is.null(coxph_weights)) {
+    coxph_weights <- data %>%
+      dplyr::pull(dplyr::one_of(coxph_weights))
+  }
+  coxph_robust <- find_argument(
+    arguments = arguments,
+    which_argument = "robust",
+    is_numeric = FALSE,
+    default = NULL)
 
   survival::coxph(
     formula = stats::as.formula(
@@ -60,7 +76,9 @@ estimate_regress_cox <- function(
           false = "survival::Surv(time = .time_orig, time2 = .time2, "),
         "event = .event) ~ .exposure ",
         confounders)),
-    data = data) %>%
+    data = data,
+    weights = coxph_weights,
+    robust = coxph_robust) %>%
     broom::tidy(
       conf.int = TRUE,
       conf.level = ci,
@@ -71,6 +89,7 @@ estimate_regress_cox <- function(
       is_trend = is_trend,
       multiply = 1,
       digits = digits,
+      ratio_digits_decrease = ratio_digits_decrease,
       pattern = pattern,
       xlevels = xlevels,
       reference = 1,

R/fill_cells.R

@@ -18,6 +18,7 @@
 #' @param diff_digits Number of digits to round difference estimates to
 #' @param risk_digits Number of digits to round risk/cumulative incidences to
 #' @param ratio_digits Number of digits to round ratio estimates to
+#' @param ratio_digits_decrease Fewer digits for elevated ratios
 #' @param rate_digits Number of digits to round rate estimates to
 #' @param to Separator for mean/difference confidence intervals.
 #' @param outcome Outcome variable
@@ -51,8 +52,9 @@ fill_cells <- function(
     diff_digits,
     risk_digits,
     ratio_digits,
+    ratio_digits_decrease,
     rate_digits) {
-  if(is.na(exposure)) {
+  if(is.na(exposure) | exposure == "") {
     data <- data %>%
       dplyr::mutate(.exposure = "Overall")
   } else {
@@ -238,6 +240,7 @@ fill_cells <- function(
       diff_digits = diff_digits,
       risk_digits = risk_digits,
       ratio_digits = ratio_digits,
+      ratio_digits_decrease = ratio_digits_decrease,
       rate_digits = rate_digits,
       risk_percent = risk_percent,
       to = to,
@@ -285,6 +288,7 @@ fill_cells <- function(
           diff_digits = diff_digits,
           risk_digits = risk_digits,
           ratio_digits = ratio_digits,
+          ratio_digits_decrease = ratio_digits_decrease,
           rate_digits = rate_digits,
           risk_percent = risk_percent,
           to = to,

R/format_regression_results.R

@@ -2,6 +2,7 @@
 #'
 #' @param data Data set
 #' @param digits Number of digits to round estimates to
+#' @param ratio_digits_decrease Ratios to round less
 #' @param to Separator character(s) for confidence interval bounds
 #' @param is_trend If called on a continous (trend) variable
 #' @param nmin Suppress counts below
@@ -25,6 +26,7 @@ format_regression_results <- function(
     is_trend,
     multiply,
     digits,
+    ratio_digits_decrease,
     pattern,
     xlevels,
     reference,
@@ -49,7 +51,8 @@ format_regression_results <- function(
         .data$conf.high),
       .funs = ~format_round(
         . * multiply,
-        digits = digits)) %>%
+        digits = digits,
+        ratio_digits_decrease = ratio_digits_decrease)) %>%
     dplyr::full_join(
       counts_per_stratum(
         data = data,

R/format_stratified_results.R

@@ -52,9 +52,9 @@ format_stratified_results <- function(
               pattern = stringr::fixed("(NaN%)")),
             "(--)"),
         TRUE ~ .data$res),
-      res = dplyr::if_else(
-        .data$.per_stratum < nmin,
-        true = paste0("-- (<", nmin, ")"),
-        false = .data$res)) %>%
+      res = dplyr::case_when(
+        .data$.per_stratum < nmin ~
+          paste0("-- (<", nmin, ")"),
+        TRUE ~ .data$res)) %>%
     dplyr::select(-.data$.per_stratum)
 }

R/input_checks.R

@@ -67,7 +67,7 @@ find_argument <- function(
     acceptable = NULL,
     default = NA) {
   argum <- default
-  if(!is.na(arguments)) {
+  if(any(!is.na(arguments))) {
     if(is.list(arguments)) {
       if(which_argument %in% names(arguments)) {
         if(is_numeric) {