diff --git a/R/data.R b/R/data.R index af196b1c8..aa19133b7 100644 --- a/R/data.R +++ b/R/data.R @@ -3,6 +3,12 @@ #' Data frame imported from the [CDISC SDTM/ADaM Pilot Project](https://github.com/cdisc-org/sdtm-adam-pilot-project) #' @name adam #' @keywords datasets +#' @returns Datasets in tibble format. +#' @examples +#' head(ADSL) +#' head(ADAE) +#' head(ADTTE) +#' head(ADLB) "ADSL" #' @rdname adam diff --git a/R/shuffle_ard.R b/R/shuffle_ard.R index cd43834c4..781375ab6 100644 --- a/R/shuffle_ard.R +++ b/R/shuffle_ard.R @@ -13,10 +13,9 @@ #' logical representing whether or not to trim away statistic-level metadata and filter #' only on numeric statistic values. #' -#' @return a tibble +#' @returns A tibble. #' @rdname deprecated #' @export -#' #' @examples #' bind_ard( #' ard_tabulate(ADSL, by = "ARM", variables = "AGEGR1"), @@ -145,7 +144,7 @@ shuffle_ard <- function(x, trim = TRUE) { #' @param ... ([`dynamic-dots`][rlang::dyn-dots])\cr #' columns to search within #' @keywords internal -#' +#' @returns A list with the warnings and errors. #' @examples #' ard <- ard_summary( #' ADSL, diff --git a/man/adam.Rd b/man/adam.Rd index f4475d8cb..79eedd0e2 100644 --- a/man/adam.Rd +++ b/man/adam.Rd @@ -26,7 +26,16 @@ ADTTE ADLB } +\value{ +Datasets in tibble format. +} \description{ Data frame imported from the \href{https://github.com/cdisc-org/sdtm-adam-pilot-project}{CDISC SDTM/ADaM Pilot Project} } +\examples{ +head(ADSL) +head(ADAE) +head(ADTTE) +head(ADLB) +} \keyword{datasets} diff --git a/man/deprecated.Rd b/man/deprecated.Rd index 8ddcbb5a1..e2005231b 100644 --- a/man/deprecated.Rd +++ b/man/deprecated.Rd @@ -51,7 +51,7 @@ logical representing whether or not to trim away statistic-level metadata and fi only on numeric statistic values.} } \value{ -a tibble +A tibble. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}\cr diff --git a/man/dot-detect_msgs.Rd b/man/dot-detect_msgs.Rd index d74d23af2..a48893107 100644 --- a/man/dot-detect_msgs.Rd +++ b/man/dot-detect_msgs.Rd @@ -13,6 +13,9 @@ a data frame} \item{...}{(\code{\link[rlang:dyn-dots]{dynamic-dots}})\cr columns to search within} } +\value{ +A list with the warnings and errors. +} \description{ Function looks for non-null contents in requested columns and notifies user before removal. Specifically used for detecting messages. diff --git a/tests/testthat/_snaps/add_calculated_row.md b/tests/testthat/_snaps/add_calculated_row.md index caf300268..2c11b4646 100644 --- a/tests/testthat/_snaps/add_calculated_row.md +++ b/tests/testthat/_snaps/add_calculated_row.md @@ -1,51 +1,47 @@ # add_calculated_row(x) Code - apply_fmt_fun(add_calculated_row(ard_summary(mtcars, variables = mpg), expr = max - - min, stat_name = "range")) + out Message - {cards} data frame: 9 x 9 + {cards} data frame: 9 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 mpg summary N N 32 32 - 2 mpg summary mean Mean 20.091 20.1 - 3 mpg summary sd SD 6.027 6.0 - 4 mpg summary median Median 19.2 19.2 - 5 mpg summary p25 Q1 15.35 15.4 - 6 mpg summary p75 Q3 22.8 22.8 - 7 mpg summary min Min 10.4 10.4 - 8 mpg summary max Max 33.9 33.9 - 9 mpg summary range range 23.5 23.5 + variable context stat_name stat_label stat fmt_fun + 1 mpg summary N N 32 0 + 2 mpg summary mean Mean 20.091 1 + 3 mpg summary sd SD 6.027 1 + 4 mpg summary median Median 19.2 1 + 5 mpg summary p25 Q1 15.35 1 + 6 mpg summary p75 Q3 22.8 1 + 7 mpg summary min Min 10.4 1 + 8 mpg summary max Max 33.9 1 + 9 mpg summary range range 23.5 1 Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error --- Code - apply_fmt_fun(add_calculated_row(ard_summary(mtcars, variables = mpg), expr = dplyr::case_when( - mean > median ~ "Right Skew", mean < median ~ "Left Skew", .default = "Symmetric"), - stat_name = "skew")) + out2 Message - {cards} data frame: 9 x 9 + {cards} data frame: 9 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 mpg summary N N 32 32 - 2 mpg summary mean Mean 20.091 20.1 - 3 mpg summary sd SD 6.027 6.0 - 4 mpg summary median Median 19.2 19.2 - 5 mpg summary p25 Q1 15.35 15.4 - 6 mpg summary p75 Q3 22.8 22.8 - 7 mpg summary min Min 10.4 10.4 - 8 mpg summary max Max 33.9 33.9 - 9 mpg summary skew skew Right Sk… Right Skew + variable context stat_name stat_label stat fmt_fun + 1 mpg summary N N 32 0 + 2 mpg summary mean Mean 20.091 1 + 3 mpg summary sd SD 6.027 1 + 4 mpg summary median Median 19.2 1 + 5 mpg summary p25 Q1 15.35 1 + 6 mpg summary p75 Q3 22.8 1 + 7 mpg summary min Min 10.4 1 + 8 mpg summary max Max 33.9 1 + 9 mpg summary skew skew Right Sk… Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error -# add_calculated_row(expr) messaging +# add_calculated_row(expr) errors when a variable is not present Code - add_calculated_row(ard_summary(mtcars, variables = mpg), expr = not_a_stat * 2, - stat_name = "this_doesnt_work") + add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work") Condition Error in `add_calculated_row()`: ! There was an error calculating the new statistic. See below: @@ -54,8 +50,7 @@ # add_calculated_row(by) messaging Code - add_calculated_row(ard_summary(mtcars, variables = mpg, by = cyl), expr = max - - min, stat_name = "range", by = "context") + add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context") Condition Error in `add_calculated_row()`: ! Duplicate statistics present within `by` groups: "N", "mean", "sd", "median", "p25", "p75", "min", "max", "N", "mean", "sd", "median", "p25", "p75", "min", and "max" diff --git a/tests/testthat/_snaps/ard_formals.md b/tests/testthat/_snaps/ard_formals.md index 0bba398f3..5f65bd791 100644 --- a/tests/testthat/_snaps/ard_formals.md +++ b/tests/testthat/_snaps/ard_formals.md @@ -1,7 +1,7 @@ # ard_formals() works Code - ard_formals(fun = mcnemar.test, arg_names = "correct") + out Message {cards} data frame: 1 x 3 Output @@ -11,8 +11,7 @@ --- Code - ard_formals(fun = asNamespace("stats")[["t.test.default"]], arg_names = c("mu", - "paired", "var.equal", "conf.level"), passed_args = list(conf.level = 0.9)) + out Message {cards} data frame: 4 x 3 Output diff --git a/tests/testthat/_snaps/as_nested_list.md b/tests/testthat/_snaps/as_nested_list.md index 0ae2c248f..0dbab30d2 100644 --- a/tests/testthat/_snaps/as_nested_list.md +++ b/tests/testthat/_snaps/as_nested_list.md @@ -1,7 +1,7 @@ # as_nested_list() works Code - as_nested_list(ard_summary(mtcars, by = "cyl", variables = "hp")) + as_nested_list(tbl) Output $variable $variable$hp diff --git a/tests/testthat/_snaps/mock.md b/tests/testthat/_snaps/mock.md index bd986d9c7..9af7e20e0 100644 --- a/tests/testthat/_snaps/mock.md +++ b/tests/testthat/_snaps/mock.md @@ -1,22 +1,21 @@ # mock_categorical() Code - apply_fmt_fun(mock_categorical(variables = list(AGEGR1 = factor(c("<65", "65-80", ">80"), levels = c("<65", "65-80", ">80"))), - by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")))) + out Message - {cards} data frame: 27 x 12 + {cards} data frame: 27 x 11 Output - group1 group1_level variable variable_level stat_name stat_label stat stat_fmt - 1 TRTA Placebo AGEGR1 <65 n n xx - 2 TRTA Placebo AGEGR1 <65 p % xx.x - 3 TRTA Placebo AGEGR1 <65 N N xx - 4 TRTA Placebo AGEGR1 65-80 n n xx - 5 TRTA Placebo AGEGR1 65-80 p % xx.x - 6 TRTA Placebo AGEGR1 65-80 N N xx - 7 TRTA Placebo AGEGR1 >80 n n xx - 8 TRTA Placebo AGEGR1 >80 p % xx.x - 9 TRTA Placebo AGEGR1 >80 N N xx - 10 TRTA Xanomeli… AGEGR1 <65 n n xx + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo AGEGR1 <65 n n + 2 TRTA Placebo AGEGR1 <65 p % + 3 TRTA Placebo AGEGR1 <65 N N + 4 TRTA Placebo AGEGR1 65-80 n n + 5 TRTA Placebo AGEGR1 65-80 p % + 6 TRTA Placebo AGEGR1 65-80 N N + 7 TRTA Placebo AGEGR1 >80 n n + 8 TRTA Placebo AGEGR1 >80 p % + 9 TRTA Placebo AGEGR1 >80 N N + 10 TRTA Xanomeli… AGEGR1 <65 n n Message i 17 more rows i Use `print(n = ...)` to see more rows @@ -34,29 +33,29 @@ # mock_continuous() Code - apply_fmt_fun(mock_continuous(variables = c("AGE", "BMIBL"))) + out Message - {cards} data frame: 16 x 9 + {cards} data frame: 16 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 AGE continuo… N N xx - 2 AGE continuo… mean Mean xx.x - 3 AGE continuo… sd SD xx.x - 4 AGE continuo… median Median xx.x - 5 AGE continuo… p25 Q1 xx.x - 6 AGE continuo… p75 Q3 xx.x - 7 AGE continuo… min Min xx.x - 8 AGE continuo… max Max xx.x - 9 BMIBL continuo… N N xx - 10 BMIBL continuo… mean Mean xx.x - 11 BMIBL continuo… sd SD xx.x - 12 BMIBL continuo… median Median xx.x - 13 BMIBL continuo… p25 Q1 xx.x - 14 BMIBL continuo… p75 Q3 xx.x - 15 BMIBL continuo… min Min xx.x - 16 BMIBL continuo… max Max xx.x + variable context stat_name stat_label stat fmt_fun + 1 AGE continuo… N N + 2 AGE continuo… mean Mean + 3 AGE continuo… sd SD + 4 AGE continuo… median Median + 5 AGE continuo… p25 Q1 + 6 AGE continuo… p75 Q3 + 7 AGE continuo… min Min + 8 AGE continuo… max Max + 9 BMIBL continuo… N N + 10 BMIBL continuo… mean Mean + 11 BMIBL continuo… sd SD + 12 BMIBL continuo… median Median + 13 BMIBL continuo… p25 Q1 + 14 BMIBL continuo… p75 Q3 + 15 BMIBL continuo… min Min + 16 BMIBL continuo… max Max Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error # mock_continuous() messaging @@ -69,21 +68,20 @@ # mock_dichotomous() Code - apply_fmt_fun(mock_dichotomous(variables = list(AGEGR1 = factor("65-80", levels = c("<65", "65-80", ">80"))), by = list(TRTA = c( - "Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")))) + out Message - {cards} data frame: 9 x 12 + {cards} data frame: 9 x 11 Output - group1 group1_level variable variable_level stat_name stat_label stat stat_fmt - 1 TRTA Placebo AGEGR1 65-80 n n xx - 2 TRTA Placebo AGEGR1 65-80 p % xx.x - 3 TRTA Placebo AGEGR1 65-80 N N xx - 4 TRTA Xanomeli… AGEGR1 65-80 n n xx - 5 TRTA Xanomeli… AGEGR1 65-80 p % xx.x - 6 TRTA Xanomeli… AGEGR1 65-80 N N xx - 7 TRTA Xanomeli… AGEGR1 65-80 n n xx - 8 TRTA Xanomeli… AGEGR1 65-80 p % xx.x - 9 TRTA Xanomeli… AGEGR1 65-80 N N xx + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo AGEGR1 65-80 n n + 2 TRTA Placebo AGEGR1 65-80 p % + 3 TRTA Placebo AGEGR1 65-80 N N + 4 TRTA Xanomeli… AGEGR1 65-80 n n + 5 TRTA Xanomeli… AGEGR1 65-80 p % + 6 TRTA Xanomeli… AGEGR1 65-80 N N + 7 TRTA Xanomeli… AGEGR1 65-80 n n + 8 TRTA Xanomeli… AGEGR1 65-80 p % + 9 TRTA Xanomeli… AGEGR1 65-80 N N Message i 4 more variables: context, fmt_fun, warning, error @@ -100,23 +98,23 @@ # mock_missing() Code - apply_fmt_fun(mock_missing(variables = c("AGE", "BMIBL"))) + out Message - {cards} data frame: 10 x 9 + {cards} data frame: 10 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 AGE missing N_obs Vector L… xx - 2 AGE missing N_miss N Missing xx - 3 AGE missing N_nonmiss N Non-mi… xx - 4 AGE missing p_miss % Missing xx.x - 5 AGE missing p_nonmiss % Non-mi… xx.x - 6 BMIBL missing N_obs Vector L… xx - 7 BMIBL missing N_miss N Missing xx - 8 BMIBL missing N_nonmiss N Non-mi… xx - 9 BMIBL missing p_miss % Missing xx.x - 10 BMIBL missing p_nonmiss % Non-mi… xx.x + variable context stat_name stat_label stat fmt_fun + 1 AGE missing N_obs Vector L… + 2 AGE missing N_miss N Missing + 3 AGE missing N_nonmiss N Non-mi… + 4 AGE missing p_miss % Missing + 5 AGE missing p_nonmiss % Non-mi… + 6 BMIBL missing N_obs Vector L… + 7 BMIBL missing N_miss N Missing + 8 BMIBL missing N_nonmiss N Non-mi… + 9 BMIBL missing p_miss % Missing + 10 BMIBL missing p_nonmiss % Non-mi… Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error # mock_missing() messaging @@ -129,7 +127,7 @@ # mock_attributes() Code - mock_attributes(label = list(AGE = "Age", BMIBL = "Baseline BMI")) + out Message {cards} data frame: 4 x 8 Output @@ -152,12 +150,12 @@ # mock_total_n() Code - apply_fmt_fun(mock_total_n()) + out Message - {cards} data frame: 1 x 9 + {cards} data frame: 1 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 ..ard_total_n.. total_n N N xx + variable context stat_name stat_label stat fmt_fun + 1 ..ard_total_n.. total_n N N Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error diff --git a/tests/testthat/_snaps/print_ard_conditions.md b/tests/testthat/_snaps/print_ard_conditions.md index 1fa6055fe..56a1daa80 100644 --- a/tests/testthat/_snaps/print_ard_conditions.md +++ b/tests/testthat/_snaps/print_ard_conditions.md @@ -1,17 +1,12 @@ # print_ard_conditions() works Code - print_ard_conditions(ard_summary(ADSL, variables = AGE)) + print_ard_conditions(ard) --- Code - print_ard_conditions(ard_summary(ADSL, variables = AGE, statistic = ~ list( - mean = function(x) mean(x), mean_warning = function(x) { - warning("warn1") - warning("warn2") - mean(x) - }, err_fn = function(x) stop("'tis an error")))) + print_ard_conditions(ard) Message The following errors were returned during `print_ard_conditions()`: x For variable `AGE` and "err_fn" statistic: 'tis an error @@ -22,12 +17,7 @@ --- Code - print_ard_conditions(ard_summary(ADSL, variables = AGE, by = ARM, statistic = ~ - list(mean = function(x) mean(x), mean_warning = function(x) { - warning("warn1") - warning("warn2") - mean(x) - }, err_fn = function(x) stop("'tis an error")))) + print_ard_conditions(ard) Message The following errors were returned during `print_ard_conditions()`: x For variable `AGE` (`ARM = "Placebo"`) and "err_fn" statistic: 'tis an error @@ -53,12 +43,6 @@ --- Code - tbl_summary <- (function() { - set_cli_abort_call() - ard <- ard_summary(ADSL, variables = AGE, statistic = ~ list(err_fn = function( - x) stop("'tis an error"))) - print_ard_conditions(ard) - }) tbl_summary() Message The following errors were returned during `tbl_summary()`: @@ -67,12 +51,7 @@ # print_ard_conditions(condition_type) Code - print_ard_conditions(ard_summary(ADSL, variables = AGE, statistic = ~ list( - mean_warning = function(x) { - warning("warn1") - warning("warn2") - mean(x) - })), condition_type = "identity") + print_ard_conditions(ard, condition_type = "identity") Message The following warnings were returned during `print_ard_conditions()`: Condition @@ -84,9 +63,7 @@ --- Code - print_ard_conditions(ard_summary(ADSL, variables = AGE, statistic = ~ list( - mean = function(x) mean(x), err_fn = function(x) stop("'tis an error"))), - condition_type = "identity") + print_ard_conditions(ard, condition_type = "identity") Message The following errors were returned during `print_ard_conditions()`: Condition @@ -96,8 +73,7 @@ # print_ard_conditions() no error when 'error'/'warning' columns not present Code - print_ard_conditions(dplyr::select(ard_summary(ADSL, variables = AGE), -warning, - -error)) + print_ard_conditions(ard) # print_ard_conditions() no error when factors are present diff --git a/tests/testthat/_snaps/tidy_as_ard.md b/tests/testthat/_snaps/tidy_as_ard.md index 94a427c44..801a03726 100644 --- a/tests/testthat/_snaps/tidy_as_ard.md +++ b/tests/testthat/_snaps/tidy_as_ard.md @@ -1,128 +1,77 @@ -# tidy_as_ard() works +# tidy_as_ard() works / with standard use Code - as.data.frame(tidy_as_ard(lst_tidy = eval_capture_conditions(dplyr::as_tibble( - stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c("estimate", - "p.value", "method")])), tidy_result_names = c("estimate", "p.value", - "method"), fun_args_to_record = c("workspace", "hybrid", "hybridPars", - "control", "or", "conf.int", "conf.level", "simulate.p.value", "B"), formals = formals( - stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", - group1 = "am", variable = "vs"))) + ard + Message + {cards} data frame: 12 x 8 Output - group1 variable context stat_name - 1 am vs fishertest estimate - 2 am vs fishertest p.value - 3 am vs fishertest method - 4 am vs fishertest workspace - 5 am vs fishertest hybrid - 6 am vs fishertest hybridPars - 7 am vs fishertest control - 8 am vs fishertest or - 9 am vs fishertest conf.int - 10 am vs fishertest conf.level - 11 am vs fishertest simulate.p.value - 12 am vs fishertest B - stat fmt_fun warning error - 1 1.956055 1 NULL NULL - 2 0.4726974 1 NULL NULL - 3 Fisher's Exact Test for Count Data NULL NULL NULL - 4 2e+05 1 NULL NULL - 5 FALSE NULL NULL NULL - 6 c(expect = 5, percent = 80, Emin = 1) NULL NULL NULL - 7 list() NULL NULL NULL - 8 1 1 NULL NULL - 9 TRUE NULL NULL NULL - 10 0.95 1 NULL NULL - 11 FALSE NULL NULL NULL - 12 2000 1 NULL NULL + group1 variable context stat_name stat fmt_fun + 1 am vs fisherte… estimate 1.956 1 + 2 am vs fisherte… p.value 0.473 1 + 3 am vs fisherte… method Fisher's… NULL + 4 am vs fisherte… workspace 2e+05 1 + 5 am vs fisherte… hybrid FALSE NULL + 6 am vs fisherte… hybridPars c, 5, 80, 1 NULL + 7 am vs fisherte… control list NULL + 8 am vs fisherte… or 1 1 + 9 am vs fisherte… conf.int TRUE NULL + 10 am vs fisherte… conf.level 0.95 1 + 11 am vs fisherte… simulate.p.value FALSE NULL + 12 am vs fisherte… B 2000 1 + Message + i 2 more variables: warning, error ---- +# tidy_as_ard() works / when primary stats function errors Code - as.data.frame(tidy_as_ard(lst_tidy = eval_capture_conditions(stop( - "Planned unit testing error!")), tidy_result_names = c("estimate", "p.value", - "conf.low", "conf.high", "method", "alternative"), fun_args_to_record = c( - "workspace", "hybrid", "hybridPars", "control", "or", "conf.int", - "conf.level", "simulate.p.value", "B"), formals = formals(stats::fisher.test), - passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", - variable = "vs"))) + ard + Message + {cards} data frame: 15 x 8 Output - group1 variable context stat_name - 1 am vs fishertest estimate - 2 am vs fishertest p.value - 3 am vs fishertest conf.low - 4 am vs fishertest conf.high - 5 am vs fishertest method - 6 am vs fishertest alternative - 7 am vs fishertest workspace - 8 am vs fishertest hybrid - 9 am vs fishertest hybridPars - 10 am vs fishertest control - 11 am vs fishertest or - 12 am vs fishertest conf.int - 13 am vs fishertest conf.level - 14 am vs fishertest simulate.p.value - 15 am vs fishertest B - stat fmt_fun warning - 1 NULL NULL NULL - 2 NULL NULL NULL - 3 NULL NULL NULL - 4 NULL NULL NULL - 5 NULL NULL NULL - 6 NULL NULL NULL - 7 2e+05 1 NULL - 8 FALSE NULL NULL - 9 c(expect = 5, percent = 80, Emin = 1) NULL NULL - 10 list() NULL NULL - 11 1 1 NULL - 12 TRUE NULL NULL - 13 0.95 1 NULL - 14 FALSE NULL NULL - 15 2000 1 NULL - error - 1 Planned unit testing error! - 2 Planned unit testing error! - 3 Planned unit testing error! - 4 Planned unit testing error! - 5 Planned unit testing error! - 6 Planned unit testing error! - 7 Planned unit testing error! - 8 Planned unit testing error! - 9 Planned unit testing error! - 10 Planned unit testing error! - 11 Planned unit testing error! - 12 Planned unit testing error! - 13 Planned unit testing error! - 14 Planned unit testing error! - 15 Planned unit testing error! + group1 variable context stat_name stat error + 1 am vs fisherte… estimate Planned … + 2 am vs fisherte… p.value Planned … + 3 am vs fisherte… conf.low Planned … + 4 am vs fisherte… conf.high Planned … + 5 am vs fisherte… method Planned … + 6 am vs fisherte… alternative Planned … + 7 am vs fisherte… workspace 2e+05 Planned … + 8 am vs fisherte… hybrid FALSE Planned … + 9 am vs fisherte… hybridPars c, 5, 80, 1 Planned … + 10 am vs fisherte… control list Planned … + 11 am vs fisherte… or 1 Planned … + 12 am vs fisherte… conf.int TRUE Planned … + 13 am vs fisherte… conf.level 0.95 Planned … + 14 am vs fisherte… simulate.p.value FALSE Planned … + 15 am vs fisherte… B 2000 Planned … + Message + i 2 more variables: fmt_fun, warning ---- +# tidy_as_ard() works / when `fun_args_to_record` argument is not passed Code - dplyr::select(as.data.frame(tidy_as_ard(lst_tidy = eval_capture_conditions( - dplyr::as_tibble(stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c( - "estimate", "p.value", "method")])), tidy_result_names = c("estimate", - "p.value", "conf.low", "conf.high", "method", "alternative"), formals = formals( - stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", - group1 = "am", variable = "vs"))), c(group1, variable, stat)) + ard + Message + {cards} data frame: 3 x 8 Output - group1 variable stat - 1 am vs 1.956055 - 2 am vs 0.4726974 - 3 am vs Fisher's Exact Test for Count Data + group1 variable context stat_name stat fmt_fun + 1 am vs fisherte… estimate 1.956 1 + 2 am vs fisherte… p.value 0.473 1 + 3 am vs fisherte… method Fisher's… NULL + Message + i 2 more variables: warning, error ---- +# tidy_as_ard() works / when `formals` argument is not passed. Code - dplyr::select(as.data.frame(tidy_as_ard(lst_tidy = eval_capture_conditions( - dplyr::as_tibble(stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c( - "estimate", "p.value", "method")])), tidy_result_names = c("estimate", - "p.value", "conf.low", "conf.high", "method", "alternative"), passed_args = list(), - lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs"))), - c(group1, variable, stat)) + ard + Message + {cards} data frame: 3 x 8 Output - group1 variable stat - 1 am vs 1.956055 - 2 am vs 0.4726974 - 3 am vs Fisher's Exact Test for Count Data + group1 variable context stat_name stat fmt_fun + 1 am vs fisherte… estimate 1.956 1 + 2 am vs fisherte… p.value 0.473 1 + 3 am vs fisherte… method Fisher's… NULL + Message + i 2 more variables: warning, error diff --git a/tests/testthat/test-add_calculated_row.R b/tests/testthat/test-add_calculated_row.R index 464bbfef6..a52e58e95 100644 --- a/tests/testthat/test-add_calculated_row.R +++ b/tests/testthat/test-add_calculated_row.R @@ -1,38 +1,56 @@ test_that("add_calculated_row(x)", { - expect_snapshot( - ard_summary(mtcars, variables = mpg) |> - add_calculated_row(expr = max - min, stat_name = "range") |> - apply_fmt_fun() + tbl <- ard_summary(mtcars, variables = mpg) + out <- add_calculated_row(tbl, expr = max - min, stat_name = "range") + expect_named(out, c( + "variable", "context", "stat_name", "stat_label", "stat", "fmt_fun", + "warning", "error" + )) + expect_s3_class(out, "card") + + expect_setequal( + out$stat_label, + c("N", "Mean", "SD", "Median", "Q1", "Q3", "Min", "Max", "range") ) - expect_snapshot( - ard_summary(mtcars, variables = mpg) |> - add_calculated_row( - expr = - dplyr::case_when( - mean > median ~ "Right Skew", - mean < median ~ "Left Skew", - .default = "Symmetric" - ), - stat_name = "skew" - ) |> - apply_fmt_fun() + expect_snapshot(out) + out2 <- add_calculated_row( + tbl, + expr = + dplyr::case_when( + mean > median ~ "Right Skew", + mean < median ~ "Left Skew", + .default = "Symmetric" + ), + stat_name = "skew" + ) + expect_setequal( + out2$stat_label, + c("N", "Mean", "SD", "Median", "Q1", "Q3", "Min", "Max", "skew") ) -}) + expect_snapshot(out2) +}) -test_that("add_calculated_row(expr) messaging", { +test_that("add_calculated_row(expr) errors when a variable is not present", { + tbl <- ard_summary(mtcars, variables = mpg) + expect_error( + add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work"), + "calculating the new statistic" + ) expect_snapshot( - ard_summary(mtcars, variables = mpg) |> - add_calculated_row(expr = not_a_stat * 2, stat_name = "this_doesnt_work"), + add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work"), error = TRUE ) }) test_that("add_calculated_row(by) messaging", { + tbl <- ard_summary(mtcars, variables = mpg, by = cyl) + expect_error( + add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context"), + "Duplicate statistics" + ) expect_snapshot( - ard_summary(mtcars, variables = mpg, by = cyl) |> - add_calculated_row(expr = max - min, stat_name = "range", by = "context"), + add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context"), error = TRUE ) }) diff --git a/tests/testthat/test-ard_formals.R b/tests/testthat/test-ard_formals.R index 749df0a24..ff03c35c2 100644 --- a/tests/testthat/test-ard_formals.R +++ b/tests/testthat/test-ard_formals.R @@ -1,13 +1,18 @@ test_that("ard_formals() works", { - expect_snapshot( - ard_formals(fun = mcnemar.test, arg_names = "correct") - ) + out <- ard_formals(fun = mcnemar.test, arg_names = "correct") + expect_s3_class(out, "card") + expect_named(out, c("stat_name", "stat_label", "stat")) + expect_true(nrow(out) == 1L) + expect_snapshot(out) + - expect_snapshot( - ard_formals( - fun = asNamespace("stats")[["t.test.default"]], - arg_names = c("mu", "paired", "var.equal", "conf.level"), - passed_args = list(conf.level = 0.90) - ) + out <- ard_formals( + fun = asNamespace("stats")[["t.test.default"]], + arg_names = c("mu", "paired", "var.equal", "conf.level"), + passed_args = list(conf.level = 0.90) ) + expect_s3_class(out, "card") + expect_named(out, c("stat_name", "stat_label", "stat")) + expect_true(nrow(out) == 4L) + expect_snapshot(out) }) diff --git a/tests/testthat/test-ard_tabulate_rows.R b/tests/testthat/test-ard_tabulate_rows.R index 021bffa1f..67226cbb6 100644 --- a/tests/testthat/test-ard_tabulate_rows.R +++ b/tests/testthat/test-ard_tabulate_rows.R @@ -1,4 +1,14 @@ test_that("ard_tabulate_rows() works", { + out <- ard_tabulate_rows(ADSL, by = TRTA) + expect_named( + out, + c( + "group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) + ) + expect_all_equal(NROW(out), length(unique(ADSL$TRTA))) + expect_snapshot( ard_tabulate_rows(ADSL, by = TRTA) ) diff --git a/tests/testthat/test-as_nested_list.R b/tests/testthat/test-as_nested_list.R index 0fd925697..ccd056581 100644 --- a/tests/testthat/test-as_nested_list.R +++ b/tests/testthat/test-as_nested_list.R @@ -1,6 +1,10 @@ test_that("as_nested_list() works", { + tbl <- ard_summary(mtcars, by = "cyl", variables = "hp") + out <- as_nested_list(tbl) + expect_type(out, "list") + expect_named(out, "variable") + expect_snapshot( - ard_summary(mtcars, by = "cyl", variables = "hp") |> - as_nested_list() + as_nested_list(tbl) ) }) diff --git a/tests/testthat/test-filter_ard_hierarchical.R b/tests/testthat/test-filter_ard_hierarchical.R index 048958678..0a988585a 100644 --- a/tests/testthat/test-filter_ard_hierarchical.R +++ b/tests/testthat/test-filter_ard_hierarchical.R @@ -1,5 +1,3 @@ -skip_on_cran() - ADAE_subset <- cards::ADAE |> dplyr::filter(AETERM %in% unique(cards::ADAE$AETERM)[1:5]) diff --git a/tests/testthat/test-mock.R b/tests/testthat/test-mock.R index e293914a9..11ffc0ffa 100644 --- a/tests/testthat/test-mock.R +++ b/tests/testthat/test-mock.R @@ -1,16 +1,27 @@ test_that("mock_categorical()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_categorical( - variables = list(AGEGR1 = factor(c("<65", "65-80", ">80"), levels = c("<65", "65-80", ">80"))), - by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) - ) |> - apply_fmt_fun() + out <- mock_categorical( + variables = list(AGEGR1 = factor(c("<65", "65-80", ">80"), levels = c("<65", "65-80", ">80"))), + by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) ) + expect_s3_class(out, "card") + expect_named( + out, + c( + "group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) + ) + expect_snapshot(out) }) test_that("mock_categorical() messaging", { # incorrect specification of the statistic argument + + expect_error(mock_categorical( + variables = list(AGEGR1 = factor(c("<65", "65-80", ">80"), levels = c("<65", "65-80", ">80"))), + statistic = ~ c("NOTASTATISTIC") + ), "must be vector with one or more of") expect_snapshot( error = TRUE, mock_categorical( @@ -23,12 +34,19 @@ test_that("mock_categorical() messaging", { test_that("mock_continuous()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_continuous( - variables = c("AGE", "BMIBL") - ) |> - apply_fmt_fun() + + out <- mock_continuous( + variables = c("AGE", "BMIBL") ) + expect_s3_class(out, "card") + expect_named( + out, + c( + "variable", "context", "stat_name", "stat_label", "stat", + "fmt_fun", "warning", "error" + ) + ) + expect_snapshot(out) }) test_that("mock_continuous() messaging", { @@ -44,13 +62,19 @@ test_that("mock_continuous() messaging", { test_that("mock_dichotomous()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_dichotomous( - variables = list(AGEGR1 = factor("65-80", levels = c("<65", "65-80", ">80"))), - by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) - ) |> - apply_fmt_fun() + out <- mock_dichotomous( + variables = list(AGEGR1 = factor("65-80", levels = c("<65", "65-80", ">80"))), + by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) + ) + expect_s3_class(out, "card") + expect_named( + out, + c( + "group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) ) + expect_snapshot(out) }) test_that("mock_dichotomous() messaging", { @@ -66,12 +90,18 @@ test_that("mock_dichotomous() messaging", { test_that("mock_missing()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_missing( - variables = c("AGE", "BMIBL") - ) |> - apply_fmt_fun() + out <- mock_missing( + variables = c("AGE", "BMIBL") + ) + expect_s3_class(out, "card") + expect_named( + out, + c( + "variable", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) ) + expect_snapshot(out) }) test_that("mock_missing() messaging", { @@ -87,11 +117,19 @@ test_that("mock_missing() messaging", { test_that("mock_attributes()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_attributes( - label = list(AGE = "Age", BMIBL = "Baseline BMI") + + out <- mock_attributes( + label = list(AGE = "Age", BMIBL = "Baseline BMI") + ) + expect_s3_class(out, "card") + expect_named( + out, + c( + "variable", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" ) ) + expect_snapshot(out) }) test_that("mock_attributes() messaging", { @@ -104,8 +142,15 @@ test_that("mock_attributes() messaging", { test_that("mock_total_n()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_total_n() |> - apply_fmt_fun() + + out <- mock_total_n() + expect_s3_class(out, "card") + expect_named( + out, + c( + "variable", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) ) + expect_snapshot(out) }) diff --git a/tests/testthat/test-print_ard_conditions.R b/tests/testthat/test-print_ard_conditions.R index 1214b4242..413d1752f 100644 --- a/tests/testthat/test-print_ard_conditions.R +++ b/tests/testthat/test-print_ard_conditions.R @@ -1,46 +1,61 @@ test_that("print_ard_conditions() works", { # nothing prints with no errors/warnings - expect_snapshot( - ard_summary(ADSL, variables = AGE) |> - print_ard_conditions() - ) + + ard <- ard_summary(ADSL, variables = AGE) + expect_null(print_ard_conditions(ard)) + expect_snapshot(print_ard_conditions(ard)) # expected messaging without by variable - expect_snapshot( - ard_summary( - ADSL, - variables = AGE, - statistic = ~ list( - mean = \(x) mean(x), - mean_warning = \(x) { - warning("warn1") - warning("warn2") - mean(x) - }, - err_fn = \(x) stop("'tis an error") - ) - ) |> - print_ard_conditions() + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list( + mean = \(x) mean(x), + mean_warning = \(x) { + warning("warn1") + warning("warn2") + mean(x) + }, + err_fn = \(x) stop("'tis an error") + ) + ) + expect_no_error(ard) + expect_message( + expect_message( + expect_message( + print_ard_conditions(ard), + "were returned during" + ), + "tis an error" + ), + "were returned during" ) + expect_snapshot(print_ard_conditions(ard)) # expected messaging with by variable - expect_snapshot( - ard_summary( - ADSL, - variables = AGE, - by = ARM, - statistic = ~ list( - mean = \(x) mean(x), - mean_warning = \(x) { - warning("warn1") - warning("warn2") - mean(x) - }, - err_fn = \(x) stop("'tis an error") - ) - ) |> - print_ard_conditions() + ard <- ard_summary( + ADSL, + variables = AGE, + by = ARM, + statistic = ~ list( + mean = \(x) mean(x), + mean_warning = \(x) { + warning("warn1") + warning("warn2") + mean(x) + }, + err_fn = \(x) stop("'tis an error") + ) + ) + expect_no_error(ard) + expect_message( + expect_message( + print_ard_conditions(ard), + "were returned during" + ), + "were returned during" ) + expect_snapshot(print_ard_conditions(ard)) # expected messaging when the same error appears for all stats (consolidated correctly) expect_snapshot( @@ -50,61 +65,78 @@ test_that("print_ard_conditions() works", { ) # calling function name prints correctly - expect_snapshot({ - tbl_summary <- function() { - set_cli_abort_call() + tbl_summary <- function() { + set_cli_abort_call() - ard <- ard_summary( - ADSL, - variables = AGE, - statistic = ~ list(err_fn = \(x) stop("'tis an error")) - ) + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list(err_fn = \(x) stop("'tis an error")) + ) - print_ard_conditions(ard) - } - tbl_summary() - }) + print_ard_conditions(ard) + } + expect_message(tbl_summary(), "tbl_summary") + expect_snapshot(tbl_summary()) }) test_that("print_ard_conditions(condition_type)", { # expected warnings as warnings - expect_snapshot( - ard_summary( - ADSL, - variables = AGE, - statistic = ~ list(mean_warning = \(x) { - warning("warn1") - warning("warn2") - mean(x) - }) - ) |> - print_ard_conditions(condition_type = "identity") + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list(mean_warning = \(x) { + warning("warn1") + warning("warn2") + mean(x) + }) + ) + expect_warning( + expect_warning( + expect_message( + print_ard_conditions(ard, condition_type = "identity"), + "print_ard_conditions()" + ), + "warn1" + ), + "warn2" ) + expect_snapshot(print_ard_conditions(ard, condition_type = "identity")) # expected warnings as warnings + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list( + mean = \(x) mean(x), + err_fn = \(x) stop("'tis an error") + ) + ) + expect_error( + expect_message( + print_ard_conditions(ard, condition_type = "identity"), + "print_ard_conditions()" + ), + "tis an error" + ) expect_snapshot( error = TRUE, - ard_summary( - ADSL, - variables = AGE, - statistic = ~ list( - mean = \(x) mean(x), - err_fn = \(x) stop("'tis an error") - ) - ) |> - print_ard_conditions(condition_type = "identity") + print_ard_conditions(ard, condition_type = "identity") ) }) test_that("print_ard_conditions() no error when 'error'/'warning' columns not present", { - expect_snapshot( - ard_summary( - ADSL, - variables = AGE - ) |> - dplyr::select(-warning, -error) |> - print_ard_conditions() - ) + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list( + mean = \(x) mean(x), + err_fn = \(x) stop("'tis an error") + ) + ) |> + dplyr::select(-warning, -error) + expect_no_error(print_ard_conditions(ard)) + expect_snapshot(print_ard_conditions(ard)) }) test_that("print_ard_conditions() no error when factors are present", { @@ -128,6 +160,7 @@ test_that("print_ard_conditions() no error when factors are present", { "card", "tbl_df", "tbl", "data.frame" )) + expect_snapshot( print_ard_conditions(ard) ) diff --git a/tests/testthat/test-tidy_as_ard.R b/tests/testthat/test-tidy_as_ard.R index c5a4f2433..63ba80ef6 100644 --- a/tests/testthat/test-tidy_as_ard.R +++ b/tests/testthat/test-tidy_as_ard.R @@ -1,7 +1,8 @@ -test_that("tidy_as_ard() works", { - # function works with standard use - expect_snapshot( - tidy_as_ard( +describe("tidy_as_ard() works", { + it("with standard use", { + # function works + + ard <- tidy_as_ard( lst_tidy = eval_capture_conditions( # this mimics a tidier @@ -18,13 +19,17 @@ test_that("tidy_as_ard() works", { formals = formals(stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") - ) |> - as.data.frame() - ) + ) + expect_s3_class(ard, "card") + expect_named(ard, c( + "group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error" + )) + expect_snapshot(ard) + }) - # function works when primary stats function errors - expect_snapshot( - tidy_as_ard( + it("when primary stats function errors", { + ard <- tidy_as_ard( lst_tidy = eval_capture_conditions( stop("Planned unit testing error!") @@ -39,13 +44,16 @@ test_that("tidy_as_ard() works", { formals = formals(stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") - ) |> - as.data.frame() - ) - - # function works when `fun_args_to_record` argument is not passed. - expect_snapshot( - tidy_as_ard( + ) + expect_s3_class(ard, "card") + expect_named(ard, c( + "group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error" + )) + expect_snapshot(ard) + }) + it("when `fun_args_to_record` argument is not passed", { + ard <- tidy_as_ard( lst_tidy = eval_capture_conditions( stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c("estimate", "p.value", "method")] |> @@ -56,14 +64,17 @@ test_that("tidy_as_ard() works", { formals = formals(stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") - ) |> - as.data.frame() |> - dplyr::select(c(group1, variable, stat)) - ) + ) + expect_s3_class(ard, "card") + expect_named(ard, c( + "group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error" + )) + expect_snapshot(ard) + }) - # function works when `formals` argument is not passed. - expect_snapshot( - tidy_as_ard( + it("when `formals` argument is not passed.", { + ard <- tidy_as_ard( lst_tidy = eval_capture_conditions( stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c("estimate", "p.value", "method")] |> @@ -73,8 +84,12 @@ test_that("tidy_as_ard() works", { c("estimate", "p.value", "conf.low", "conf.high", "method", "alternative"), passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") - ) |> - as.data.frame() |> - dplyr::select(c(group1, variable, stat)) - ) + ) + expect_s3_class(ard, "card") + expect_named(ard, c( + "group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error" + )) + expect_snapshot(ard) + }) })