1.2.1 Release

.Rbuildignore

@@ -22,3 +22,6 @@
 ^Makefile$
 ^Jenkinsfile$
 ^rsconnect$
+^data-raw$
+^scratch.R$
+^CRAN-SUBMISSION$

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

@@ -5,10 +5,12 @@ on:
     branches:
       - main
       - master
+      - devel
   pull_request:
     branches:
       - main
       - master
+      - devel
 
 name: R-CMD-check
 

.gitignore

@@ -5,3 +5,4 @@
 inst/doc
 Tplyr.Rproj
 docs/
+scratch.R

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 1.2.0
+Date: 2024-02-14 17:07:48 UTC
+SHA: 806f9a0a103059542437632f5977cc1e8ded2652

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Tplyr
 Title: A Traceability Focused Grammar of Clinical Data Summary
-Version: 1.1.0
+Version: 1.2.1
 Authors@R: 
     c(
     person(given = "Eli",
@@ -26,6 +26,18 @@ Authors@R:
            family = "Mascary",
            email = "sadchla.mascary@atorusresearch.com",
            role = "ctb"),
+    person(given = "Andrew",
+           family = "Bates",
+           email = "andrew.bates@atorusresearch.com",
+           role = "ctb"),
+    person(given = "Shiyu",
+           family = "Chen",
+           email = "shiyu.chen@atorusresearch.com",
+           role = "ctb"),
+    person(given = "Oleksii",
+           family = "Mikryukov",
+           email = "alex.mikryukov@atorusresearch.com",
+           role = "ctb"),
     person(given = "Atorus Research LLC",
            role = "cph")
     )
@@ -62,3 +74,4 @@ VignetteBuilder: knitr
 RoxygenNote: 7.2.3
 RdMacros: lifecycle
 Config/testthat/edition: 3
+LazyData: true

NAMESPACE

@@ -32,6 +32,10 @@ S3method(set_denoms_by,count_layer)
 S3method(set_denoms_by,shift_layer)
 S3method(set_format_strings,count_layer)
 S3method(set_format_strings,desc_layer)
+S3method(set_format_strings,shift_layer)
+S3method(set_limit_data_by,count_layer)
+S3method(set_limit_data_by,desc_layer)
+S3method(set_limit_data_by,shift_layer)
 S3method(set_where,tplyr_layer)
 S3method(set_where,tplyr_table)
 S3method(str,f_str)
@@ -40,10 +44,12 @@ S3method(str,tplyr_table)
 export("%>%")
 export("header_n<-")
 export("pop_data<-")
+export(add_anti_join)
 export(add_column_headers)
 export(add_filters)
 export(add_layer)
 export(add_layers)
+export(add_missing_subjects_row)
 export(add_risk_diff)
 export(add_total_group)
 export(add_total_row)
@@ -54,9 +60,11 @@ export(apply_conditional_format)
 export(apply_formats)
 export(apply_row_masks)
 export(build)
+export(collapse_row_labels)
 export(f_str)
 export(get_by)
 export(get_count_layer_formats)
+export(get_data_labels)
 export(get_desc_layer_formats)
 export(get_layer_template)
 export(get_layer_templates)
@@ -86,6 +94,7 @@ export(process_statistic_data)
 export(process_statistic_formatting)
 export(process_summaries)
 export(remove_layer_template)
+export(replace_leading_whitespace)
 export(set_by)
 export(set_count_layer_formats)
 export(set_custom_summaries)
@@ -97,7 +106,9 @@ export(set_distinct_by)
 export(set_format_strings)
 export(set_header_n)
 export(set_indentation)
+export(set_limit_data_by)
 export(set_missing_count)
+export(set_missing_subjects_row_label)
 export(set_nest_count)
 export(set_numeric_threshold)
 export(set_order_count_method)
@@ -135,8 +146,10 @@ importFrom(dplyr,between)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,case_when)
+importFrom(dplyr,count)
 importFrom(dplyr,cur_column)
 importFrom(dplyr,cur_group)
+importFrom(dplyr,desc)
 importFrom(dplyr,distinct)
 importFrom(dplyr,do)
 importFrom(dplyr,everything)
@@ -159,10 +172,12 @@ importFrom(dplyr,rename)
 importFrom(dplyr,row_number)
 importFrom(dplyr,rowwise)
 importFrom(dplyr,select)
+importFrom(dplyr,slice_head)
 importFrom(dplyr,summarize)
 importFrom(dplyr,tally)
 importFrom(dplyr,ungroup)
 importFrom(dplyr,vars)
+importFrom(dplyr,where)
 importFrom(forcats,fct_collapse)
 importFrom(forcats,fct_drop)
 importFrom(forcats,fct_expand)
@@ -176,6 +191,7 @@ importFrom(purrr,flatten)
 importFrom(purrr,imap)
 importFrom(purrr,map)
 importFrom(purrr,map2)
+importFrom(purrr,map2_chr)
 importFrom(purrr,map2_dfr)
 importFrom(purrr,map_chr)
 importFrom(purrr,map_dbl)
@@ -194,7 +210,6 @@ importFrom(rlang,as_name)
 importFrom(rlang,call_args)
 importFrom(rlang,call_modify)
 importFrom(rlang,call_name)
-importFrom(rlang,call_standardise)
 importFrom(rlang,caller_env)
 importFrom(rlang,current_env)
 importFrom(rlang,enexpr)
@@ -220,6 +235,7 @@ importFrom(rlang,is_logical)
 importFrom(rlang,is_named)
 importFrom(rlang,is_quosure)
 importFrom(rlang,is_quosures)
+importFrom(rlang,list2)
 importFrom(rlang,quo)
 importFrom(rlang,quo_get_expr)
 importFrom(rlang,quo_is_call)
@@ -245,6 +261,7 @@ importFrom(stringr,str_detect)
 importFrom(stringr,str_extract)
 importFrom(stringr,str_extract_all)
 importFrom(stringr,str_locate_all)
+importFrom(stringr,str_match)
 importFrom(stringr,str_match_all)
 importFrom(stringr,str_pad)
 importFrom(stringr,str_remove_all)

NEWS.md

@@ -1,3 +1,21 @@
+# Tplyr 1.2.1
+- Resolve #178 to add metadata handling for missing subjects, and add the `add_anti_join()` function
+
+# Tplyr 1.2.0
+- Resolve #62 Add data vignette data into the package (thanks for the suggestion @thebioengineer)
+- Resolve #74 Add an example of piping in set_pop_data
+- Resolve #83 Add the `add_missing_subjects()` function 
+- Resolve #84 Add `set_limit_data_by()` function
+- Resolve #111, #148 Allow ellipsis argument unpacking outside of `add_layer()`
+- Resolve #129 Add `collapse_row_labels()` function
+- Resolve #134 Clarify how population data works to trigger denominators
+- Resolve #75, #146, #166 Fix nested count layer handling where one inner layer value exists in multiple outer layer groups
+- Resolve #21, #152 Fix handling of Inf, -Inf in desc layer for min and max
+- Resolve #154 Fix namespace scoping for execution of Tplyr tables within non-global environments
+- Resolve #155 Dead code clean-up
+- Resolve #170 Add `replace_leading_whitespace()` post-processing function
+- Resolve #173 Fix nested count layer sort variable behavior when using by variables
+
 # Tplyr 1.1.0
 - This release incorporate parenthesis hugging across all layers (#117)
 - New functions `apply_conditional_formats()`, `str_extract_fmt_group()` and `str_extract_num()`

R/apply_conditional_format.R

@@ -11,15 +11,15 @@
 #' @noRd
 validate_conditional_format_params <- function(string, format_group, condition, replacement, full_string) {
   if (!inherits(string, "character")) {
-    stop("Paramter `string` must be a character vector", call.=FALSE)
+    stop("Parameter `string` must be a character vector", call.=FALSE)
   }
 
   if (!inherits(format_group, "numeric") || (inherits(format_group, "numeric") && format_group %% 1 != 0)) {
-    stop("Paramter `format_group` must be an integer", call.=FALSE)
+    stop("Parameter `format_group` must be an integer", call.=FALSE)
   }
 
   if (!inherits(replacement, "character")) {
-    stop("Paramter `replacement` must be a string", call.=FALSE)
+    stop("Parameter `replacement` must be a string", call.=FALSE)
   }
 
   # Condition statement must use the variable name 'x'
@@ -28,7 +28,7 @@ validate_conditional_format_params <- function(string, format_group, condition,
   }
 
   if (!inherits(full_string, "logical")) {
-    stop("Paramter `full_string` must be bool", call.=FALSE)
+    stop("Parameter `full_string` must be bool", call.=FALSE)
   }
 
 }

R/apply_formats.R

@@ -38,7 +38,7 @@ apply_formats <- function(format_string, ..., empty = c(.overall = "")) {
          call.=FALSE)
   }
 
-  pmap_chr(list(...), function(...) apply_fmts(...), fmt=format)
+  pmap_chr(list2(...), function(...) apply_fmts(...), fmt=format)
 }
 
 #' Application of individual format string
@@ -53,7 +53,7 @@ apply_formats <- function(format_string, ..., empty = c(.overall = "")) {
 #' @return An individually formatted string
 #' @noRd
 apply_fmts <- function(..., fmt) {
-  nums <- list(...)
+  nums <- list2(...)
   repl <- vector('list', length(fmt$settings))
   for (i in seq_along(fmt$settings)) {
     repl[[i]] <- num_fmt(nums[[i]], i, fmt=fmt)

R/assertions.R

@@ -42,22 +42,7 @@ assert_has_class <- function(x, should_be) {
 
   # Is the argument the class that it should be?
   if (class(x) != should_be){
-    # Grab the trace back into an object
-    trc <- trace_back()
-    # Look at the length of the traceback
-    max_length <- length(trc$calls)
-    # If it's >1 we're inside a function, so grab the name
-    if (max_length > 1){
-      # Pull the name out of the call stack
-      cname <- call_name(trc$calls[[max_length - 1]])
-      # Make a display string
-      func_str <- paste0('` in function `', cname, '`')
-    } else {
-      # Filler
-      func_str <- '`'
-    }
-    # Abort and show error
-    abort(paste0('Argument `', param, func_str, ' must be ',
+    abort(paste0('Argument `', param, '` must be ',
                  should_be, '. Instead a class of "', class(x),
                  '" was passed.'))
   }
@@ -75,24 +60,9 @@ assert_inherits_class <- function(x, should_have) {
 
   # Is the argument the class that it should be?
   if (!inherits(x, should_have)){
-
-    # Grab the trace back into an object
-    trc <- trace_back()
-    # Look at the length of the traceback
-    max_length <- max(trc$indices)
-    # If it's >1 we're innside a function, so grab the name
-    if (max_length > 1){
-      # Pull the name out of the call stack
-      cname <- call_name(trc$calls[[max_length - 1]])
-      # Make a display string
-      func_str <- paste0('` in function `', cname, '`')
-    } else {
-      # Filler
-      func_str <- '`'
-    }
     # Abort and show error
-    abort(paste0('Argument `', param, func_str,
-                 ' does not inherit "', should_have,
+    abort(paste0('Argument `', param,
+                 '` does not inherit "', should_have,
                  '". Classes: ', paste(class(x), collapse=", ")))
   }
 }
@@ -197,15 +167,6 @@ unpack_vars <- function(quo_list, allow_character=TRUE) {
   quo_list
 }
 
-#' Check if a quosure is null or contains a call
-#'
-#' @param quo_var A quosure object to check
-#'
-#' @noRd
-is_null_or_call <- function(quo_var) {
-  quo_is_null(quo_var) || inherits(quo_get_expr(quo_var), "call")
-}
-
 #' Check if a quosure is null or contains a logical value
 #'
 #' @param quo_var A quosure object to check
@@ -222,14 +183,6 @@ assert_is_layer <- function(object) {
  assert_inherits_class(object, "tplyr_layer")
 }
 
-#' @param object Object to check if its a layer
-#'
-#' @noRd
-assert_is_table <- function(object) {
-  assert_inherits_class(object, "tplyr_table")
-}
-
-
 #' Return the class of the expression inside a quosure
 #'
 #' @param q A quosure