254 tblsummary pattern (#328)

* in progress

* in progress

* updates to tidyselect allowing for more flexible inputs

* NSE for add_p and tbl_uvregression

* Update tbl_uvregression.R

* Update tbl_regression.R

* making all inputs accept bare/tidyselect notation

* making the selectors totally tidy compatible

* updated argument name for internal select function

* documentation update using tidyselect/symbol inputs

* deprecation note update

* Update test-select_helpers.R

* in progress

* in progress

* first draft complete

* first draft of inline_text pattern update for tbl_summary

* Update .covrignore

* removed functions no longer in use

* fixing edge cases for summarizing data that resulted in errors

* removing references to ..continuous.. and ..categorical..

* in progress

* small tweaks to NSE inputs

* select for tbl_regression complete

* updated unit tests, error messaging, and input checks

* dep version updates

* deleting commented out code

* #300 improved error messaging

* bug fix to new include/exclude notation over terms

* doc update to inline_text.tbl_summary

* documentation update

* Update NEWS.md

* Update _pkgdown.yml

* version number incremented

* NEWS update

* added return for when an input resolves to NULL

Co-authored-by: Margaret Hannum <[email protected]>

Author: ddsjoberg

.covrignore

@@ -1 +1,2 @@
 R/deprecated.R
+R/print.R

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: gtsummary
 Title: Presentation-Ready Data Summary and Analytic Result
     Tables
-Version: 1.2.4.9002
+Version: 1.2.4.9003
 Authors@R: 
     c(person(given = "Daniel D.",
              family = "Sjoberg",
@@ -48,32 +48,32 @@ BugReports: https://github.com/ddsjoberg/gtsummary/issues
 Depends: 
     R (>= 3.5)
 Imports: 
-    broom (>= 0.5.1),
-    broom.mixed (>= 0.2.3),
+    broom (>= 0.5.3),
+    broom.mixed (>= 0.2.4),
     crayon (>= 1.3.4),
-    dplyr (>= 0.7.8),
-    glue (>= 1.3.0),
-    knitr (>= 1.21),
+    dplyr (>= 0.8.3),
+    glue (>= 1.3.1),
+    knitr (>= 1.26),
     lifecycle (>= 0.1.0),
     magrittr (>= 1.5),
-    purrr (>= 0.3.0),
-    rlang (>= 0.3.1),
+    purrr (>= 0.3.3),
+    rlang (>= 0.4.2),
     stringr (>= 1.4.0),
     survival,
-    tibble (>= 2.0.1),
+    tibble (>= 2.1.3),
     tidyr (>= 1.0.0),
     tidyselect (>= 0.2.5),
     usethis (>= 1.5.1)
 Suggests: 
-    car (>= 3.0.2),
-    covr (>= 3.2.1),
-    geepack (>= 1.2.1),
-    ggplot2 (>= 3.1.0),
-    Hmisc (>= 4.2.0),
-    lme4 (>= 1.1.18.1),
-    rmarkdown (>= 1.11),
-    spelling (>= 2.0),
-    testthat (>= 2.1.0),
+    car (>= 3.0.6),
+    covr (>= 3.4.0),
+    geepack (>= 1.3.1),
+    ggplot2 (>= 3.2.1),
+    Hmisc (>= 4.3.0),
+    lme4 (>= 1.1.21),
+    rmarkdown (>= 2.0),
+    spelling (>= 2.1),
+    testthat (>= 2.3.1),
     forcats (>= 0.4.0)
 Enhances:
     gt (>= 0.1.0)

NAMESPACE

@@ -132,6 +132,7 @@ importFrom(knitr,knit_print)
 importFrom(lifecycle,deprecate_soft)
 importFrom(magrittr,"%>%")
 importFrom(purrr,compact)
+importFrom(purrr,cross_df)
 importFrom(purrr,discard)
 importFrom(purrr,every)
 importFrom(purrr,flatten)
@@ -156,10 +157,12 @@ importFrom(purrr,pmap_dbl)
 importFrom(purrr,pmap_lgl)
 importFrom(purrr,some)
 importFrom(rlang,"%||%")
+importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(rlang,parse_expr)
 importFrom(rlang,set_names)
 importFrom(rlang,sym)
+importFrom(rlang,syms)
 importFrom(stringr,fixed)
 importFrom(stringr,str_detect)
 importFrom(stringr,str_extract_all)

NEWS.md

@@ -1,5 +1,30 @@
 # gtsummary (development version)
 
+* Package-wide update allowing arguments that accept variable names to accept bare/symbol inputs, character inputs, stored character inputs, and tidyselect helpers.  When passing a single variable, the `vars()` function wrapper is no longer required. #250
+
+    ```r
+    tbl_summary(trial, label = age ~ "NEW LABEL"))
+    tbl_summary(trial, label = "age" ~ "NEW LABEL"))
+    tbl_summary(trial, label = c("age", "trt") ~ "NEW LABEL"))
+    tbl_summary(trial, label = c(age, trt) ~ "NEW LABEL"))
+    tbl_summary(trial, label = vars(age, trt) ~ "NEW LABEL"))
+    tbl_summary(trial, label = vars(everything(), -age, -trt) ~ "NEW LABEL"))
+    
+    age_column = "age"
+    tbl_summary(trial, label = age_column ~ "NEW LABEL"))
+    tbl_summary(trial, label = vars(age_column) ~ "NEW LABEL")
+    
+    purrr::map(c("trt", "grade"), ~tbl_summary(trial, by = .x))
+    ```
+
+* New `pattern=` argument in `inline_text.tbl_summary()`.  Previously, we could only grab the entire cell from a `tbl_summary()` with `inline_text()`, and now we can get any single statistic reported #254
+
+* Cubic spline terms are now accurately matched to a variable name/term #312
+
+* Improved error messaging in `tidyselect_to_list()` #300
+
+* Functions `tbl_summary_()` and `add_p_()` have been deprecated because the `by=` and `group=` arguments now accept strings #250
+
 * Bug fix when non-standard evaluation arguments were passed in `method.args=` argument of `tbl_uvregression()` (#322)
 
 * Functions `all_categorical()`, `all_dichotomous()`, and `all_continuous()` may now be used in `tbl_summary()` argument `type=` (#256)
@@ -10,7 +35,7 @@
 
 * Bug fix in `as_kable()` where column header did not match statistics presented when certain levels of the `by=` variable are entirely missing in `tbl_summary()` (#304)
 
-* Updated the trial example dataset `"trt"` variable to be `"Drug A"` and `"Drug B"` instead of `"Placebo"` and `"Drug"`
+* Updated the trial example data set `"trt"` variable to be `"Drug A"` and `"Drug B"` instead of `"Placebo"` and `"Drug"`
 
 * Improved messaging to users when an error or warning occurs while calculating a p-value in `add_p()`.  Also, p-values are no longer omitted from output when a warning is encountered during their calculation (#283) 
 

R/add_global_p.R

@@ -77,28 +77,23 @@ add_global_p.tbl_regression <- function(x, include = NULL, exclude = NULL,
                                  select_input = !!rlang::enquo(exclude))
 
   # fetching categorical variables from model
-  model_terms <- x %>%
+  if (is.null(include))
+    include <- x %>%
     pluck("table_body") %>%
-    filter(.data$var_type == "categorical") %>%
+    filter(.data$var_type %in% c("categorical", "interaction")) %>%
     pull(.data$variable) %>%
     unique()
 
-  # if not terms supplied, getting list of all categorical terms in model
-  if (is.null(terms)) terms <- model_terms
+  include <- include %>% setdiff(exclude)
+
+
 
   # if no terms are provided, stop and return x
-  if (length(terms) == 0) {
+  if (length(include) == 0) {
     message("No terms were selected, and no global p-values added to table")
     return(x)
   }
 
-  # check that terms selected appear in model.
-  if (!all(terms %in% model_terms)) {
-    stop(glue(
-      "Terms selected are not categorical terms from model: ",
-      "{paste(terms[!(terms %in% model_terms)], collpase = ', ')}"
-    ))
-  }
 
   # calculating global pvalues
   tryCatch(
@@ -121,7 +116,7 @@ add_global_p.tbl_regression <- function(x, include = NULL, exclude = NULL,
     car_Anova %>%
     as.data.frame() %>%
     tibble::rownames_to_column(var = "variable") %>%
-    filter(!!parse_expr("variable %in% terms")) %>%
+    filter(.data$variable %in% !!include) %>%
     select(c("variable", starts_with("Pr(>"))) %>% # selecting the pvalue column
     set_names(c("variable", "p.value_global")) %>%
     mutate(row_type = "label")
@@ -143,7 +138,7 @@ add_global_p.tbl_regression <- function(x, include = NULL, exclude = NULL,
     x$table_body <-
       x$table_body %>%
       mutate(
-        p.value = if_else(.data$variable %in% terms & .data$row_type == "level",
+        p.value = if_else(.data$variable %in% !!include & .data$row_type == "level",
           NA_real_, .data$p.value
         )
       )

R/add_p.R

@@ -79,15 +79,18 @@ add_p <- function(x, test = NULL, pvalue_fun = NULL,
                   group = NULL, include = NULL, exclude = NULL) {
 
   # converting bare arguments to string ----------------------------------------
-  group <- var_input_to_string(data = x$inputs$data, select_input = !!rlang::enquo(group))
-  include <- var_input_to_string(data = x$inputs$data, select_input = !!rlang::enquo(include))
-  exclude <- var_input_to_string(data = x$inputs$data, select_input = !!rlang::enquo(exclude))
+  group <- var_input_to_string(data = x$inputs$data, select_input = !!rlang::enquo(group),
+                               arg_name = "by", select_single = TRUE)
+  include <- var_input_to_string(data = x$inputs$data, select_input = !!rlang::enquo(include),
+                                 arg_name = "by")
+  exclude <- var_input_to_string(data = x$inputs$data, select_input = !!rlang::enquo(exclude),
+                                 arg_name = "by")
 
   # group argument -------------------------------------------------------------
   if (!is.null(group)) {
     # checking group is in the data frame
     if (!group %in% x$meta_data$variable) {
-      stop(glue("'{group}' is not a column name in the input data frame."))
+      stop(glue("'{group}' is not a column name in the input data frame."), call. = FALSE)
     }
     # dropping group variable from table_body and meta_data
     x$table_body <- x$table_body %>% filter(.data$variable != group)
@@ -103,24 +106,24 @@ add_p <- function(x, test = NULL, pvalue_fun = NULL,
       "'pvalue_fun' is not a valid function.  Please pass only a function\n",
       "object. For example,\n\n",
       "'pvalue_fun = function(x) style_pvalue(x, digits = 2)'"
-    ))
+    ), call. = FALSE)
   }
 
   # checking that input is class tbl_summary
-  if (class(x) != "tbl_summary") stop("x must be class 'tbl_summary'")
+  if (class(x) != "tbl_summary") stop("x must be class 'tbl_summary'", call. = FALSE)
   # checking that input x has a by var
   if (is.null(x$inputs[["by"]])) {
     stop(paste0(
       "Cannot add comparison when no 'by' variable ",
       "in original tbl_summary() call"
-    ))
+    ), call. = FALSE)
   }
 
   # test -----------------------------------------------------------------------
   # parsing into a named list
   test <- tidyselect_to_list(
     x$inputs$data, test,
-    .meta_data = x$meta_data, input_type = "test"
+    .meta_data = x$meta_data, arg_name = "test"
   )
 
   if (!is.null(test)) {
@@ -131,13 +134,13 @@ add_p <- function(x, test = NULL, pvalue_fun = NULL,
       stop(glue(
         "Each element in 'test' must be named. ",
         "For example, 'test = list(age = \"t.test\", ptstage = \"fisher.test\")'"
-      ))
+      ), call. = FALSE)
     }
   }
 
   # checking pvalue_fun are functions
   if (!is.function(pvalue_fun)) {
-    stop("Input 'pvalue_fun' must be a function.")
+    stop("Input 'pvalue_fun' must be a function.", call. = FALSE)
   }
 
   # Getting p-values only for included variables

R/gtsummary-package.R

@@ -3,11 +3,13 @@
 #' rename_at bind_cols mutate_all mutate_at slice desc
 #' @importFrom purrr map imap map2 pmap map_chr map_dfr map_lgl map_dbl map_if
 #' imap_dfr imap_lgl map2_chr pmap_lgl pmap_chr pmap_dbl compact keep discard
-#' every some pluck flatten negate partial
+#' every some pluck flatten negate partial cross_df
 #' @importFrom tidyr nest unnest complete spread
 #' @importFrom tibble tibble as_tibble
-#' @importFrom rlang .data %||% set_names sym parse_expr
+#' @importFrom rlang .data %||% set_names sym syms parse_expr :=
 #' @importFrom glue glue as_glue glue_collapse
+#' @importFrom stringr fixed word str_extract_all str_remove_all str_starts
+#' str_split str_detect str_remove
 #' @keywords internal
 "_PACKAGE"