diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 4c312c12..da978db9 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -25,7 +25,7 @@ jobs: fail-fast: false matrix: config: - - {os: macos-latest, r: 'release'} +# - {os: macos-latest, r: 'release'} - {os: windows-latest, r: 'release'} - {os: ubuntu-latest, r: 'release'} diff --git a/.gitignore b/.gitignore index 22907fdd..8ed5d2b4 100644 --- a/.gitignore +++ b/.gitignore @@ -32,7 +32,6 @@ programs_external/* #IDE .vscode/settings.json .idea/* -temp_ilse/* #Air air.toml diff --git a/CHANGELOG.md b/CHANGELOG.md index 8524411f..75176e8a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +5,7 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [0.1.3] - 2025-11-28 +## [0.1.2] - 2025-12-10 ### Added and Removed - Add `a_two_tier()` analysis function @@ -31,6 +31,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fixes #102 bug inappropriate warnings from `cond_rm_facets` function - Fix bug for not selecting NA records in `h_subset_combo()` +- Consistent `tt_to_tbldf()` function behavior with invalid structures #116 ## [0.1.1] - 2025-07-28 diff --git a/DESCRIPTION b/DESCRIPTION index 9c681f05..53fb7dea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,6 +14,7 @@ Authors@R: c( person("Ezequiel", "Anokian", , "eanokia1@its.jnj.com", role = c("ctb")), person("Renfei", "Mao", , "rmao6@its.jnj.com", role = c("ctb")), person("Mrinal", "Das", , "mdas35@its.jnj.com", role = c("ctb")), + person("Wojciech", "Wojciak", , "wwojciak@its.jnj.com", role = c("ctb")), person("Isaac", "Gravestock", role = "cph", comment = "Author of included rbmi functions"), person("Joe", "Zhu", role = "cph", @@ -35,19 +36,14 @@ Description: Structure and formatting requirements for clinical trial table and License: Apache License (>= 2) URL: https://github.com/johnsonandjohnson/junco, https://johnsonandjohnson.github.io/junco/ BugReports: https://github.com/johnsonandjohnson/junco/issues -Remotes: - insightsengineering/formatters@main, - insightsengineering/rtables@main, - insightsengineering/rlistings@main, - insightsengineering/tern@main -Depends: +Depends: R (>= 4.4), - formatters (>= 0.5.6), + formatters (>= 0.5.12), rtables (>= 0.6.13) Imports: tidytlg (>= 0.1.5), tern (>= 0.9.9), - rlistings (>= 0.2.11), + rlistings (>= 0.2.13), checkmate (>= 2.1.0), broom, methods, @@ -74,7 +70,9 @@ Suggests: mvtnorm, parallel, readxl, - pharmaverseadam, + rlang, + rbmi (>= 1.3.0), + tidyr, rlang, rbmi (>= 1.3.0), tidyr, @@ -82,4 +80,6 @@ Suggests: pharmaverseadamjnj VignetteBuilder: knitr Config/testthat/edition: 3 +Remotes: + insightsengineering/rtables@main Additional_repositories: https://insightsengineering.r-universe.dev/ diff --git a/NAMESPACE b/NAMESPACE index bd15e293..cf4faa22 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -47,7 +47,6 @@ export(find_missing_chg_after_avisit) export(fit_ancova) export(fit_mmrm_j) export(format_stats) -export(format_xx_fct) export(get_mmrm_lsmeans) export(get_ref_info) export(get_titles_from_file) @@ -60,6 +59,7 @@ export(inches_to_spaces) export(insert_blank_line) export(jj_complex_scorefun) export(jjcs_num_formats) +export(jjcsformat_cnt_den_fract_fct) export(jjcsformat_count_denom_fraction) export(jjcsformat_count_fraction) export(jjcsformat_fraction_count_denom) diff --git a/NEWS.md b/NEWS.md index 05084392..fda8f021 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,8 +10,9 @@ - Remove some unused functions (jj_uc_map, postfun_cog, postfun_eq5d, column_N, non_blank_sentinel, null_fn, unicodify - Replace {pharmaverseadam} with {pharmaverseadamjnj} -- fix bug for not selecting NA records in `h_subset_combo()` -- update `string_to_title()` to handle factors (#26) +- Fix bug for not selecting NA records in `h_subset_combo()` +- Update `string_to_title()` to handle factors (#26) +- Consistent `tt_to_tbldf()` function behavior with invalid structures (#116) ## Other changes diff --git a/R/column_stats.R b/R/column_stats.R index 02cfffaf..4e606730 100644 --- a/R/column_stats.R +++ b/R/column_stats.R @@ -1,60 +1,33 @@ -calc_one_visit <- function(datvec, decimal, statnm, visit, varnm, roundmethod = c("sas", "iec"), exclude_visits, +calc_one_visit <- function(datvec, decimal, statnm, visit, varnm, round_type = valid_round_type, exclude_visits, var_names = c("AVAL", "CHG", "BASE")) { - roundmethod <- match.arg(roundmethod) + round_type <- match.arg(round_type) if (is.na(decimal)) { decimal <- 0 } if ((varnm == var_names[2] || varnm == var_names[3]) && (visit %in% exclude_visits)) { return(NULL) } - if (roundmethod == "sas") { - switch(statnm, - N = length(stats::na.omit(datvec)), - SE = format( - tidytlg::roundSAS(stats::sd(datvec) / sqrt(length(stats::na.omit(datvec))), decimal + 2), - nsmall = decimal + 2 - ), - SD = format( - tidytlg::roundSAS(stats::sd(datvec), decimal + 2), - nsmall = decimal + - 2 - ), - Mean = format(tidytlg::roundSAS(mean(datvec), decimal + 1), nsmall = decimal + 1), - mean_sd = paste0( - format(tidytlg::roundSAS(mean(datvec), decimal + 1), nsmall = decimal + 1), - " (", - format( - tidytlg::roundSAS(stats::sd(datvec), decimal + 2), - nsmall = decimal + - 2 - ), - ")" - ), - Med = format(tidytlg::roundSAS(stats::median(datvec), decimal + 1), nsmall = decimal + 1), - Min = format(tidytlg::roundSAS(min(datvec), decimal), nsmall = decimal), - Max = format(tidytlg::roundSAS(max(datvec), decimal), nsmall = decimal) - ) - } else { - switch(statnm, - N = length(stats::na.omit(datvec)), - SE = format(round(stats::sd(datvec) / sqrt(length(stats::na.omit(datvec))), decimal + 2), nsmall = decimal + 2), - SD = format(round(stats::sd(datvec), decimal + 2), nsmall = decimal + 2), - Mean = format(round(mean(datvec), decimal + 1), nsmall = decimal + 1), - mean_sd = paste0( - format(round(mean(datvec), decimal + 1), nsmall = decimal + 1), - " (", - format( - round(stats::sd(datvec), decimal + 2), - nsmall = decimal + - 2 - ), - ")" - ), - Med = format(round(stats::median(datvec), decimal + 1), nsmall = decimal + 1), - Min = format(round(min(datvec), decimal), nsmall = decimal), - Max = format(round(max(datvec), decimal), nsmall = decimal) - ) - } + + switch(statnm, + N = length(stats::na.omit(datvec)), + SE = round_fmt(stats::sd(datvec) / sqrt(length(stats::na.omit(datvec))), + decimal + 2, + round_type = round_type + ), + SD = round_fmt(stats::sd(datvec), decimal + 2, round_type = round_type), + Mean = round_fmt(mean(datvec), decimal + 1, + round_type = round_type + ), + mean_sd = paste0( + round_fmt(mean(datvec), decimal + 1, round_type = round_type), + " (", + round_fmt(stats::sd(datvec), decimal + 2, round_type = round_type), + ")" + ), + Med = round_fmt(stats::median(datvec), decimal + 1, round_type = round_type), + Min = round_fmt(min(datvec), decimal, round_type = round_type), + Max = round_fmt(max(datvec), decimal, round_type = round_type), + ) } #' @name column_stats diff --git a/R/jjcsformats.R b/R/jjcsformats.R index 428333e5..cfd04ca8 100644 --- a/R/jjcsformats.R +++ b/R/jjcsformats.R @@ -1,45 +1,61 @@ -#' @title Function factory for xx style formatting -#' @description A function factory to generate formatting functions for value -#' formatting that support the xx style format and control the rounding method. +#' @name jjcsformat_xx +#' @title Utility for specifying custom formats +#' +#' @description #' -#' @param roundmethod (`string`)\cr choice of rounding methods. Options are: -#' * `sas`: the underlying rounding method is `tidytlg::roundSAS`, where \cr -#' roundSAS comes from this Stack Overflow post https://stackoverflow.com/questions/12688717/round-up-from-5 -#' * `iec`: the underlying rounding method is `round` +#' Utility for specifying custom formats that can be used as a format in `formatters::format_value` #' -#' @param na_str_dflt (`character`)\cr Character to represent NA value -#' @param replace_na_dflt (`logical(1)`)\cr Should an `na_string` of "NA" within +#' @param str The formatting that is required specified as a text string, eg "xx.xx" +#' @param na_str_dflt Character to represent NA value +#' @param replace_na_dflt logical(1). Should an `na_string` of "NA" within #' the formatters framework be overridden by `na_str_default`? Defaults to #' `TRUE`, as a way to have a different default na string behavior from the #' base `formatters` framework. -#' @return `format_xx_fct()` format function that can be used in rtables formatting calls +#' @param na_str String for NA values. +#' @return Either a supported format string, or a formatting function that can be +#' used as format in `formatters::format_value` +#' @family JJCS formatting functions +#' @rdname jjcsformat_xx #' @export -#' -#' @family JJCS formats #' @examples -#' jjcsformat_xx_SAS <- format_xx_fct(roundmethod = "sas") -#' jjcsformat_xx <- jjcsformat_xx_SAS -#' rcell(c(1.453), jjcsformat_xx("xx.xx")) -#' rcell(c(), jjcsformat_xx("xx.xx")) -#' rcell(c(1.453, 2.45638), jjcsformat_xx("xx.xx (xx.xxx)")) -format_xx_fct <- function(roundmethod = c("sas", "iec"), na_str_dflt = "NE", - replace_na_dflt = TRUE) { - roundmethod <- match.arg(roundmethod) - - if (roundmethod == "sas") { - roundfunc <- tidytlg::roundSAS - } else { - roundfunc <- round +#' value <- c(1.65, 8.645) +#' fmt <- jjcsformat_xx("xx.x") +#' is.function(fmt) +#' fmt +#' format_value(value[1], fmt, round_type = "sas") +#' format_value(value[1], fmt, round_type = "iec") +#' if (is.function(fmt)) fmt(value[1]) +#' +#' fmt2 <- jjcsformat_xx("xx.x (xx.xxx)") +#' is.function(fmt2) +#' value <- c(1.65, 8.645) +#' format_value(value, fmt2, round_type = "sas") +#' format_value(value, fmt2, round_type = "iec") +#' # only possible when resulting format is a function +#' if (is.function(fmt2)) fmt2(value, round_type = "sas") +#' +#' value <- c(1.65, NA) +#' format_value(value, fmt2, round_type = "iec", na_str = c("ne1", "ne2")) +#' if (is.function(fmt2)) fmt2(value, round_type = "iec", na_str = c("ne1", "ne2")) +jjcsformat_xx <- function( + str, + na_str = na_str_dflt, + na_str_dflt = "NE", + replace_na_dflt = TRUE +) { + if (grepl("xxx.", str, fixed = TRUE)) { + stop("Error: jjcsformat_xx do not use xxx. in input str, replace by xx. instead.") } - fnct <- function(str, na_str = na_str_dflt) { - if (grepl("xxx.", str, fixed = TRUE)) { - stop( - "Error: jjcs_format_xx: do not use xxx. in input str, replace by xx. instead." - ) - } + if (identical(str, "default")) { + return(str) + } + + if (is_valid_format(str)) { + rtable_format <- str + } else { if (!grepl("xx", str, fixed = TRUE)) { - stop("Error: jjcs_format_xx: input str must contain xx.") + stop("Error: jjcsformat_xx input str must contain xx.") } positions <- gregexpr( pattern = "xx\\.?x*", @@ -47,82 +63,64 @@ format_xx_fct <- function(roundmethod = c("sas", "iec"), na_str_dflt = "NE", perl = TRUE ) x_positions <- regmatches(x = str, m = positions)[[1]] - ### str is splitted into pieces as xx. xx xx.xxx - ### xx is no rounding - ### xx. rounding to integer - ### xx.x rounding to 1 decimal, etc - - no_round <- function(x, na_str = na_str_dflt) { - if (is.na(x)) { - return(na_str) - } else { - return(x) - } - } - roundings <- lapply(X = x_positions, function(x) { - y <- strsplit(split = "\\.", x = x)[[1]] - ### "xx.x" will result in c("xx","x") - ### "xx." will result in "xx" - ### "xx" will remain "xx" - - if (x == "xx") { - rounding <- no_round - } else { - rounding <- function(x, na_str = na_str_dflt) { - if (is.na(x)) { - return(na_str) - } else { - format( - roundfunc(x, digits = ifelse(length(y) > 1, nchar(y[2]), 0)), - nsmall = ifelse(length(y) > 1, nchar(y[2]), 0) - ) - } + single_rounding <- function(fmt) { + function(x, + na_str, + round_type) { + if (fmt %in% list_valid_format_labels()$`1d`) { + res <- format_value(x, + fmt, + na_str = na_str[1], + round_type = round_type + ) + } else if (fmt %in% paste0("xx.", strrep("x", times = 5:12))) { + # p-value fmt sometimes might need more digits + d <- nchar(sub(".*\\.", "", fmt)) + res <- round_fmt(x, digits = d, round_type = round_type, na_str = na_str[1]) } + res } - return(rounding) + } + + roundings <- lapply(X = x_positions, function(fmt) { + single_rounding(fmt) }) - rtable_format <- function(x, output, na_str = na_str_dflt) { - if (anyNA(na_str) || (replace_na_dflt && any(na_str == "NA"))) { - na_inds <- which(is.na(na_str) | (replace_na_dflt & na_str == "NA")) - na_str[na_inds] <- rep(na_str_dflt, length.out = length(na_str))[na_inds] - } - if (length(x) == 0 || isTRUE(all(x == ""))) { - return(NULL) - } else if (!length(positions[[1]]) == length(x)) { - stop( - "Error: input str in call to jjcs_format_xx must contain same number of xx as the number of stats." - ) - } - values <- Map(y = x, fun = roundings, na_str = na_str, function(y, fun, na_str) fun(y, na_str = na_str)) - regmatches(x = str, m = positions)[[1]] <- values - return(str) - } - return(rtable_format) - } - return(fnct) -} + rtable_format <- + function(x, + output, + round_type = valid_round_type, + na_str = na_str_dflt) { + if (anyNA(na_str) || (replace_na_dflt && any(na_str == "NA"))) { + na_inds <- which(is.na(na_str) | (replace_na_dflt & na_str == "NA")) + na_str[na_inds] <- rep(na_str_dflt, length.out = length(na_str))[na_inds] + } + if (length(x) == 0 || isTRUE(all(x == ""))) { + return(NULL) + } else if (!length(positions[[1]]) == length(x)) { + stop( + "Error: input str in call to jjcsformat_xx must contain same number of xx as the number of stats." + ) + } + round_type <- match.arg(round_type) -jjcsformat_xx_SAS <- format_xx_fct(roundmethod = "sas") -jjcsformat_xx_R <- format_xx_fct(roundmethod = "iec") + values <- Map(y = x, fun = roundings, na_str = na_str, function(y, fun, na_str, output) { + fun(y, na_str = na_str, round_type = round_type) + }) + regmatches(x = str, m = positions)[[1]] <- values + return(str) + } -### if we ever decide to switch rounding method, we just have to update jjcsformat_xx here + return(rtable_format) + } +} -#' @title Formatting of values -#' @name jjcsformat_xx -#' @description jjcs formatting function -#' @param str (`character`)\cr the formatting that is required specified as a text string, eg "xx.xx" -#' @param na_str (`character`)\cr Na string that will be passed from `formatters` into -#' our formatting functions. -#' @return a formatting function with `"sas"`-style rounding. -#' @export -jjcsformat_xx <- jjcsformat_xx_SAS -#' @name count_fraction -#' @title Formatting count and fraction values +#' @name count and fraction related formatting functions +#' @title Formatting functions for count and fraction, and for count denominator and fraction values #' #' @description #' @@ -130,191 +128,130 @@ jjcsformat_xx <- jjcsformat_xx_SAS #' consideration when count is 0, or fraction is 1. #' \cr See also: [tern::format_count_fraction_fixed_dp()] #' -#' @inheritParams format_xx_fct #' @param x (`numeric vector`)\cr Vector with elements `num` and `fraction` or `num`, `denom` and `fraction`. #' @param d (`numeric(1)`)\cr Number of digits to round fraction to (default = 1) #' @param ... Additional arguments passed to other methods. -#' @return A string in the format `count / denom (ratio percent)`. If `count` +#' @param type (`character(1`)\cr One of `count_fraction`, `count_denom_fraction`, `fraction_count_denom`, +#' to specify the type of format the function will represent. +#' @param verbose (`logical`)\cr Whether to print verbose output +#' @param round_type (`character(1)`)\cr the type of rounding to perform. +#' See [formatters::format_value()] for more details. +#' @param output (`string`)\cr output type. +#' See [formatters::format_value()] for more details. +#' @return A formatting function to format input into string in the format `count / denom (ratio percent)`. If `count` #' is 0, the format is `0`. If fraction is >0.99, the format is #' `count / denom (>99.9 percent)` -#' @family JJCS formats +#' @family JJCS formatting functions #' @rdname count_fraction #' @export -#' @examples -#' jjcsformat_count_fraction(c(7, 0.7)) -#' jjcsformat_count_fraction(c(70000, 0.9999999)) -#' jjcsformat_count_fraction(c(70000, 1)) -jjcsformat_count_fraction <- function( - x, - d = 1, - roundmethod = c("sas", "iec"), - ...) { - roundmethod <- match.arg(roundmethod) - attr(x, "label") <- NULL - if (any(is.na(x))) { - return("-") - } - checkmate::assert_vector(x) - checkmate::assert_integerish(x[1]) - assert_proportion_value( - x[2], - include_boundaries = TRUE - ) +jjcsformat_cnt_den_fract_fct <- function(d = 1, + type = c("count_fraction", "count_denom_fraction", "fraction_count_denom"), + verbose = FALSE) { + type <- match.arg(type) + + function(x, + round_type = valid_round_type, + output, + ...) { + obj_label(x) <- NULL + if (any(is.na(x))) { + return("-") + } - fraction <- x[2] + round_type <- match.arg(round_type) - if (isTRUE(all.equal(fraction, 1))) fraction <- 1 + checkmate::assert_vector(x) + count <- x[1] + checkmate::assert_integerish(count) - if (roundmethod == "sas") { - fmtpct <- format(tidytlg::roundSAS(fraction * 100, d), nsmall = d) - } else { - fmtpct <- format(round(fraction * 100, d), nsmall = d) - } + fraction <- switch(type, + "count_fraction" = x[2], + "count_denom_fraction" = x[3], + "fraction_count_denom" = x[3] + ) - result <- if (x[1] == 0) { - "0" - } else if (fraction == 1) { - ## per conventions still report as 100.0% - paste0(x[1], " (100.0%)") - } else if (fmtpct == format(0, nsmall = d)) { - # else if (100*x[2] < 10**(-d)) { - ### example pct = 0.09999 ### <0.1% (even if fmtpct == 0.1, - # but the actual value of pct <0.1) - paste0(x[1], " (<", 10**(-d), "%)") - } else if (fmtpct == format(100, nsmall = d)) { - # else if (100*x[2] > 100-10**(-d)) { - ### example pct = 99.90001 ### >99.9% (even if fmtpct == 99.9, - # but the actual value of pct >99.9) - paste0(x[1], " (>", 100 - 10**(-d), "%)") - } else { - paste0(x[1], " (", fmtpct, "%)") - } - return(result) -} -#' @title Formatting count, denominator and fraction values. -#' -#' @inheritParams count_fraction -#' @param ... Additional arguments passed to other methods. -#' @export -#' @rdname count_denom_fraction -#' @return `x`, formatted into a string with the appropriate -#' format and `d` digits of precision. -#' @examples -#' jjcsformat_count_denom_fraction(c(7, 10, 0.7)) -#' jjcsformat_count_denom_fraction(c(70000, 70001, 70000 / 70001)) -#' jjcsformat_count_denom_fraction(c(235, 235, 235 / 235)) -jjcsformat_count_denom_fraction <- function( - x, - d = 1, - roundmethod = c("sas", "iec"), - ...) { - roundmethod <- match.arg(roundmethod) - attr(x, "label") <- NULL - if (any(is.na(x))) { - return("-") - } - checkmate::assert_vector(x) - checkmate::assert_integerish(x[1]) - assert_proportion_value( - x[3], - include_boundaries = TRUE - ) + assert_proportion_value( + fraction, + include_boundaries = TRUE + ) - fraction <- x[3] - if (x[2] == x[1]) fraction <- 1 + if (isTRUE(all.equal(fraction, 1))) fraction <- 1 - fmt_x12 <- paste0(x[1], "/", x[2]) + if (type == "count_fraction") fmt_cd <- format_value(x = count, format = "xx") + if (type %in% c("count_denom_fraction", "fraction_count_denom")) { + denom <- x[2] + checkmate::assert_integerish(denom) + fmt_cd <- paste0(count, "/", denom) + } - if (roundmethod == "sas") { - fmtpct <- format(tidytlg::roundSAS(fraction * 100, d), nsmall = d) - } else { - fmtpct <- format(round(fraction * 100, d), nsmall = d) - } + if (verbose) message(paste0("round_type used: ", round_type)) - result <- if (x[1] == 0) { - # "0" - # same as in general situation - paste0(fmt_x12, " (", fmtpct, "%)") - } else if (100 * fraction == 100) { - paste0(fmt_x12, " (100.0%)") - } else if (100 * fraction < 10**(-d)) { - ### example pct = 0.09999 ### <0.1% (even if fmtpct == 0.1, but the actual value of pct <0.1) - paste0(fmt_x12, " (<", 10**(-d), "%)") - } else if (100 * fraction > 100 - 10**(-d)) { - ### example pct = 99.90001 ### >99.9% (even if fmtpct == 99.9, but the actual value of pct >99.9) - paste0(fmt_x12, " (>", 100 - 10**(-d), "%)") - } else { - paste0(fmt_x12, " (", fmtpct, "%)") + fmtpct <- format_value(100 * fraction, + format = paste0("xx.", strrep("x", times = d)), + output = "ascii", + round_type = round_type + ) + + fmtpct_p2 <- fmtpct + # deal with special cases + if (fraction == 1) { + fmtpct_p2 <- "100.0" + } else if (fmtpct == format(100, nsmall = d)) { + fmtpct_p2 <- paste0(">", 100 - 10**(-d)) + } else if (count != 0 && fmtpct == format(0, nsmall = d)) { + fmtpct_p2 <- paste0("<", 10**(-d)) + } + + fmtpct_p2 <- paste0(fmtpct_p2, "%") + fmtpct_p <- paste0(" (", fmtpct_p2, ")") + + result <- if (type == "fraction_count_denom") { + paste0(fmtpct_p2, " (", fmt_cd, ")") + } else if (count == 0 && type == "count_fraction") { + 0 + } else { + paste0(fmt_cd, fmtpct_p) + } + + return(result) } - return(result) } -#' @title Formatting fraction, count and denominator values. +#' @rdname count_fraction +#' @export +#' @examples #' -#' @details -#' Formats a 3-dimensional value such that percent values -#' near 0 or 100% are formatted as .e.g, `"<0.1%"` and -#' `">99.9%"`, where the cutoff is controlled by `d`, and -#' formatted as `"xx.x% (xx/xx)"` otherwise, with the -#' precision of the percent also controlled by `d`. +#' jjcsformat_count_fraction(c(7, 0.7)) +#' jjcsformat_count_fraction(c(70000, 70000 / 70001)) +#' jjcsformat_count_fraction(c(235, 235 / 235)) +#' fmt <- jjcsformat_cnt_den_fract_fct(type = "count_fraction", d = 2) +#' fmt(c(23, 23 / 235)) +jjcsformat_count_fraction <- jjcsformat_cnt_den_fract_fct(type = "count_fraction") + +#' @rdname count_fraction +#' @export +#' @examples #' -#' @inheritParams count_fraction -#' @param ... Additional arguments passed to other methods. +#' jjcsformat_count_denom_fraction(c(7, 10, 0.7)) +#' jjcsformat_count_denom_fraction(c(70000, 70001, 70000 / 70001)) +#' jjcsformat_count_denom_fraction(c(235, 235, 235 / 235)) +#' fmt <- jjcsformat_cnt_den_fract_fct(type = "count_denom_fraction", d = 2) +#' fmt(c(23, 235, 23 / 235)) +jjcsformat_count_denom_fraction <- jjcsformat_cnt_den_fract_fct(type = "count_denom_fraction") + +#' @rdname count_fraction #' @export -#' @rdname fraction_count_denom -#' @return `x` formatted as a string with `d` digits of precision, -#' with special cased values as described in Details above. #' @examples +#' #' jjcsformat_fraction_count_denom(c(7, 10, 0.7)) #' jjcsformat_fraction_count_denom(c(70000, 70001, 70000 / 70001)) #' jjcsformat_fraction_count_denom(c(235, 235, 235 / 235)) -jjcsformat_fraction_count_denom <- function( - x, - d = 1, - roundmethod = c("sas", "iec"), - ...) { - roundmethod <- match.arg(roundmethod) - attr(x, "label") <- NULL - if (any(is.na(x))) { - return("-") - } - checkmate::assert_vector(x) - checkmate::assert_integerish(x[1]) - assert_proportion_value( - x[3], - include_boundaries = TRUE - ) - - fraction <- x[3] - if (x[2] == x[1]) fraction <- 1 - - fmt_x12 <- paste0(x[1], "/", x[2]) - - if (roundmethod == "sas") { - fmtpct <- format(tidytlg::roundSAS(fraction * 100, d), nsmall = d) - } else { - fmtpct <- format(round(fraction * 100, d), nsmall = d) - } +#' fmt <- jjcsformat_cnt_den_fract_fct(type = "fraction_count_denom", d = 2) +#' fmt(c(23, 235, 23 / 235)) +jjcsformat_fraction_count_denom <- jjcsformat_cnt_den_fract_fct(type = "fraction_count_denom") - result <- if (x[1] == 0) { - # "0" - # same as in general situation - paste0("(", fmt_x12, ")") - } else if (100 * fraction == 100) { - paste0("100.0%", " (", fmt_x12, ")") - } else if (100 * fraction < 10**(-d)) { - ### example pct = 0.09999 ### <0.1% (even if fmtpct == 0.1, but the actual value of pct <0.1) - paste0("<", 10**(-d), "%", " (", fmt_x12, ")") - } else if (100 * fraction > 100 - 10**(-d)) { - ### example pct = 99.90001 ### >99.9% (even if fmtpct == 99.9, but the actual value of pct >99.9) - paste0(">", 100 - 10**(-d), "%", " (", fmt_x12, ")") - } else { - paste0(fmtpct, "%", " (", fmt_x12, ")") - } - return(result) -} #' @title Function factory for p-value formatting #' @@ -330,7 +267,7 @@ jjcsformat_fraction_count_denom <- function( #' For example, 0.0048 is not rounded to 0.005 but stays at 0.0048 if `alpha = 0.005` #' is set. #' -#' @family JJCS formats +#' @rdname jjcsformat_xx #' @export #' #' @examples @@ -346,27 +283,36 @@ jjcsformat_fraction_count_denom <- function( jjcsformat_pval_fct <- function(alpha = 0.05) { checkmate::assert_number(alpha, lower = 0, upper = 1) - function(x, ...) { + function(x, round_type = valid_round_type, na_str, ...) { + round_type <- match.arg(round_type) checkmate::assert_number( x, lower = 0, upper = 1 + .Machine$double.eps, # Be a bit tolerant here. na.ok = TRUE ) + xx_format <- "xx.xxx" + if (!is.na(x) && alpha < 0.001 && alpha > 0) { + stop("jjcsformat_pval_fct: argument alpha should be 0 or at least 0.001.") + } + if (is.na(x)) { - "NE" + format_value(x, jjcsformat_xx(xx_format), na_str = na_str) } else if (x < 0.001) { "<0.001" } else if (x > 0.999) { ">0.999" } else { - xx_format <- "xx.xxx" - res <- jjcsformat_xx(xx_format)(x) - while (as.numeric(res) == alpha && x < alpha) { + res <- format_value(x, jjcsformat_xx(xx_format), round_type = round_type) # nolint start + while (as.numeric(res) == alpha && x < alpha && + xx_format != paste0("xx.", strrep("x", times = 10))) { # Increase precision by 1 digit until the result # is different from threshold alpha. - xx_format <- paste0(xx_format, "x") - res <- jjcsformat_xx(xx_format)(x) + xx_format <- paste0(xx_format, "x") # nolint end + res <- format_value(x, jjcsformat_xx(xx_format), round_type = round_type) + } + if (xx_format == paste0("xx.", strrep("x", times = 10))) { + # produce message eg "stopped increasing precision for p-value"? } res } @@ -379,28 +325,33 @@ jjcsformat_pval_fct <- function(alpha = 0.05) { #' #' @param str (`string`)\cr the format specifying the number of digits to be used, #' for the range values, e.g. `"xx.xx"`. +#' +#' @param censor_char (`string`)\cr the character (of length 1) to be appended to `min` or `max` #' @return A function that formats a numeric vector with 4 elements: #' - minimum #' - maximum #' - censored minimum? (1 if censored, 0 if event) #' - censored maximum? (1 if censored, 0 if event) #' The range along with the censoring information is returned as a string -#' with the specified numeric format as `(min, max)`, and the `+` is appended +#' with the specified numeric format as `(min, max)`, and the `censor_char` is appended #' to `min` or `max` if these have been censored. #' -#' @family JJCS formats #' @export -#' +#' @rdname jjcsformat_xx #' @examples #' my_range_format <- jjcsformat_range_fct("xx.xx") #' my_range_format(c(0.35235, 99.2342, 1, 0)) #' my_range_format(c(0.35235, 99.2342, 0, 1)) #' my_range_format(c(0.35235, 99.2342, 0, 0)) #' my_range_format(c(0.35235, 99.2342, 1, 1)) -jjcsformat_range_fct <- function(str) { +#' my_range_format <- jjcsformat_range_fct("xx.xx", censor_char = "*") +#' my_range_format(c(0.35235, 99.2342, 1, 1)) +jjcsformat_range_fct <- function(str, censor_char = "+") { format_xx <- jjcsformat_xx(str) + checkmate::assert_string(censor_char, na.ok = FALSE, n.chars = 1) - function(x, ...) { + function(x, output, round_type = valid_round_type, ...) { + round_type <- match.arg(round_type) checkmate::assert_numeric( x, len = 4L, @@ -409,9 +360,11 @@ jjcsformat_range_fct <- function(str) { ) checkmate::assert_true(all(x[c(3, 4)] %in% c(0, 1))) - res <- vapply(x[c(1, 2)], format_xx, character(1)) - if (x[3] == 1) res[1] <- paste0(res[1], "+") - if (x[4] == 1) res[2] <- paste0(res[2], "+") + res <- vapply(x[c(1, 2)], FUN = function(x) { + format_value(x, format_xx, round_type = round_type) + }, character(1)) + if (x[3] == 1) res[1] <- paste0(res[1], censor_char) + if (x[4] == 1) res[2] <- paste0(res[2], censor_char) paste0("(", res[1], ", ", res[2], ")") } } diff --git a/R/junco_utils_default_stats_formats_labels.R b/R/junco_utils_default_stats_formats_labels.R index 30d8bce3..c75a76b8 100644 --- a/R/junco_utils_default_stats_formats_labels.R +++ b/R/junco_utils_default_stats_formats_labels.R @@ -257,6 +257,7 @@ junco_default_formats_start <- c( adj_mean_ci = jjcsformat_xx("(xx.xxx, xx.xxx)"), adj_mean_est_ci = jjcsformat_xx("xx.xxx (xx.xxx, xx.xxx)"), change = "xx.x%", + cv = jjcsformat_xx("xx.xx"), diff = jjcsformat_xx("xx.x"), diff_ci = jjcsformat_xx("(xx.x, xx.x)"), diff_est_ci = jjcsformat_xx("xx.x (xx.x, xx.x)"), @@ -265,6 +266,10 @@ junco_default_formats_start <- c( diff_mean_est_ci = jjcsformat_xx("xx.xxx (xx.xxx, xx.xxx)"), event_free_ci = jjcsformat_xx("xx.xx (xx.xx, xx.xx)"), event_free_rate = jjcsformat_xx("xx.xx"), + geom_sd = jjcsformat_xx("xx.xxx"), + geom_se = jjcsformat_xx("xx.xxx"), + geom_mean_sd = jjcsformat_xx("xx.xx (xx.xxx)"), + geom_mean_se = jjcsformat_xx("xx.xx (xx.xxx)"), hr = jjcsformat_xx("xx.xx"), hr_ci = jjcsformat_xx("(xx.xx, xx.xx)"), hr_ci_3d = jjcsformat_xx("xx.xx (xx.xx, xx.xx)"), @@ -275,10 +280,14 @@ junco_default_formats_start <- c( lsmean_diffci = jjcsformat_xx("xx.xx (xx.xx, xx.xx)"), lsmean_diff_ci = jjcsformat_xx("(xx.xx, xx.xx)"), lsmean_se = jjcsformat_xx("xx.xx (xx.xx)"), + mean = jjcsformat_xx("xx.xx"), mean_sd = jjcsformat_xx("xx.xx (xx.xxx)"), + mean_se = jjcsformat_xx("xx.xx (xx.xxx)"), + mean_pval = jjcsformat_pval_fct(0), median = jjcsformat_xx("xx.xx"), median_ci = jjcsformat_xx("(xx.xx, xx.xx)"), median_ci_3d = jjcsformat_xx("xx.xx (xx.xx, xx.xx)"), + median_range = jjcsformat_xx("xx.xx (xx.x, xx.x)"), n = jjcsformat_xx("xx."), n_tot = jjcsformat_xx("xx."), n_tot_events = jjcsformat_xx("xx."), @@ -288,12 +297,14 @@ junco_default_formats_start <- c( pvalue = jjcsformat_pval_fct(0), p_value = jjcsformat_pval_fct(0), quantiles = jjcsformat_xx("xx.xx, xx.xx"), - range = jjcsformat_xx("xx.xx, xx.xx"), + range = jjcsformat_xx("xx.x, xx.x"), range_with_cens_info = jjcsformat_range_fct("xx.xx"), rate_ci = jjcsformat_xx("(xx.xx, xx.xx)"), rate_se = jjcsformat_xx("xx.xx"), rel_risk_ci = jjcsformat_xx("xx.xx (xx.xx - xx.xx)"), quantiles_upper = jjcsformat_xx("xx.xx (xx.xx, xx.xx)"), + sd = jjcsformat_xx("xx.xxx"), + se = jjcsformat_xx("xx.xxx"), n_altdf = "xx", n_df = "xx", n_rowdf = "xx", diff --git a/R/tt_to_tblfile.R b/R/tt_to_tblfile.R index 8036ad32..4bdd90f2 100644 --- a/R/tt_to_tblfile.R +++ b/R/tt_to_tblfile.R @@ -4,24 +4,46 @@ #' @param fontspec (`font_spec`)\cr Font specification object #' @param string_map (`list`)\cr Unicode mapping for special characters #' @param markup_df (`data.frame`)\cr Data frame containing markup information +#' @param round_type (`character(1)`)\cr the type of rounding to perform. +#' See [formatters::format_value()] for more details. +#' @param validate logical(1). Whether to validate the table structure using +#' `rtables::validate_table_struct()`. Defaults to `TRUE`. If `FALSE`, a message +#' will be displayed instead of stopping with an error when validation fails. #' @return `tt` represented as a `tbl` data.frame suitable for passing #' to [tidytlg::gentlg] via the `huxme` argument. tt_to_tbldf <- function( - tt, - fontspec = font_spec("Times", 9L, 1), - string_map = default_str_map, - markup_df = dps_markup_df) { - if (!validate_table_struct(tt)) { - stop( - "invalid table structure. summarize_row_groups without ", - "analyze below it in layout structure?" - ) + tt, + fontspec = font_spec("Times", 9L, 1), + string_map = default_str_map, + markup_df = dps_markup_df, + round_type = obj_round_type(tt), + validate = TRUE +) { + if (validate) { + if (!validate_table_struct(tt)) { + stop( + "Invalid table structure detected. summarize_row_groups without ", + "analyze below it in layout structure?" + ) + } + } else { + if (!validate_table_struct(tt)) { + message( + "Invalid table structure detected. This may cause issues in the output. ", + "The validation process failed, proceed with caution." + ) + } else { + message( + "Table structure validation succeeded. You should not need to set validate=FALSE." + ) + } } mpf <- matrix_form( tt, indent_rownames = FALSE, expand_newlines = FALSE, - fontspec = fontspec + fontspec = fontspec, + round_type = round_type ) strmat <- mf_strings(mpf) @@ -108,9 +130,10 @@ tlg_type <- function(tt) { } mpf_to_colspan <- function( - mpf, - string_map = default_str_map, - markup_df = dps_markup_df) { + mpf, + string_map = default_str_map, + markup_df = dps_markup_df +) { if (!methods::is(mpf, "MatrixPrintForm")) { stop("figure out how to make this an mpf (MatrixPrintForm) first.") } @@ -213,6 +236,33 @@ get_ncol <- function(tt) { } } +# apply format and round_type to columns of a listing_df object and return as a dataframe +# only for usage as input to gentlg +listingdf_dataframe_formats <- function(df, round_type = obj_round_type(df)) { + if (!is(df, "listing_df")) { + return(df) + } else { + cols <- listing_dispcols(df) + df[cols] <- lapply(names(df), function(col) { + fmt <- obj_format(df[[col]]) + if (!is.null(fmt)) { + na_str <- obj_na_str(df[[col]]) + lbl <- obj_label(df[[col]]) + + df[[col]] <- sapply(df[[col]], FUN = function(x) { + format_value(x, format = fmt, na_str = na_str, round_type = round_type) + }) + + obj_label(df[[col]]) <- lbl + } + df[[col]] + }) + } + + class(df) <- "data.frame" + df +} + #' @name tt_to_tlgrtf #' @title TableTree to .rtf Conversion #' @description @@ -249,9 +299,11 @@ get_ncol <- function(tt) { #' and k is the number of lines the header takes up. See [tidytlg::add_bottom_borders] #' for what the matrix should contain. Users should only specify this when the #' default behavior does not meet their needs. +#' @param round_type (`character(1)`)\cr the type of rounding to perform. +#' See [formatters::format_value()] for more details. #' @param validate logical(1). Whether to validate the table structure using -#' `rtables::validate_table_struct()`. Defaults to `TRUE`. This can also be disabled -#' globally by setting the environment variable `JUNCO_DISABLE_VALIDATION=TRUE`. +#' `rtables::validate_table_struct()`. Defaults to `TRUE`. If `FALSE`, a message +#' will be displayed when validation fails. #' @import rlistings #' @rdname tt_to_tlgrtf #' @export @@ -267,48 +319,53 @@ get_ncol <- function(tt) { #' @return If `file` is non-NULL, this is called for the side-effect of writing #' one or more RTF files. Otherwise, returns a list of `huxtable` objects. tt_to_tlgrtf <- function( + tt, + file = NULL, + orientation = c("portrait", "landscape"), + colwidths = def_colwidths( tt, - file = NULL, - orientation = c("portrait", "landscape"), - colwidths = def_colwidths( - tt, - fontspec, - col_gap = col_gap, - label_width_ins = label_width_ins, - type = tlgtype - ), - label_width_ins = 2, - watermark = NULL, - pagenum = ifelse(tlgtype == "Listing", TRUE, FALSE), - fontspec = font_spec("Times", 9L, 1.2), - pg_width = pg_width_by_orient(orientation == "landscape"), - margins = c(0, 0, 0, 0), - paginate = tlg_type(tt) == "Table", - col_gap = ifelse(tlgtype == "Listing", .5, 3), - nosplitin = list( - row = character(), - col = character() - ), - verbose = FALSE, - tlgtype = tlg_type(tt), - string_map = default_str_map, - markup_df = dps_markup_df, - combined_rtf = FALSE, - one_table = TRUE, - border_mat = make_header_bordmat(obj = tt), - validate = TRUE, - ...) { - # Validate table structure if requested and not disabled by environment variable - # nolint start - if (validate && tlgtype == "Table" && methods::is(tt, "VTableTree") && - Sys.getenv("JUNCO_DISABLE_VALIDATION") != "TRUE") { + fontspec, + col_gap = col_gap, + label_width_ins = label_width_ins, + type = tlgtype + ), + label_width_ins = 2, + watermark = NULL, + pagenum = ifelse(tlgtype == "Listing", TRUE, FALSE), + fontspec = font_spec("Times", 9L, 1.2), + pg_width = pg_width_by_orient(orientation == "landscape"), + margins = c(0, 0, 0, 0), + paginate = tlg_type(tt) == "Table", + col_gap = ifelse(tlgtype == "Listing", .5, 3), + nosplitin = list( + row = character(), + col = character() + ), + verbose = FALSE, + tlgtype = tlg_type(tt), + string_map = default_str_map, + markup_df = dps_markup_df, + combined_rtf = FALSE, + one_table = TRUE, + border_mat = make_header_bordmat(obj = tt), + round_type = obj_round_type(tt), + validate = TRUE, + ... +) { + if (validate && tlgtype == "Table" && methods::is(tt, "VTableTree")) { if (!rtables::validate_table_struct(tt)) { - warning( + message( "Invalid table structure detected. This may cause issues in the output. ", - "Use validate=FALSE to disable this warning or set JUNCO_DISABLE_VALIDATION=TRUE in your environment." + "The validation process failed, proceed with caution." ) } - } # nolint end + } else if (!validate && tlgtype == "Table" && methods::is(tt, "VTableTree")) { + if (rtables::validate_table_struct(tt)) { + message( + "Table structure validation succeeded. You should not need to set validate=FALSE." + ) + } + } orientation <- match.arg(orientation) newdev <- open_font_dev(fontspec) @@ -369,12 +426,13 @@ tt_to_tlgrtf <- function( ) } if (methods::is(tt, "VTableTree")) { - hdrmpf <- matrix_form(tt[1, , keep_topleft = TRUE]) + hdrmpf <- matrix_form(tt[1, , keep_topleft = TRUE], round_type = round_type) } else if (methods::is(tt, "list") && methods::is(tt[[1]], "MatrixPrintForm")) { hdrmpf <- tt[[1]] } else { - hrdmpf <- tt + hdrmpf <- tt } + pags <- paginate_to_mpfs( tt, fontspec = fontspec, @@ -386,7 +444,8 @@ tt_to_tlgrtf <- function( margins = margins, lpp = NULL, nosplitin = nosplitin, - verbose = verbose + verbose = verbose, + round_type = round_type ) ## if (has_force_pag(tt)) { nslices <- which( @@ -443,6 +502,7 @@ tt_to_tlgrtf <- function( string_map = string_map, markup_df = markup_df, border_mat = pag_bord_mats[[i]], + round_type = round_type, ... ) } @@ -465,6 +525,7 @@ tt_to_tlgrtf <- function( colwidths = colwidths, ## this is largely ignored see note in docs # colwidths are already on the pags since they are mpfs border_mat = pag_bord_mats, + round_type = round_type, ... ) } else if (!is.null(file)) { # only one page after pagination @@ -488,7 +549,8 @@ tt_to_tlgrtf <- function( tt_to_tbldf, fontspec = fontspec, string_map = string_map, - markup_df = markup_df + markup_df = markup_df, + round_type = round_type ) if (one_table) { df <- do.call( @@ -512,11 +574,14 @@ tt_to_tlgrtf <- function( tt, fontspec = fontspec, string_map = string_map, - markup_df = markup_df + markup_df = markup_df, + round_type = round_type ) } } else { df <- tt[, listing_dispcols(tt)] + # apply formats and round_type and return df as a dataframe to input in gentlg + df <- listingdf_dataframe_formats(df, round_type = round_type) } ## we only care about the col labels here... @@ -554,7 +619,8 @@ tt_to_tlgrtf <- function( utils::head(tt, 1), indent_rownames = FALSE, expand_newlines = FALSE, - fontspec = fontspec + fontspec = fontspec, + round_type = round_type ) colinfo <- mpf_to_colspan( mpf, @@ -695,8 +761,9 @@ fixup_bord_mat <- function(brdmat, hstrs) { } .make_header_bordmat <- function( - obj, - mpf = matrix_form(utils::head(obj, 1), expand_newlines = FALSE)) { + obj, + mpf = matrix_form(utils::head(obj, 1), expand_newlines = FALSE) +) { spns <- mf_spans(mpf) nlh <- mf_nlheader(mpf) nrh <- mf_nrheader(mpf) diff --git a/_pkgdown.yml b/_pkgdown.yml index 84c69670..3126f854 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -48,7 +48,6 @@ reference: - c_proportion_logical - cmp_cfun - cmp_post_fun - - count_fraction - find_missing_chg_after_avisit - fit_ancova - fit_mmrm_j @@ -92,10 +91,6 @@ reference: - jjcsformat_xx - jjcs_num_formats - jjcsformat_count_denom_fraction - - format_xx_fct - - jjcsformat_fraction_count_denom - - jjcsformat_pval_fct - - jjcsformat_range_fct - insert_blank_line - title: junco Sorting Functions and Pruning Functions diff --git a/inst/WORDLIST b/inst/WORDLIST index bb2df183..1bb9e07b 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -70,6 +70,10 @@ grepl hardcoding https ie +IEC +iec +imputeObj +inriskdiffcol insightsengineering jj jjcs @@ -112,6 +116,7 @@ rrisk rtables rtf rtfs +sas savse scorefun sd diff --git a/man/count_denom_fraction.Rd b/man/count_denom_fraction.Rd deleted file mode 100644 index c4394543..00000000 --- a/man/count_denom_fraction.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/jjcsformats.R -\name{jjcsformat_count_denom_fraction} -\alias{jjcsformat_count_denom_fraction} -\title{Formatting count, denominator and fraction values.} -\usage{ -jjcsformat_count_denom_fraction(x, d = 1, roundmethod = c("sas", "iec"), ...) -} -\arguments{ -\item{x}{(\verb{numeric vector})\cr Vector with elements \code{num} and \code{fraction} or \code{num}, \code{denom} and \code{fraction}.} - -\item{d}{(\code{numeric(1)})\cr Number of digits to round fraction to (default = 1)} - -\item{roundmethod}{(\code{string})\cr choice of rounding methods. Options are: -\itemize{ -\item \code{sas}: the underlying rounding method is \code{tidytlg::roundSAS}, where \cr -roundSAS comes from this Stack Overflow post https://stackoverflow.com/questions/12688717/round-up-from-5 -\item \code{iec}: the underlying rounding method is \code{round} -}} - -\item{...}{Additional arguments passed to other methods.} -} -\value{ -\code{x}, formatted into a string with the appropriate -format and \code{d} digits of precision. -} -\description{ -Formatting count, denominator and fraction values. -} -\examples{ -jjcsformat_count_denom_fraction(c(7, 10, 0.7)) -jjcsformat_count_denom_fraction(c(70000, 70001, 70000 / 70001)) -jjcsformat_count_denom_fraction(c(235, 235, 235 / 235)) -} diff --git a/man/count_fraction.Rd b/man/count_fraction.Rd index 3a9aba9c..a41deb8b 100644 --- a/man/count_fraction.Rd +++ b/man/count_fraction.Rd @@ -1,28 +1,45 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/jjcsformats.R -\name{count_fraction} -\alias{count_fraction} +\name{count and fraction related formatting functions} +\alias{count and fraction related formatting functions} +\alias{jjcsformat_cnt_den_fract_fct} \alias{jjcsformat_count_fraction} -\title{Formatting count and fraction values} +\alias{jjcsformat_count_denom_fraction} +\alias{jjcsformat_fraction_count_denom} +\title{Formatting functions for count and fraction, and for count denominator and fraction values} \usage{ -jjcsformat_count_fraction(x, d = 1, roundmethod = c("sas", "iec"), ...) +jjcsformat_cnt_den_fract_fct( + d = 1, + type = c("count_fraction", "count_denom_fraction", "fraction_count_denom"), + verbose = FALSE +) + +jjcsformat_count_fraction(x, round_type = valid_round_type, output, ...) + +jjcsformat_count_denom_fraction(x, round_type = valid_round_type, output, ...) + +jjcsformat_fraction_count_denom(x, round_type = valid_round_type, output, ...) } \arguments{ +\item{d}{(\code{numeric(1)})\cr Number of digits to round fraction to (default = 1)} + +\item{type}{(\verb{character(1})\cr One of \code{count_fraction}, \code{count_denom_fraction}, \code{fraction_count_denom}, +to specify the type of format the function will represent.} + +\item{verbose}{(\code{logical})\cr Whether to print verbose output} + \item{x}{(\verb{numeric vector})\cr Vector with elements \code{num} and \code{fraction} or \code{num}, \code{denom} and \code{fraction}.} -\item{d}{(\code{numeric(1)})\cr Number of digits to round fraction to (default = 1)} +\item{round_type}{(\code{character(1)})\cr the type of rounding to perform. +See \code{\link[formatters:format_value]{formatters::format_value()}} for more details.} -\item{roundmethod}{(\code{string})\cr choice of rounding methods. Options are: -\itemize{ -\item \code{sas}: the underlying rounding method is \code{tidytlg::roundSAS}, where \cr -roundSAS comes from this Stack Overflow post https://stackoverflow.com/questions/12688717/round-up-from-5 -\item \code{iec}: the underlying rounding method is \code{round} -}} +\item{output}{(\code{string})\cr output type. +See \code{\link[formatters:format_value]{formatters::format_value()}} for more details.} \item{...}{Additional arguments passed to other methods.} } \value{ -A string in the format \verb{count / denom (ratio percent)}. If \code{count} +A formatting function to format input into string in the format \verb{count / denom (ratio percent)}. If \code{count} is 0, the format is \code{0}. If fraction is >0.99, the format is \verb{count / denom (>99.9 percent)} } @@ -32,14 +49,27 @@ consideration when count is 0, or fraction is 1. \cr See also: \code{\link[tern:format_count_fraction_fixed_dp]{tern::format_count_fraction_fixed_dp()}} } \examples{ + jjcsformat_count_fraction(c(7, 0.7)) -jjcsformat_count_fraction(c(70000, 0.9999999)) -jjcsformat_count_fraction(c(70000, 1)) +jjcsformat_count_fraction(c(70000, 70000 / 70001)) +jjcsformat_count_fraction(c(235, 235 / 235)) +fmt <- jjcsformat_cnt_den_fract_fct(type = "count_fraction", d = 2) +fmt(c(23, 23 / 235)) + +jjcsformat_count_denom_fraction(c(7, 10, 0.7)) +jjcsformat_count_denom_fraction(c(70000, 70001, 70000 / 70001)) +jjcsformat_count_denom_fraction(c(235, 235, 235 / 235)) +fmt <- jjcsformat_cnt_den_fract_fct(type = "count_denom_fraction", d = 2) +fmt(c(23, 235, 23 / 235)) + +jjcsformat_fraction_count_denom(c(7, 10, 0.7)) +jjcsformat_fraction_count_denom(c(70000, 70001, 70000 / 70001)) +jjcsformat_fraction_count_denom(c(235, 235, 235 / 235)) +fmt <- jjcsformat_cnt_den_fract_fct(type = "fraction_count_denom", d = 2) +fmt(c(23, 235, 23 / 235)) } \seealso{ -Other JJCS formats: -\code{\link{format_xx_fct}()}, -\code{\link{jjcsformat_pval_fct}()}, -\code{\link{jjcsformat_range_fct}()} +Other JJCS formatting functions: +\code{\link{jjcsformat_xx}()} } -\concept{JJCS formats} +\concept{JJCS formatting functions} diff --git a/man/format_xx_fct.Rd b/man/format_xx_fct.Rd deleted file mode 100644 index 5020e06c..00000000 --- a/man/format_xx_fct.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/jjcsformats.R -\name{format_xx_fct} -\alias{format_xx_fct} -\title{Function factory for xx style formatting} -\usage{ -format_xx_fct( - roundmethod = c("sas", "iec"), - na_str_dflt = "NE", - replace_na_dflt = TRUE -) -} -\arguments{ -\item{roundmethod}{(\code{string})\cr choice of rounding methods. Options are: -\itemize{ -\item \code{sas}: the underlying rounding method is \code{tidytlg::roundSAS}, where \cr -roundSAS comes from this Stack Overflow post https://stackoverflow.com/questions/12688717/round-up-from-5 -\item \code{iec}: the underlying rounding method is \code{round} -}} - -\item{na_str_dflt}{(\code{character})\cr Character to represent NA value} - -\item{replace_na_dflt}{(\code{logical(1)})\cr Should an \code{na_string} of "NA" within -the formatters framework be overridden by \code{na_str_default}? Defaults to -\code{TRUE}, as a way to have a different default na string behavior from the -base \code{formatters} framework.} -} -\value{ -\code{format_xx_fct()} format function that can be used in rtables formatting calls -} -\description{ -A function factory to generate formatting functions for value -formatting that support the xx style format and control the rounding method. -} -\examples{ -jjcsformat_xx_SAS <- format_xx_fct(roundmethod = "sas") -jjcsformat_xx <- jjcsformat_xx_SAS -rcell(c(1.453), jjcsformat_xx("xx.xx")) -rcell(c(), jjcsformat_xx("xx.xx")) -rcell(c(1.453, 2.45638), jjcsformat_xx("xx.xx (xx.xxx)")) -} -\seealso{ -Other JJCS formats: -\code{\link{count_fraction}}, -\code{\link{jjcsformat_pval_fct}()}, -\code{\link{jjcsformat_range_fct}()} -} -\concept{JJCS formats} diff --git a/man/fraction_count_denom.Rd b/man/fraction_count_denom.Rd deleted file mode 100644 index 9cd2084c..00000000 --- a/man/fraction_count_denom.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/jjcsformats.R -\name{jjcsformat_fraction_count_denom} -\alias{jjcsformat_fraction_count_denom} -\title{Formatting fraction, count and denominator values.} -\usage{ -jjcsformat_fraction_count_denom(x, d = 1, roundmethod = c("sas", "iec"), ...) -} -\arguments{ -\item{x}{(\verb{numeric vector})\cr Vector with elements \code{num} and \code{fraction} or \code{num}, \code{denom} and \code{fraction}.} - -\item{d}{(\code{numeric(1)})\cr Number of digits to round fraction to (default = 1)} - -\item{roundmethod}{(\code{string})\cr choice of rounding methods. Options are: -\itemize{ -\item \code{sas}: the underlying rounding method is \code{tidytlg::roundSAS}, where \cr -roundSAS comes from this Stack Overflow post https://stackoverflow.com/questions/12688717/round-up-from-5 -\item \code{iec}: the underlying rounding method is \code{round} -}} - -\item{...}{Additional arguments passed to other methods.} -} -\value{ -\code{x} formatted as a string with \code{d} digits of precision, -with special cased values as described in Details above. -} -\description{ -Formatting fraction, count and denominator values. -} -\details{ -Formats a 3-dimensional value such that percent values -near 0 or 100\% are formatted as .e.g, \code{"<0.1\%"} and -\code{">99.9\%"}, where the cutoff is controlled by \code{d}, and -formatted as \code{"xx.x\% (xx/xx)"} otherwise, with the -precision of the percent also controlled by \code{d}. -} -\examples{ -jjcsformat_fraction_count_denom(c(7, 10, 0.7)) -jjcsformat_fraction_count_denom(c(70000, 70001, 70000 / 70001)) -jjcsformat_fraction_count_denom(c(235, 235, 235 / 235)) -} diff --git a/man/jjcsformat_pval_fct.Rd b/man/jjcsformat_pval_fct.Rd deleted file mode 100644 index d37949e6..00000000 --- a/man/jjcsformat_pval_fct.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/jjcsformats.R -\name{jjcsformat_pval_fct} -\alias{jjcsformat_pval_fct} -\title{Function factory for p-value formatting} -\usage{ -jjcsformat_pval_fct(alpha = 0.05) -} -\arguments{ -\item{alpha}{(\code{numeric})\cr the significance level to account for during rounding.} -} -\value{ -The p-value in the standard format. If \code{count} is 0, the format is \code{0}. -If it is smaller than 0.001, then \verb{<0.001}, if it is larger than 0.999, then -\verb{>0.999} is returned. Otherwise, 3 digits are used. In the special case that -rounding from below would make the string equal to the specified \code{alpha}, -then a higher number of digits is used to be able to still see the difference. -For example, 0.0048 is not rounded to 0.005 but stays at 0.0048 if \code{alpha = 0.005} -is set. -} -\description{ -A function factory to generate formatting functions for p-value -formatting that support rounding close to the significance level specified. -} -\examples{ -my_pval_format <- jjcsformat_pval_fct(0.005) -my_pval_format(0.2802359) -my_pval_format(0.0048) -my_pval_format(0.00499) -my_pval_format(0.004999999) -my_pval_format(0.0051) -my_pval_format(0.0009) -my_pval_format(0.9991) - -} -\seealso{ -Other JJCS formats: -\code{\link{count_fraction}}, -\code{\link{format_xx_fct}()}, -\code{\link{jjcsformat_range_fct}()} -} -\concept{JJCS formats} diff --git a/man/jjcsformat_range_fct.Rd b/man/jjcsformat_range_fct.Rd deleted file mode 100644 index 10cc0927..00000000 --- a/man/jjcsformat_range_fct.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/jjcsformats.R -\name{jjcsformat_range_fct} -\alias{jjcsformat_range_fct} -\title{Function factory for range with censoring information formatting} -\usage{ -jjcsformat_range_fct(str) -} -\arguments{ -\item{str}{(\code{string})\cr the format specifying the number of digits to be used, -for the range values, e.g. \code{"xx.xx"}.} -} -\value{ -A function that formats a numeric vector with 4 elements: -\itemize{ -\item minimum -\item maximum -\item censored minimum? (1 if censored, 0 if event) -\item censored maximum? (1 if censored, 0 if event) -The range along with the censoring information is returned as a string -with the specified numeric format as \verb{(min, max)}, and the \code{+} is appended -to \code{min} or \code{max} if these have been censored. -} -} -\description{ -A function factory to generate formatting functions for range formatting -that includes information about the censoring of survival times. -} -\examples{ -my_range_format <- jjcsformat_range_fct("xx.xx") -my_range_format(c(0.35235, 99.2342, 1, 0)) -my_range_format(c(0.35235, 99.2342, 0, 1)) -my_range_format(c(0.35235, 99.2342, 0, 0)) -my_range_format(c(0.35235, 99.2342, 1, 1)) -} -\seealso{ -Other JJCS formats: -\code{\link{count_fraction}}, -\code{\link{format_xx_fct}()}, -\code{\link{jjcsformat_pval_fct}()} -} -\concept{JJCS formats} diff --git a/man/jjcsformat_xx.Rd b/man/jjcsformat_xx.Rd index 87465f34..dc980cd6 100644 --- a/man/jjcsformat_xx.Rd +++ b/man/jjcsformat_xx.Rd @@ -2,19 +2,109 @@ % Please edit documentation in R/jjcsformats.R \name{jjcsformat_xx} \alias{jjcsformat_xx} -\title{Formatting of values} +\alias{jjcsformat_pval_fct} +\alias{jjcsformat_range_fct} +\title{Utility for specifying custom formats} \usage{ -jjcsformat_xx(str, na_str = na_str_dflt) +jjcsformat_xx( + str, + na_str = na_str_dflt, + na_str_dflt = "NE", + replace_na_dflt = TRUE +) + +jjcsformat_pval_fct(alpha = 0.05) + +jjcsformat_range_fct(str, censor_char = "+") } \arguments{ -\item{str}{(\code{character})\cr the formatting that is required specified as a text string, eg "xx.xx"} +\item{str}{(\code{string})\cr the format specifying the number of digits to be used, +for the range values, e.g. \code{"xx.xx"}.} + +\item{na_str}{String for NA values.} + +\item{na_str_dflt}{Character to represent NA value} -\item{na_str}{(\code{character})\cr Na string that will be passed from \code{formatters} into -our formatting functions.} +\item{replace_na_dflt}{logical(1). Should an \code{na_string} of "NA" within +the formatters framework be overridden by \code{na_str_default}? Defaults to +\code{TRUE}, as a way to have a different default na string behavior from the +base \code{formatters} framework.} + +\item{alpha}{(\code{numeric})\cr the significance level to account for during rounding.} + +\item{censor_char}{(\code{string})\cr the character (of length 1) to be appended to \code{min} or \code{max}} } \value{ -a formatting function with \code{"sas"}-style rounding. +Either a supported format string, or a formatting function that can be +used as format in \code{formatters::format_value} + +The p-value in the standard format. If \code{count} is 0, the format is \code{0}. +If it is smaller than 0.001, then \verb{<0.001}, if it is larger than 0.999, then +\verb{>0.999} is returned. Otherwise, 3 digits are used. In the special case that +rounding from below would make the string equal to the specified \code{alpha}, +then a higher number of digits is used to be able to still see the difference. +For example, 0.0048 is not rounded to 0.005 but stays at 0.0048 if \code{alpha = 0.005} +is set. + +A function that formats a numeric vector with 4 elements: +\itemize{ +\item minimum +\item maximum +\item censored minimum? (1 if censored, 0 if event) +\item censored maximum? (1 if censored, 0 if event) +The range along with the censoring information is returned as a string +with the specified numeric format as \verb{(min, max)}, and the \code{censor_char} is appended +to \code{min} or \code{max} if these have been censored. +} } \description{ -jjcs formatting function +Utility for specifying custom formats that can be used as a format in \code{formatters::format_value} + +A function factory to generate formatting functions for p-value +formatting that support rounding close to the significance level specified. + +A function factory to generate formatting functions for range formatting +that includes information about the censoring of survival times. +} +\examples{ +value <- c(1.65, 8.645) +fmt <- jjcsformat_xx("xx.x") +is.function(fmt) +fmt +format_value(value[1], fmt, round_type = "sas") +format_value(value[1], fmt, round_type = "iec") +if (is.function(fmt)) fmt(value[1]) + +fmt2 <- jjcsformat_xx("xx.x (xx.xxx)") +is.function(fmt2) +value <- c(1.65, 8.645) +format_value(value, fmt2, round_type = "sas") +format_value(value, fmt2, round_type = "iec") +# only possible when resulting format is a function +if (is.function(fmt2)) fmt2(value, round_type = "sas") + +value <- c(1.65, NA) +format_value(value, fmt2, round_type = "iec", na_str = c("ne1", "ne2")) +if (is.function(fmt2)) fmt2(value, round_type = "iec", na_str = c("ne1", "ne2")) +my_pval_format <- jjcsformat_pval_fct(0.005) +my_pval_format(0.2802359) +my_pval_format(0.0048) +my_pval_format(0.00499) +my_pval_format(0.004999999) +my_pval_format(0.0051) +my_pval_format(0.0009) +my_pval_format(0.9991) + +my_range_format <- jjcsformat_range_fct("xx.xx") +my_range_format(c(0.35235, 99.2342, 1, 0)) +my_range_format(c(0.35235, 99.2342, 0, 1)) +my_range_format(c(0.35235, 99.2342, 0, 0)) +my_range_format(c(0.35235, 99.2342, 1, 1)) +my_range_format <- jjcsformat_range_fct("xx.xx", censor_char = "*") +my_range_format(c(0.35235, 99.2342, 1, 1)) +} +\seealso{ +Other JJCS formatting functions: +\code{\link{count and fraction related formatting functions}} } +\concept{JJCS formatting functions} diff --git a/man/tt_to_tbldf.Rd b/man/tt_to_tbldf.Rd index 72a1b4b2..a2434b02 100644 --- a/man/tt_to_tbldf.Rd +++ b/man/tt_to_tbldf.Rd @@ -8,7 +8,9 @@ tt_to_tbldf( tt, fontspec = font_spec("Times", 9L, 1), string_map = default_str_map, - markup_df = dps_markup_df + markup_df = dps_markup_df, + round_type = obj_round_type(tt), + validate = TRUE ) } \arguments{ @@ -19,6 +21,13 @@ tt_to_tbldf( \item{string_map}{(\code{list})\cr Unicode mapping for special characters} \item{markup_df}{(\code{data.frame})\cr Data frame containing markup information} + +\item{round_type}{(\code{character(1)})\cr the type of rounding to perform. +See \code{\link[formatters:format_value]{formatters::format_value()}} for more details.} + +\item{validate}{logical(1). Whether to validate the table structure using +\code{rtables::validate_table_struct()}. Defaults to \code{TRUE}. If \code{FALSE}, a message +will be displayed instead of stopping with an error when validation fails.} } \value{ \code{tt} represented as a \code{tbl} data.frame suitable for passing diff --git a/man/tt_to_tlgrtf.Rd b/man/tt_to_tlgrtf.Rd index 33a78dd8..87eb14e4 100644 --- a/man/tt_to_tlgrtf.Rd +++ b/man/tt_to_tlgrtf.Rd @@ -26,6 +26,7 @@ tt_to_tlgrtf( combined_rtf = FALSE, one_table = TRUE, border_mat = make_header_bordmat(obj = tt), + round_type = obj_round_type(tt), validate = TRUE, ... ) @@ -83,9 +84,12 @@ and k is the number of lines the header takes up. See \link[tidytlg:add_bottom_b for what the matrix should contain. Users should only specify this when the default behavior does not meet their needs.} +\item{round_type}{(\code{character(1)})\cr the type of rounding to perform. +See \code{\link[formatters:format_value]{formatters::format_value()}} for more details.} + \item{validate}{logical(1). Whether to validate the table structure using -\code{rtables::validate_table_struct()}. Defaults to \code{TRUE}. This can also be disabled -globally by setting the environment variable \code{JUNCO_DISABLE_VALIDATION=TRUE}.} +\code{rtables::validate_table_struct()}. Defaults to \code{TRUE}. If \code{FALSE}, a message +will be displayed when validation fails.} \item{...}{Additional arguments passed to gentlg} } diff --git a/tests/testthat/_snaps/a_freq_j.md b/tests/testthat/_snaps/a_freq_j.md index 2e98c93c..250992b7 100644 --- a/tests/testthat/_snaps/a_freq_j.md +++ b/tests/testthat/_snaps/a_freq_j.md @@ -1,3 +1,27 @@ +# a_freq_j with label_map works in a table layout as expected + + Code + result + Output + A B + ——————————————————————————————————————————— + No Response 30/50 (60.0%) 28/50 (56.0%) + Response 20/50 (40.0%) 22/50 (44.0%) + +# a_freq_j with label_map restricts the values according to row split and label_map + + Code + result + Output + A B + —————————————————————————————————————————— + Baseline + Response A 6/50 (12.0%) 4/50 (8.0%) + Response B 6/50 (12.0%) 4/50 (8.0%) + Week 1 + Response C 3/50 (6.0%) 7/50 (14.0%) + Response D 9/50 (18.0%) 7/50 (14.0%) + # a_freq_j_with_exclude allows to exclude row split levels from the analysis Code diff --git a/tests/testthat/_snaps/coxreg_multivar.md b/tests/testthat/_snaps/coxreg_multivar.md index 0fbca21e..02aaec89 100644 --- a/tests/testthat/_snaps/coxreg_multivar.md +++ b/tests/testthat/_snaps/coxreg_multivar.md @@ -80,10 +80,10 @@ Coeff. (SE) p-value Estimate 50% CI —————————————————————————————————————————————————————————————————————————————————————————— Model Parameter - Treatment (B: Placebo vs. A: Drug X) 0 (0) <0.001 1.5170 (1.4, 1.6) - Treatment (C: Combination vs. A: Drug X) 1 (0) <0.001 1.9203 (1.8, 2.1) - Sex (M vs. F) 0 (0) 0.099 0.8813 (0.8, 0.9) - Age 0 (0) 0.646 1.0024 (1.0, 1.0) + Treatment (B: Placebo vs. A: Drug X) 0.4 (0.1) <0.001 1.5170 (1.4, 1.6) + Treatment (C: Combination vs. A: Drug X) 0.7 (0.1) <0.001 1.9203 (1.8, 2.1) + Sex (M vs. F) -0.1 (0.1) 0.099 0.8813 (0.8, 0.9) + Age 0.0 (0.0) 0.646 1.0024 (1.0, 1.0) # summarize_coxreg_multivar works with row splits diff --git a/tests/testthat/_snaps/jjcs_num_formats.md b/tests/testthat/_snaps/jjcs_num_formats.md index 15df9649..bbe44134 100644 --- a/tests/testthat/_snaps/jjcs_num_formats.md +++ b/tests/testthat/_snaps/jjcs_num_formats.md @@ -24,23 +24,26 @@ --- Code - format_value(values, format = jjcsformat_xx_SAS("xx.x (xx.xx)")) + format_value(values, format = jjcsformat_xx("xx.x (xx.xx)"), round_type = "sas") Output [1] "5.1 (7.89)" Code - format_value(values, format = jjcsformat_xx_R("xx.x (xx.xx)")) + format_value(values, format = jjcsformat_xx("xx.x (xx.xx)"), round_type = "iec") Output [1] "5.1 (7.89)" Code - format_value(c(5.05, values[2]), format = jjcsformat_xx_SAS("xx.x (xx.xx)")) + format_value(c(5.05, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), + round_type = "sas") Output [1] "5.1 (7.89)" Code - format_value(c(5.05, values[2]), format = jjcsformat_xx_R("xx.x (xx.xx)")) + format_value(c(5.05, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), + round_type = "iec") Output [1] "5.0 (7.89)" Code - format_value(c(5.15, values[2]), format = jjcsformat_xx_R("xx.x (xx.xx)")) + format_value(c(5.15, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), + round_type = "iec") Output [1] "5.2 (7.89)" Code @@ -48,11 +51,13 @@ Output [1] "5.2 (7.9)" Code - format_value(c(4.15, values[2]), format = jjcsformat_xx_SAS("xx.x (xx.xx)")) + format_value(c(4.15, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), + round_type = "sas") Output [1] "4.2 (7.89)" Code - format_value(c(4.15, values[2]), format = jjcsformat_xx_R("xx.x (xx.xx)")) + format_value(c(4.15, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), + round_type = "iec") Output [1] "4.2 (7.89)" Code @@ -60,7 +65,8 @@ Output [1] "4.2 (7.9)" Code - format_value(c(4.15, values[2]), format = jjcsformat_xx_SAS("xx.x (xx.x)")) + format_value(c(4.15, values[2]), format = jjcsformat_xx("xx.x (xx.x)"), + round_type = "sas") Output [1] "4.2 (7.9)" Code @@ -68,303 +74,316 @@ Output [1] "3.1 (7.9)" Code - format_value(c(3.15, values[2]), format = jjcsformat_xx_SAS("xx.x (xx.x)")) + format_value(c(3.15, values[2]), format = jjcsformat_xx("xx.x (xx.x)"), + round_type = "sas") Output [1] "3.2 (7.9)" Code - format_value(c(3.15, values[2]), format = jjcsformat_xx_R("xx.x (xx.x)")) + format_value(c(3.15, values[2]), format = jjcsformat_xx("xx.x (xx.x)"), + round_type = "iec") Output [1] "3.1 (7.9)" --- Code - format_value(values, format = jjcsformat_xx_SAS("xx / xx")) + format_value(values, format = jjcsformat_xx("xx / xx"), round_type = "sas") Output [1] "5.123456 / 7.891112" Code - format_value(values, format = jjcsformat_xx_SAS("xx. / xx.")) + format_value(values, format = jjcsformat_xx("xx. / xx."), round_type = "sas") Output [1] "5 / 8" Code - format_value(values, format = jjcsformat_xx_SAS("xx.x / xx.x")) + format_value(values, format = jjcsformat_xx("xx.x / xx.x"), round_type = "sas") Output [1] "5.1 / 7.9" Code - format_value(values, format = jjcsformat_xx_SAS("xx.xx / xx.xx")) + format_value(values, format = jjcsformat_xx("xx.xx / xx.xx"), round_type = "sas") Output [1] "5.12 / 7.89" Code - format_value(values, format = jjcsformat_xx_SAS("xx.xxx / xx.xxx")) + format_value(values, format = jjcsformat_xx("xx.xxx / xx.xxx"), round_type = "sas") Output [1] "5.123 / 7.891" Code - format_value(values, format = jjcsformat_xx_SAS("(xx, xx)")) + format_value(values, format = jjcsformat_xx("(xx, xx)"), round_type = "sas") Output [1] "(5.123456, 7.891112)" Code - format_value(values, format = jjcsformat_xx_SAS("(xx., xx.)")) + format_value(values, format = jjcsformat_xx("(xx., xx.)"), round_type = "sas") Output [1] "(5, 8)" Code - format_value(values, format = jjcsformat_xx_SAS("(xx.x, xx.x)")) + format_value(values, format = jjcsformat_xx("(xx.x, xx.x)"), round_type = "sas") Output [1] "(5.1, 7.9)" Code - format_value(values, format = jjcsformat_xx_SAS("(xx.xx, xx.xx)")) + format_value(values, format = jjcsformat_xx("(xx.xx, xx.xx)"), round_type = "sas") Output [1] "(5.12, 7.89)" Code - format_value(values, format = jjcsformat_xx_SAS("(xx.xxx, xx.xxx)")) + format_value(values, format = jjcsformat_xx("(xx.xxx, xx.xxx)"), round_type = "sas") Output [1] "(5.123, 7.891)" Code - format_value(values, format = jjcsformat_xx_SAS("(xx.xxxx, xx.xxxx)")) + format_value(values, format = jjcsformat_xx("(xx.xxxx, xx.xxxx)"), round_type = "sas") Output [1] "(5.1235, 7.8911)" Code - format_value(values, format = jjcsformat_xx_SAS("xx - xx")) + format_value(values, format = jjcsformat_xx("xx - xx"), round_type = "sas") Output [1] "5.123456 - 7.891112" Code - format_value(values, format = jjcsformat_xx_SAS("xx.x - xx.x")) + format_value(values, format = jjcsformat_xx("xx.x - xx.x"), round_type = "sas") Output [1] "5.1 - 7.9" Code - format_value(values, format = jjcsformat_xx_SAS("xx.xx - xx.xx")) + format_value(values, format = jjcsformat_xx("xx.xx - xx.xx"), round_type = "sas") Output [1] "5.12 - 7.89" Code - format_value(values, format = jjcsformat_xx_SAS("xx (xx)")) + format_value(values, format = jjcsformat_xx("xx (xx)"), round_type = "sas") Output [1] "5.123456 (7.891112)" Code - format_value(values, format = jjcsformat_xx_SAS("xx (xx.)")) + format_value(values, format = jjcsformat_xx("xx (xx.)"), round_type = "sas") Output [1] "5.123456 (8)" Code - format_value(values, format = jjcsformat_xx_SAS("xx (xx.x)")) + format_value(values, format = jjcsformat_xx("xx (xx.x)"), round_type = "sas") Output [1] "5.123456 (7.9)" Code - format_value(values, format = jjcsformat_xx_SAS("xx (xx.xx)")) + format_value(values, format = jjcsformat_xx("xx (xx.xx)"), round_type = "sas") Output [1] "5.123456 (7.89)" Code - format_value(values, format = jjcsformat_xx_SAS("xx. (xx.)")) + format_value(values, format = jjcsformat_xx("xx. (xx.)"), round_type = "sas") Output [1] "5 (8)" Code - format_value(values, format = jjcsformat_xx_SAS("xx.x (xx.x)")) + format_value(values, format = jjcsformat_xx("xx.x (xx.x)"), round_type = "sas") Output [1] "5.1 (7.9)" Code - format_value(values, format = jjcsformat_xx_SAS("xx.xx (xx.xx)")) + format_value(values, format = jjcsformat_xx("xx.xx (xx.xx)"), round_type = "sas") Output [1] "5.12 (7.89)" Code - format_value(values, format = jjcsformat_xx_SAS("xx.x, xx.x")) + format_value(values, format = jjcsformat_xx("xx.x, xx.x"), round_type = "sas") Output [1] "5.1, 7.9" Code - format_value(values, format = jjcsformat_xx_SAS("xx.x to xx.x")) + format_value(values, format = jjcsformat_xx("xx.x to xx.x"), round_type = "sas") Output [1] "5.1 to 7.9" Code - format_value(c(values, 10.1235), format = jjcsformat_xx_SAS("xx. (xx. - xx.)")) + format_value(c(values, 10.1235), format = jjcsformat_xx("xx. (xx. - xx.)"), + round_type = "sas") Output [1] "5 (8 - 10)" Code - format_value(c(values, 10.1235), format = jjcsformat_xx_SAS( - "xx.x (xx.x - xx.x)")) + format_value(c(values, 10.1235), format = jjcsformat_xx("xx.x (xx.x - xx.x)"), + round_type = "sas") Output [1] "5.1 (7.9 - 10.1)" Code - format_value(c(values, 10.1235), format = jjcsformat_xx_SAS( - "xx.xx (xx.xx - xx.xx)")) + format_value(c(values, 10.1235), format = jjcsformat_xx("xx.xx (xx.xx - xx.xx)"), + round_type = "sas") Output [1] "5.12 (7.89 - 10.12)" Code - format_value(c(values, 10.1235), format = jjcsformat_xx_SAS( - "xx.xxx (xx.xxx - xx.xxx)")) + format_value(c(values, 10.1235), format = jjcsformat_xx( + "xx.xxx (xx.xxx - xx.xxx)"), round_type = "sas") Output [1] "5.123 (7.891 - 10.124)" Code - format_value(NULL, jjcsformat_xx_SAS("xx")) + format_value(NULL, jjcsformat_xx("xx"), round_type = "sas") Output [1] "" Code - format_value(c(500), jjcsformat_xx_SAS("N=xx")) + format_value(c(500), jjcsformat_xx("N=xx"), round_type = "sas") Output [1] "N=500" Code - format_value(c(500), jjcsformat_xx_SAS("(N=xx)")) + format_value(c(500), jjcsformat_xx("(N=xx)"), round_type = "sas") Output [1] "(N=500)" --- Code - format_value(0, jjcsformat_xx_SAS("xx.")) + format_value(0, jjcsformat_xx("xx."), round_type = "sas") Output [1] "0" Code - format_value(0, jjcsformat_xx_SAS("xx.x")) + format_value(0, jjcsformat_xx("xx.x"), round_type = "sas") Output [1] "0.0" Code - format_value(0, jjcsformat_xx_SAS("xx.xx")) + format_value(0, jjcsformat_xx("xx.xx"), round_type = "sas") Output [1] "0.00" Code - format_value(0, jjcsformat_xx_SAS("xx.xxx")) + format_value(0, jjcsformat_xx("xx.xxx"), round_type = "sas") Output [1] "0.000" Code - format_value(0, jjcsformat_xx_SAS("xx.xxxx")) + format_value(0, jjcsformat_xx("xx.xxxx"), round_type = "sas") Output [1] "0.0000" # jjcsformats NA works Code - format_value(NA, jjcsformat_xx_SAS("xx."), na_str = "-") + format_value(NA, jjcsformat_xx("xx."), round_type = "sas", na_str = "-") Output [1] "-" Code - format_value(NA, jjcsformat_xx_SAS("xx"), na_str = "-") + format_value(NA, jjcsformat_xx("xx"), round_type = "sas", na_str = "-") Output [1] "-" --- Code - format_value(c(1.2, NA, NA), jjcsformat_xx_SAS("xx.x (xx.x - xx.x)"), na_str = "NA") + format_value(c(1.2, NA, NA), jjcsformat_xx("xx.x (xx.x - xx.x)"), round_type = "sas", + na_str = "NE") Output [1] "1.2 (NE - NE)" Code - format_value(c(1.2, NA, NA), jjcsformat_xx_SAS("xx.x (xx.x - xx.x)"), na_str = "x") + format_value(c(1.2, NA, NA), jjcsformat_xx("xx.x (xx.x - xx.x)"), round_type = "sas", + na_str = "x") Output [1] "1.2 (x - x)" Code - format_value(c(NA, NA, NA), jjcsformat_xx_SAS("xx.x (xx.x - xx.x)"), na_str = "x") + format_value(c(NA, NA, NA), jjcsformat_xx("xx.x (xx.x - xx.x)"), round_type = "sas", + na_str = "x") Output [1] "x" --- Code - format_value(c(NA, NA), format = jjcsformat_xx_SAS("xx.x - xx.x"), na_str = c( - "hi", "lo")) + format_value(c(NA, NA), format = jjcsformat_xx("xx.x - xx.x"), round_type = "sas", + na_str = c("hi", "lo")) Output [1] "hi - lo" Code - format_value(c(NA, 5.2), format = jjcsformat_xx_SAS("xx.x - xx.x"), na_str = "what") + format_value(c(NA, 5.2), format = jjcsformat_xx("xx.x - xx.x"), round_type = "sas", + na_str = "what") Output [1] "what - 5.2" Code - format_value(c(NA, 5.2), format = jjcsformat_xx_SAS("xx.x - xx.x"), na_str = c( - "hi", "lo")) + format_value(c(NA, 5.2), format = jjcsformat_xx("xx.x - xx.x"), round_type = "sas", + na_str = c("hi", "lo")) Output [1] "hi - 5.2" Code - format_value(c(NA, NA), format = jjcsformat_xx_SAS("xx.x - xx.x"), na_str = "what") + format_value(c(NA, NA), format = jjcsformat_xx("xx.x - xx.x"), round_type = "sas", + na_str = "what") Output [1] "what" --- Code - format_value(NA, format = jjcsformat_xx_SAS("xx.x"), na_str = character()) + format_value(NA, format = jjcsformat_xx("xx.x"), round_type = "sas", na_str = character()) Output [1] "NA" Code - format_value(NA, format = jjcsformat_xx_SAS("xx.x"), na_str = NA_character_) + format_value(NA, format = jjcsformat_xx("xx.x"), round_type = "sas", na_str = NA_character_) Output [1] "NA" --- Code - format_value(c(6.23, NA, NA), format = jjcsformat_xx_SAS("xx.x (xx.xx, xx.xx)"), - na_str = "-") + format_value(c(6.23, NA, NA), format = jjcsformat_xx("xx.x (xx.xx, xx.xx)"), + round_type = "sas", na_str = "-") Output [1] "6.2 (-, -)" Code - format_value(c(NA, NA, NA), format = jjcsformat_xx_SAS("xx.x (xx.xx, xx.xx)"), - na_str = "-") + format_value(c(NA, NA, NA), format = jjcsformat_xx("xx.x (xx.xx, xx.xx)"), + round_type = "sas", na_str = "-") Output [1] "-" Code - format_value(c(6.23, NA, NA), format = jjcsformat_xx_SAS("xx.x (xx.xx, xx.xx)"), - na_str = c("-", "x", "x")) + format_value(c(6.23, NA, NA), format = jjcsformat_xx("xx.x (xx.xx, xx.xx)"), + round_type = "sas", na_str = c("-", "x", "x")) Output [1] "6.2 (-, x)" Code - format_value(c(6.23, NA, NA), format = jjcsformat_xx_SAS("xx.x (xx.xx, xx.xx)"), - na_str = c("-", "x", "y")) + format_value(c(6.23, NA, NA), format = jjcsformat_xx("xx.x (xx.xx, xx.xx)"), + round_type = "sas", na_str = c("-", "x", "y")) Output [1] "6.2 (-, x)" # jjcsformats count_fraction works Code - format_value(cdf, format = jjcsformat_count_denom_fraction) + format_value(cdf, format = jjcsformat_count_denom_fraction, round_type = "sas") Output [1] "5/2000 (0.3%)" Code - format_value(cf, format = jjcsformat_count_fraction) + format_value(cf, format = jjcsformat_count_fraction, round_type = "sas") Output [1] "5 (0.3%)" Code - format_value(cf, format = "xx (xx.x%)") + format_value(cf, format = "xx (xx.x%)", round_type = "iec") Output [1] "5 (0.2%)" Code - format_value(c(2000, 2001, 2000 / 2001), format = jjcsformat_count_denom_fraction) + format_value(c(2000, 2001, 2000 / 2001), format = jjcsformat_count_denom_fraction, + round_type = "sas") Output [1] "2000/2001 (>99.9%)" Code - format_value(c(2000, 2000 / 2001), format = "xx (xx.x%)") + format_value(c(2000, 2000 / 2001), format = "xx (xx.x%)", round_type = "iec") Output [1] "2000 (100.0%)" Code - format_value(c(1, 2001, 1 / 2001), format = jjcsformat_count_denom_fraction) + format_value(c(1, 2001, 1 / 2001), format = jjcsformat_count_denom_fraction, + round_type = "sas") Output [1] "1/2001 (<0.1%)" Code - format_value(c(1, 1 / 2001), format = "xx (xx.x%)") + format_value(c(1, 1 / 2001), format = "xx (xx.x%)", round_type = "iec") Output [1] "1 (0.0%)" Code - format_value(c(3, 3, 3 / 3), format = jjcsformat_count_denom_fraction) + format_value(c(3, 3, 3 / 3), format = jjcsformat_count_denom_fraction, + round_type = "sas") Output [1] "3/3 (100.0%)" Code - format_value(c(3, 3 / 3), format = "xx (xx.x%)") + format_value(c(3, 3 / 3), format = "xx (xx.x%)", round_type = "iec") Output [1] "3 (100.0%)" Code - format_value(rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), na_str = rep( - "NA", 10)) + format_value(rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), + round_type = "sas", na_str = rep("NE", 10)) Output [1] "NE (NE, NE)" Code - format_value(rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), na_str = rep( - "NA", 1)) + format_value(rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), + round_type = "sas", na_str = rep("NA", 1)) Output [1] "NA" Code - format_value(rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)")) + format_value(rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), + round_type = "sas", na_str = "NA") Output [1] "NA" Code - format_value(c(1, rep(NA, 2)), format = jjcsformat_xx("xx.x (xx.x, xx.x)")) + format_value(c(1, rep(NA, 2)), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), + round_type = "sas", na_str = rep("NE", 10)) Output [1] "1.0 (NE, NE)" Code format_value(c(1, rep(NA, 2)), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), - na_str = c("ne1", "ne2", "ne3")) + round_type = "sas", na_str = c("ne1", "ne2", "ne3")) Output [1] "1.0 (ne1, ne2)" diff --git a/tests/testthat/_snaps/jjcsformats.md b/tests/testthat/_snaps/jjcsformats.md index b7ee6ced..391fa205 100644 --- a/tests/testthat/_snaps/jjcsformats.md +++ b/tests/testthat/_snaps/jjcsformats.md @@ -199,6 +199,10 @@ my_range_format(c(0.35235, 99.2342, 1, 1)) Output [1] "(0.35+, 99.23+)" + Code + my_range_format2(c(0.35235, 99.2342, 0, 1)) + Output + [1] "(0.35, 99.23*)" # jjcsformat_pval_fct works @@ -210,6 +214,10 @@ jjcsformat_pval_fct(0.005)(0.00499) Output [1] "0.00499" + Code + jjcsformat_pval_fct(0.005)(0.000499) + Output + [1] "<0.001" Code jjcsformat_pval_fct(0)(0.0048) Output @@ -246,4 +254,24 @@ jjcsformat_pval_fct(0)(0.9990000001) Output [1] ">0.999" + Code + jjcsformat_pval_fct(0)(NA_real_, na_str = "ne") + Output + [1] "ne" + Code + jjcsformat_pval_fct(5e-04)(NA_real_, na_str = "ne") + Output + [1] "ne" + Code + jjcsformat_pval_fct(0.005)(0.004999999) + Output + [1] "0.004999999" + Code + jjcsformat_pval_fct(0.005)(0.0049999999) + Output + [1] "0.0049999999" + Code + jjcsformat_pval_fct(0.005)(0.00499999999) + Output + [1] "0.0050000000" diff --git a/tests/testthat/_snaps/junco_utils_default_stats_formats_labels.md b/tests/testthat/_snaps/junco_utils_default_stats_formats_labels.md index 70cba432..882ed6fe 100644 --- a/tests/testthat/_snaps/junco_utils_default_stats_formats_labels.md +++ b/tests/testthat/_snaps/junco_utils_default_stats_formats_labels.md @@ -11,14 +11,14 @@ Code normalize_fun(res$quantiles_upper) Output - [1] "{if(anyNA(na_str)||(replace_na_dflt&&any(na_str==\"NA\"))){na_inds<-which(is.na(na_str)|(replace_na_dflt&na_str==\"NA\"))na_str[na_inds]<-rep(na_str_dflt,length.out=length(na_str))[na_inds]}if(length(x)==0||isTRUE(all(x==\"\"))){return(NULL)}elseif(!length(positions[[1]])==length(x)){stop(\"Error:inputstrincalltojjcs_format_xxmustcontainsamenumberofxxasthenumberofstats.\")}values<-Map(y=x,fun=roundings,na_str=na_str,function(y,fun,na_str)fun(y,na_str=na_str))regmatches(x=str,m=positions)[[1]]<-valuesreturn(str)}" + [1] "{if(anyNA(na_str)||(replace_na_dflt&&any(na_str==\"NA\"))){na_inds<-which(is.na(na_str)|(replace_na_dflt&na_str==\"NA\"))na_str[na_inds]<-rep(na_str_dflt,length.out=length(na_str))[na_inds]}if(length(x)==0||isTRUE(all(x==\"\"))){return(NULL)}elseif(!length(positions[[1]])==length(x)){stop(\"Error:inputstrincalltojjcsformat_xxmustcontainsamenumberofxxasthenumberofstats.\")}round_type<-match.arg(round_type)values<-Map(y=x,fun=roundings,na_str=na_str,function(y,fun,na_str,output){fun(y,na_str=na_str,round_type=round_type)})regmatches(x=str,m=positions)[[1]]<-valuesreturn(str)}" --- Code normalize_fun(res$range_with_cens_info) Output - [1] "{checkmate::assert_numeric(x,len=4L,finite=TRUE,any.missing=FALSE)checkmate::assert_true(all(x[c(3,4)]%in%c(0,1)))res<-vapply(x[c(1,2)],format_xx,character(1))if(x[3]==1)res[1]<-paste0(res[1],\"+\")if(x[4]==1)res[2]<-paste0(res[2],\"+\")paste0(\"(\",res[1],\",\",res[2],\")\")}" + [1] "{round_type<-match.arg(round_type)checkmate::assert_numeric(x,len=4L,finite=TRUE,any.missing=FALSE)checkmate::assert_true(all(x[c(3,4)]%in%c(0,1)))res<-vapply(x[c(1,2)],FUN=function(x){format_value(x,format_xx,round_type=round_type)},character(1))if(x[3]==1)res[1]<-paste0(res[1],censor_char)if(x[4]==1)res[2]<-paste0(res[2],censor_char)paste0(\"(\",res[1],\",\",res[2],\")\")}" # get_labels_from_stats works as expected diff --git a/tests/testthat/_snaps/summarize_ancova.md b/tests/testthat/_snaps/summarize_ancova.md index 915adf41..5e2a0e28 100644 --- a/tests/testthat/_snaps/summarize_ancova.md +++ b/tests/testthat/_snaps/summarize_ancova.md @@ -48,7 +48,7 @@ n 50 50 50 Mean (SD) 1.46 (0.174) 4.26 (0.470) 5.55 (0.552) Median 1.50 4.35 5.55 - Min, max 1.00, 1.90 3.00, 5.10 4.50, 6.90 + Min, max 1.0, 1.9 3.0, 5.1 4.5, 6.9 25% and 75%-ile 1.40, 1.60 4.00, 4.60 5.10, 5.90 Difference in Adjusted Means (95% CI) 2.80 (2.63, 2.97) 4.09 (3.92, 4.26) p-value <0.001 <0.001 diff --git a/tests/testthat/_snaps/tt_to_tblfile/test3allparts.rtf b/tests/testthat/_snaps/tt_to_tblfile/test3allparts.rtf old mode 100644 new mode 100755 diff --git a/tests/testthat/_snaps/tt_to_tblfile/test4iec.rtf b/tests/testthat/_snaps/tt_to_tblfile/test4iec.rtf new file mode 100755 index 00000000..c14ce897 --- /dev/null +++ b/tests/testthat/_snaps/tt_to_tblfile/test4iec.rtf @@ -0,0 +1,40 @@ +{\rtf1\ansi\deff0\portrait\paperw12240\paperh15840\margl1440\margr1440\margt1440\margb1440\headery1440\footery1440{\stylesheet{\ql \li0\ri0\widctlpar\wrapdefault\faauto\adjustright\rin0\lin0\itap0 \rtlch\fcs1 \af0\afs20\alang1025 \ltrch\fcs0 \fs20\lang9\langfe3081\loch\f0\hich\af0\dbch\af31505\cgrid\langnp9\langfenp3081 \snext0 \sqformat \spriority0 Normal;}{\s15\ql \fi-1152\li1152\ri0\keepn\widctlpar\tx1152\wrapdefault\faauto\rin0\lin1152\itap0 \rtlch\fcs1 \af0\afs18\alang1025 \ltrch\fcs0 \b\fs20\lang1033\langfe1033\loch\f0\hich\af0\dbch\af31505\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 \sqformat caption;}{\s16 \ql \fi-1152\li1152\ri0\keepn\widctlpar\tx1152\wrapdefault\faauto\rin0\lin1152\itap0 \rtlch\fcs1 \af0\afs18\alang1025 \ltrch\fcs0 \b\fs20\lang1033\langfe1033\loch\f0\hich\af0\dbch\af31505\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 \sqformat;}} + + +{ +\trowd +\trqc \clmgf\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx2872 +\clmrg\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx4786 +\clmrg\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx6701 +\clmrg\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx9189 \pard\intbl\ql\fs20 \b \pnhang\trhdr\fi-1152\li1152\keepn\s15 test4iec:\tab \b0 \cell +\pard\intbl\ql\fs20 \b \b0 \cell +\pard\intbl\ql\fs20 \b \b0 \cell +\pard\intbl\ql\fs20 \b \b0 \cell +\row +} + +{ +\trowd +\trqc \clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadr67\clpadfr3\cellx2872 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadt67\clpadft3\clpadr67\clpadfr3\cellx4786 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadt67\clpadft3\clpadr67\clpadfr3\cellx6701 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadt67\clpadft3\clpadr67\clpadfr3\cellx9189 \pard\intbl\ql\fs18 \keepn\trhdr \cell +\pard\intbl\qc\fs18 \keepn\trhdr ARM A \cell +\pard\intbl\qc\fs18 \keepn\trhdr ARM B \cell +\pard\intbl\qc\fs18 \keepn\trhdr ARM C \cell +\row +} + +{ +\trowd +\trqc \clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx2872 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx4786 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx6701 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx9189 \pard\intbl\ql\fs18 \intbl\li87\fi-87 Mean \cell +\pard\intbl\qc\fs18 1.86 \cell +\pard\intbl\qc\fs18 2.98 \cell +\pard\intbl\qc\fs18 -0.00 \cell +\row +} + +} \ No newline at end of file diff --git a/tests/testthat/_snaps/tt_to_tblfile/test4iecmod.rtf b/tests/testthat/_snaps/tt_to_tblfile/test4iecmod.rtf new file mode 100755 index 00000000..01c9e2a4 --- /dev/null +++ b/tests/testthat/_snaps/tt_to_tblfile/test4iecmod.rtf @@ -0,0 +1,40 @@ +{\rtf1\ansi\deff0\portrait\paperw12240\paperh15840\margl1440\margr1440\margt1440\margb1440\headery1440\footery1440{\stylesheet{\ql \li0\ri0\widctlpar\wrapdefault\faauto\adjustright\rin0\lin0\itap0 \rtlch\fcs1 \af0\afs20\alang1025 \ltrch\fcs0 \fs20\lang9\langfe3081\loch\f0\hich\af0\dbch\af31505\cgrid\langnp9\langfenp3081 \snext0 \sqformat \spriority0 Normal;}{\s15\ql \fi-1152\li1152\ri0\keepn\widctlpar\tx1152\wrapdefault\faauto\rin0\lin1152\itap0 \rtlch\fcs1 \af0\afs18\alang1025 \ltrch\fcs0 \b\fs20\lang1033\langfe1033\loch\f0\hich\af0\dbch\af31505\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 \sqformat caption;}{\s16 \ql \fi-1152\li1152\ri0\keepn\widctlpar\tx1152\wrapdefault\faauto\rin0\lin1152\itap0 \rtlch\fcs1 \af0\afs18\alang1025 \ltrch\fcs0 \b\fs20\lang1033\langfe1033\loch\f0\hich\af0\dbch\af31505\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 \sqformat;}} + + +{ +\trowd +\trqc \clmgf\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx2872 +\clmrg\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx4786 +\clmrg\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx6701 +\clmrg\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx9189 \pard\intbl\ql\fs20 \b \pnhang\trhdr\fi-1152\li1152\keepn\s15 test4iecmod:\tab \b0 \cell +\pard\intbl\ql\fs20 \b \b0 \cell +\pard\intbl\ql\fs20 \b \b0 \cell +\pard\intbl\ql\fs20 \b \b0 \cell +\row +} + +{ +\trowd +\trqc \clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadr67\clpadfr3\cellx2872 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadt67\clpadft3\clpadr67\clpadfr3\cellx4786 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadt67\clpadft3\clpadr67\clpadfr3\cellx6701 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadt67\clpadft3\clpadr67\clpadfr3\cellx9189 \pard\intbl\ql\fs18 \keepn\trhdr \cell +\pard\intbl\qc\fs18 \keepn\trhdr ARM A \cell +\pard\intbl\qc\fs18 \keepn\trhdr ARM B \cell +\pard\intbl\qc\fs18 \keepn\trhdr ARM C \cell +\row +} + +{ +\trowd +\trqc \clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx2872 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx4786 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx6701 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx9189 \pard\intbl\ql\fs18 \intbl\li87\fi-87 Mean \cell +\pard\intbl\qc\fs18 1.86 \cell +\pard\intbl\qc\fs18 2.98 \cell +\pard\intbl\qc\fs18 0.00 \cell +\row +} + +} \ No newline at end of file diff --git a/tests/testthat/_snaps/tt_to_tblfile/test4sas.rtf b/tests/testthat/_snaps/tt_to_tblfile/test4sas.rtf new file mode 100755 index 00000000..fde5d3a4 --- /dev/null +++ b/tests/testthat/_snaps/tt_to_tblfile/test4sas.rtf @@ -0,0 +1,40 @@ +{\rtf1\ansi\deff0\portrait\paperw12240\paperh15840\margl1440\margr1440\margt1440\margb1440\headery1440\footery1440{\stylesheet{\ql \li0\ri0\widctlpar\wrapdefault\faauto\adjustright\rin0\lin0\itap0 \rtlch\fcs1 \af0\afs20\alang1025 \ltrch\fcs0 \fs20\lang9\langfe3081\loch\f0\hich\af0\dbch\af31505\cgrid\langnp9\langfenp3081 \snext0 \sqformat \spriority0 Normal;}{\s15\ql \fi-1152\li1152\ri0\keepn\widctlpar\tx1152\wrapdefault\faauto\rin0\lin1152\itap0 \rtlch\fcs1 \af0\afs18\alang1025 \ltrch\fcs0 \b\fs20\lang1033\langfe1033\loch\f0\hich\af0\dbch\af31505\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 \sqformat caption;}{\s16 \ql \fi-1152\li1152\ri0\keepn\widctlpar\tx1152\wrapdefault\faauto\rin0\lin1152\itap0 \rtlch\fcs1 \af0\afs18\alang1025 \ltrch\fcs0 \b\fs20\lang1033\langfe1033\loch\f0\hich\af0\dbch\af31505\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 \sqformat;}} + + +{ +\trowd +\trqc \clmgf\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx2872 +\clmrg\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx4786 +\clmrg\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx6701 +\clmrg\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx9189 \pard\intbl\ql\fs20 \b \pnhang\trhdr\fi-1152\li1152\keepn\s15 test4sas:\tab \b0 \cell +\pard\intbl\ql\fs20 \b \b0 \cell +\pard\intbl\ql\fs20 \b \b0 \cell +\pard\intbl\ql\fs20 \b \b0 \cell +\row +} + +{ +\trowd +\trqc \clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadr67\clpadfr3\cellx2872 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadt67\clpadft3\clpadr67\clpadfr3\cellx4786 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadt67\clpadft3\clpadr67\clpadfr3\cellx6701 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\clpadt67\clpadft3\clpadr67\clpadfr3\cellx9189 \pard\intbl\ql\fs18 \keepn\trhdr \cell +\pard\intbl\qc\fs18 \keepn\trhdr ARM A \cell +\pard\intbl\qc\fs18 \keepn\trhdr ARM B \cell +\pard\intbl\qc\fs18 \keepn\trhdr ARM C \cell +\row +} + +{ +\trowd +\trqc \clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx2872 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx4786 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx6701 +\clbrdrt\brdrs\brdrw18\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx9189 \pard\intbl\ql\fs18 \intbl\li87\fi-87 Mean \cell +\pard\intbl\qc\fs18 1.87 \cell +\pard\intbl\qc\fs18 2.99 \cell +\pard\intbl\qc\fs18 0.00 \cell +\row +} + +} \ No newline at end of file diff --git a/tests/testthat/helper_rbmi.R b/tests/testthat/helper_rbmi.R index 00408c6d..7c99cad9 100644 --- a/tests/testthat/helper_rbmi.R +++ b/tests/testthat/helper_rbmi.R @@ -19,7 +19,7 @@ rbmi_as_analysis <- function( next_class %in% c("jackknife", "bootstrap", "rubin", "bmlmi") ) x <- list( - results = as_class(results, c(next_class, "list")), + results = rbmi::as_class(results, c(next_class, "list")), delta = delta, fun = fun, fun_name = fun_name, @@ -54,21 +54,21 @@ get_sim_data <- function(n, sigma, trt = 4) { ) ) - dat <- mvtnorm::rmvnorm(n, sigma = sigma) %>% - set_col_names(paste0("visit_", 1:nv)) %>% - dplyr::as_tibble() %>% - dplyr::mutate(id = seq_len(dplyr::n())) %>% - tidyr::gather("visit", "outcome", -id) %>% - dplyr::mutate(visit = factor(.data$visit)) %>% - dplyr::arrange(id, .data$visit) %>% - dplyr::left_join(covars, by = "id") %>% + dat <- mvtnorm::rmvnorm(n, sigma = sigma) |> + set_col_names(paste0("visit_", 1:nv)) |> + dplyr::as_tibble() |> + dplyr::mutate(id = seq_len(dplyr::n())) |> + tidyr::gather("visit", "outcome", -id) |> + dplyr::mutate(visit = factor(.data$visit)) |> + dplyr::arrange(id, .data$visit) |> + dplyr::left_join(covars, by = "id") |> dplyr::mutate( outcome = .data$outcome + 5 + 3 * .data$age + 3 * f2n(.data$sex) + trt * f2n(.data$group) - ) %>% + ) |> dplyr::mutate(id = as.factor(id)) return(dat) diff --git a/tests/testthat/sas_comparison/relative_risk.R b/tests/testthat/sas_comparison/relative_risk.R index 90f1a98a..35be3446 100644 --- a/tests/testthat/sas_comparison/relative_risk.R +++ b/tests/testthat/sas_comparison/relative_risk.R @@ -261,7 +261,7 @@ dat <- data.frame( )) ) -lyt <- basic_table() |> +lyt <- basic_table(round_type = "sas") |> split_cols_by("Treatment", ref_group = "B") |> analyze( vars = "Response", diff --git a/tests/testthat/test-a_freq_j.R b/tests/testthat/test-a_freq_j.R index c1e6bb91..6493f191 100644 --- a/tests/testthat/test-a_freq_j.R +++ b/tests/testthat/test-a_freq_j.R @@ -20,6 +20,7 @@ test_that("a_freq_j with label_map works in a table layout as expected", { ) ) result <- build_table(lyt, dta) + expect_snapshot(result) }) test_that("a_freq_j with label_map restricts the values according to row split and label_map", { @@ -47,6 +48,7 @@ test_that("a_freq_j with label_map restricts the values according to row split a ) ) result <- build_table(lyt, dta) + expect_snapshot(result) }) test_that("a_freq_j_with_exclude allows to exclude row split levels from the analysis", { diff --git a/tests/testthat/test-a_freq_resp_var_j.R b/tests/testthat/test-a_freq_resp_var_j.R index 8c1009eb..5c7e6754 100644 --- a/tests/testthat/test-a_freq_resp_var_j.R +++ b/tests/testthat/test-a_freq_resp_var_j.R @@ -16,8 +16,8 @@ test_that("a_freq_resp_var_j works as expected with basic usage", { ) # Create the layout based on patterns seen in test-varia.R - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( "SEX", afun = a_freq_resp_var_j, @@ -54,8 +54,8 @@ test_that("a_freq_resp_var_j works with factor responses", { ) # Create the layout - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( "SEX", afun = a_freq_resp_var_j, @@ -86,8 +86,8 @@ test_that("a_freq_resp_var_j handles missing values correctly", { adrs$SEX[6:10] <- NA # Create the layout - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( "SEX", afun = a_freq_resp_var_j, @@ -117,8 +117,8 @@ test_that("a_freq_resp_var_j errors on invalid responses", { adrs$RSP[1:3] <- "MAYBE" # Create the layout - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( "SEX", afun = a_freq_resp_var_j, @@ -148,8 +148,8 @@ test_that("a_freq_resp_var_j errors when resp_var is null", { ) # Create layout with missing resp_var - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( "SEX", afun = a_freq_resp_var_j @@ -178,8 +178,8 @@ test_that("a_freq_resp_var_j works with drop_levels parameter", { ) # Create layout with drop_levels = TRUE - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( "SEX", afun = a_freq_resp_var_j, @@ -210,8 +210,8 @@ test_that("a_freq_resp_var_j works with riskdiff parameter", { ) # Create layout with drop_levels = TRUE - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( "SEX", afun = a_freq_resp_var_j, diff --git a/tests/testthat/test-a_maxlev.R b/tests/testthat/test-a_maxlev.R index 62de37e6..e1e53f8d 100644 --- a/tests/testthat/test-a_maxlev.R +++ b/tests/testthat/test-a_maxlev.R @@ -16,7 +16,7 @@ test_that("a_maxlev produces correct numbers for single treatment per subject", AESEV := ordered(AESEV, levels = c("Missing", "Mild", "Moderate", "Severe")) ) - lyt <- basic_table() |> + lyt <- basic_table(round_type = "sas") |> split_cols_by("ARM") |> add_overall_col("Total") |> split_rows_by("AESEV", split_fun = aesevall_spf) |> diff --git a/tests/testthat/test-a_summarize_aval_chg_diff.R b/tests/testthat/test-a_summarize_aval_chg_diff.R index 316b6501..d1431547 100644 --- a/tests/testthat/test-a_summarize_aval_chg_diff.R +++ b/tests/testthat/test-a_summarize_aval_chg_diff.R @@ -57,7 +57,7 @@ test_that("a_summarize_aval_chg_diff_j works as expected", { CHG = c(2, 3, -1, 9, -2, 0, 6, -2, 5, 2) ) - ADEG <- ADEG %>% + ADEG <- ADEG |> mutate( TRT01A = as.factor(TRT01A), STUDYID = as.factor(STUDYID) @@ -94,40 +94,40 @@ test_that("a_summarize_aval_chg_diff_j works as expected", { ref_path <- c("colspan_trt", " ", "TRT01A", "Placebo") - lyt <- basic_table() %>% + lyt <- basic_table(round_type = "sas") |> ### first columns split_cols_by( "colspan_trt", split_fun = trim_levels_to_map(map = colspan_trt_map) - ) %>% - split_cols_by("TRT01A") %>% + ) |> + split_cols_by("TRT01A") |> split_rows_by( "PARAM", label_pos = "topleft", split_label = "Blood Pressure", section_div = " ", split_fun = drop_split_levels - ) %>% + ) |> split_rows_by( "AVISIT", label_pos = "topleft", split_label = "Study Visit", split_fun = drop_split_levels, child_labels = "hidden" - ) %>% + ) |> ## set up a 3 column split split_cols_by_multivar( c("AVAL", "AVAL", "CHG"), varlabels = c("n/N (%)", "Mean (CI)", "CFB (CI)") - ) %>% - split_cols_by("rrisk_header", nested = FALSE) %>% + ) |> + split_cols_by("rrisk_header", nested = FALSE) |> split_cols_by( "TRT01A", split_fun = remove_split_levels("Placebo"), labels_var = "rrisk_label" - ) %>% + ) |> ### difference columns : just 1 column & analysis needs to be done on change - split_cols_by_multivar(c("CHG"), varlabels = c(" ")) %>% + split_cols_by_multivar(c("CHG"), varlabels = c(" ")) |> ### the variable passed here in analyze is not used (STUDYID), it is a dummy var passing, ### the function a_summarize_aval_chg_diff_j grabs the required vars from cols_by_multivar calls analyze( @@ -207,7 +207,7 @@ test_that("a_summarize_aval_chg_diff_j works with ancova = TRUE", { CHG = c(2, 3, -1, 9, -2, 0, 6, -2, 5, 2) ) - ADEG <- ADEG %>% + ADEG <- ADEG |> mutate( TRT01A = as.factor(TRT01A), STUDYID = as.factor(STUDYID) @@ -230,40 +230,40 @@ test_that("a_summarize_aval_chg_diff_j works with ancova = TRUE", { ) ref_path <- c("colspan_trt", " ", "TRT01A", "Placebo") - lyt <- basic_table() %>% + lyt <- basic_table(round_type = "sas") |> ### first columns split_cols_by( "colspan_trt", split_fun = trim_levels_to_map(map = colspan_trt_map) - ) %>% - split_cols_by("TRT01A") %>% + ) |> + split_cols_by("TRT01A") |> split_rows_by( "PARAM", label_pos = "topleft", split_label = "Blood Pressure", section_div = " ", split_fun = drop_split_levels - ) %>% + ) |> split_rows_by( "AVISIT", label_pos = "topleft", split_label = "Study Visit", split_fun = drop_split_levels, child_labels = "hidden" - ) %>% + ) |> ## set up a 3 column split split_cols_by_multivar( c("AVAL", "AVAL", "CHG"), varlabels = c("n/N (%)", "Mean (CI)", "CFB (CI)") - ) %>% - split_cols_by("rrisk_header", nested = FALSE) %>% + ) |> + split_cols_by("rrisk_header", nested = FALSE) |> split_cols_by( "TRT01A", split_fun = remove_split_levels("Placebo"), labels_var = "rrisk_label" - ) %>% + ) |> ### difference columns : just 1 column & analysis needs to be done on change - split_cols_by_multivar(c("CHG"), varlabels = c(" ")) %>% + split_cols_by_multivar(c("CHG"), varlabels = c(" ")) |> ### the variable passed here in analyze is not used (STUDYID), it is a dummy var passing, ### the function a_summarize_aval_chg_diff_j grabs the required vars from cols_by_multivar calls analyze( diff --git a/tests/testthat/test-analyze_values.R b/tests/testthat/test-analyze_values.R index d6232cab..57012b63 100644 --- a/tests/testthat/test-analyze_values.R +++ b/tests/testthat/test-analyze_values.R @@ -2,7 +2,7 @@ library(rtables) test_that("analyze_values correctly modifies layout with proper formats", { # Create a simple layout - lyt <- basic_table() %>% + lyt <- basic_table(round_type = "sas") |> split_cols_by("ARM") # Define variables to analyze diff --git a/tests/testthat/test-blank_line.R b/tests/testthat/test-blank_line.R index ff79bb15..cfa64847 100644 --- a/tests/testthat/test-blank_line.R +++ b/tests/testthat/test-blank_line.R @@ -1,7 +1,7 @@ test_that("insert_blank_line works as expected", { ADSL <- ex_adsl - lyt <- basic_table() |> + lyt <- basic_table(round_type = "sas") |> split_cols_by("ARM") |> split_rows_by("STRATA1") |> analyze(vars = "AGE", afun = function(x) { @@ -34,7 +34,7 @@ test_that("insert_blank_line works as expected", { test_that("insert_blank_line optionally uses custom table names", { ADSL <- ex_adsl - lyt <- basic_table() |> + lyt <- basic_table(round_type = "sas") |> split_cols_by("ARM") |> split_rows_by("STRATA1") |> analyze(vars = "AGE", afun = function(x) { diff --git a/tests/testthat/test-cmp_functions.R b/tests/testthat/test-cmp_functions.R index d553add9..e7fdd9ec 100644 --- a/tests/testthat/test-cmp_functions.R +++ b/tests/testthat/test-cmp_functions.R @@ -1,5 +1,5 @@ test_that("cmp_split_fun works as expected", { - result <- basic_table() %>% + result <- basic_table(round_type = "sas") |> split_cols_by("ID", split_fun = cmp_split_fun) |> build_table(formatters::DM) expect_snapshot(result) diff --git a/tests/testthat/test-column_stats.R b/tests/testthat/test-column_stats.R index 3a80c6a0..557a59de 100644 --- a/tests/testthat/test-column_stats.R +++ b/tests/testthat/test-column_stats.R @@ -164,7 +164,7 @@ test_that("column_stats handles BASE variable correctly", { expect_equal(week1_base_mean, "20.00") }) -test_that("column_stats handles iec roundmethod correctly", { +test_that("column_stats handles iec round_type correctly", { # Create sample data df <- data.frame( AVISIT = c("Baseline (DB)", "Week 1", "Week 1", "Week 2", "Week 2"), @@ -180,7 +180,7 @@ test_that("column_stats handles iec roundmethod correctly", { statnm, visit, varnm, - roundmethod = "iec", + round_type = "iec", exclude_visits = "Baseline (DB)" ) } @@ -243,11 +243,23 @@ test_that("column_stats handles iec roundmethod correctly", { "Mean", "Week 1", "AVAL", - roundmethod = "sas", + round_type = "sas", exclude_visits = "Baseline (DB)" ) expect_equal(result_SAS, "25.35") + # Compare to SAS rounding + result_R_mod <- calc_one_visit( + df$AVAL[df$AVISIT == "Week 1"], + 1, + "Mean", + "Week 1", + "AVAL", + round_type = "iec_mod", + exclude_visits = "Baseline (DB)" + ) + expect_equal(result_R_mod, "25.34") + df <- data.frame( AVISIT = c( diff --git a/tests/testthat/test-colwidths.R b/tests/testthat/test-colwidths.R index f3e98c7f..e08f9354 100644 --- a/tests/testthat/test-colwidths.R +++ b/tests/testthat/test-colwidths.R @@ -15,7 +15,7 @@ ADSL <- data.frame( PKFL = c("N", "N", "N", "N", "N", "N", "N", "N", "N", "N") ) -lyt <- basic_table() |> +lyt <- basic_table(round_type = "sas") |> split_cols_by("TRT01P") |> add_overall_col("Total") |> analyze("FASFL", @@ -40,7 +40,7 @@ lyt <- basic_table() |> tt <- build_table(lyt, ADSL) test_that("ttype_wrap_vec works as expected", { - result <- ttype_wrap_vec(vec = c(1, 2, 3, 4) %>% as.character(), fontspec = fontspec, width = 2) + result <- ttype_wrap_vec(vec = c(1, 2, 3, 4) |> as.character(), fontspec = fontspec, width = 2) # TODO: how do I guess expected_result expected_result <- list( c("1"), @@ -70,7 +70,7 @@ test_that("def_colwidths works as expected", { ARM = "Description\nOf\nPlanned Arm" ) # nolint start - suppressMessages(tt2 <- as_listing(anl, key_cols = c("USUBJID")) %>% + suppressMessages(tt2 <- as_listing(anl, key_cols = c("USUBJID")) |> add_listing_col("ARM")) # nolint end @@ -88,7 +88,7 @@ test_that("listing_column_widths works as expected", { ARM = "Description\nOf\nPlanned Arm" ) # nolint start - suppressMessages(tt3 <- as_listing(anl, key_cols = c("USUBJID")) %>% + suppressMessages(tt3 <- as_listing(anl, key_cols = c("USUBJID")) |> add_listing_col("ARM")) # nolint end mpf <- rlistings::matrix_form(tt3) @@ -106,7 +106,7 @@ test_that("find_free_colspc works as expected", { ARM = "Description\nOf\nPlanned Arm" ) # nolint start - suppressMessages(tt4 <- as_listing(anl, key_cols = c("USUBJID")) %>% + suppressMessages(tt4 <- as_listing(anl, key_cols = c("USUBJID")) |> add_listing_col("ARM")) # nolint end mpf <- rlistings::matrix_form(tt4) diff --git a/tests/testthat/test-count_pct.R b/tests/testthat/test-count_pct.R index 4e316b38..975e20d3 100644 --- a/tests/testthat/test-count_pct.R +++ b/tests/testthat/test-count_pct.R @@ -12,8 +12,8 @@ test_that("a_freq_j with val = NA and denom option", { extra_args_1 <- list( .stats = c("count_unique_denom_fraction") ) - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt1 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -33,8 +33,8 @@ test_that("a_freq_j with val = NA and denom option", { denom = "N_col", .stats = c("count_unique_denom_fraction") ) - lyt1c <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt1c <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -51,8 +51,8 @@ test_that("a_freq_j with specific val (CHN) and denom option", { .stats = c("count_unique_denom_fraction"), val = "CHN" ) - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt1 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -73,8 +73,8 @@ test_that("a_freq_j with specific val (CHN) and denom option", { .stats = c("count_unique_denom_fraction"), val = "CHN" ) - lyt1c <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt1c <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -91,8 +91,8 @@ test_that("a_freq_j with N_only", { extra_args_1 <- list( .stats = c("count_unique") ) - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt1 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -115,9 +115,9 @@ test_that("a_freq_j with TotCol_only", { .stats = c("count_unique"), restr_columns = "Total" ) - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - add_overall_col("Total") %>% + lyt1 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> + add_overall_col("Total") |> analyze(vars = "COUNTRY", afun = a_freq_j, extra_args = extra_args_1) # apply to adsl @@ -135,21 +135,21 @@ test_that("a_freq_j as cfun", { Ncol <- length(unique(adsl_col[["USUBJID"]])) adae_col <- adae[adae$ARM == "A: Drug X", ] - adae_col_bs <- unique(adae_col %>% select(USUBJID, AEBODSYS)) + adae_col_bs <- unique(adae_col |> select(USUBJID, AEBODSYS)) # scenario 1 : extra_args_1 <- list( denom = "N_col", .stats = c("count_unique_denom_fraction") ) - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by("AEBODSYS") %>% + lyt1 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> + split_rows_by("AEBODSYS") |> summarize_row_groups( "AEBODSYS", cfun = a_freq_j, extra_args = extra_args_1 - ) %>% + ) |> analyze( vars = "AEDECOD", afun = a_freq_j, @@ -163,14 +163,14 @@ test_that("a_freq_j as cfun", { # scenario 2 : label using label_fstr method works extra_args_2 <- append(extra_args_1, list(label_fstr = "Bodysystem %s")) - lyt2 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by("AEBODSYS") %>% + lyt2 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> + split_rows_by("AEBODSYS") |> summarize_row_groups( "AEBODSYS", cfun = a_freq_j, extra_args = extra_args_2 - ) %>% + ) |> analyze( vars = "AEDECOD", afun = a_freq_j, @@ -187,7 +187,7 @@ test_that("a_freq_j with label map", { Ncol <- length(unique(adsl_col[["USUBJID"]])) adae_col <- adae[adae$ARM == "A: Drug X", ] - adae_col_sub <- unique(adae_col %>% select(USUBJID)) + adae_col_sub <- unique(adae_col |> select(USUBJID)) Subjs_with_AEs <- tibble::tribble( ~value, @@ -198,8 +198,8 @@ test_that("a_freq_j with label map", { # scenario 1 : with label_map extra_args_1 <- list(label_map = Subjs_with_AEs) - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt1 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "TRTEMFL", afun = a_freq_j, @@ -212,8 +212,8 @@ test_that("a_freq_j with label map", { # scenario 2 : set row label using label parameter extra_args_2 <- list(label = "Subjects with >= 1 AE") - lyt2 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt2 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "TRTEMFL", afun = a_freq_j, @@ -230,8 +230,8 @@ test_that("a_freq_j (old count_pats case)", { extra_args_1 <- list( .stats = c("count_unique_denom_fraction") ) - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt1 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -251,8 +251,8 @@ test_that("a_freq_j (old count_pats case)", { denom = "N_col", .stats = c("count_unique_denom_fraction") ) - lyt1c <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt1c <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -268,9 +268,9 @@ test_that("a_freq_j with N_subgroup as denom", { # scenario 1: denom = N_subgroup, all values extra_args_1 <- list(denom = "n_df") - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% + lyt1 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -294,9 +294,9 @@ test_that("a_freq_j with N_subgroup as denom", { .stats = c("count_unique_denom_fraction") ) - lyt1c <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% + lyt1c <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -316,14 +316,14 @@ test_that("a_freq_j with N_trt as denom - special situation", { ### spanning header for severity - adsl_ <- ex_adsl %>% select(USUBJID, ARM) - adae_ <- ex_adae %>% select(USUBJID, ARM, AEBODSYS, AEDECOD, AESEV) + adsl_ <- ex_adsl |> select(USUBJID, ARM) + adae_ <- ex_adae |> select(USUBJID, ARM, AEBODSYS, AEDECOD, AESEV) adae_$TRTEMFL <- "Y" trtvar <- "ARM" ## Total column on adsl - adsl_ <- adsl_ %>% + adsl_ <- adsl_ |> mutate(ASEV = factor("Total", levels = c("Total", levels(adae$AESEV)))) adsl_$spanheader <- factor( ifelse(adsl_$ASEV == "Total", " ", "Severity"), @@ -331,34 +331,34 @@ test_that("a_freq_j with N_trt as denom - special situation", { ) ## ae : max severity per subject per SOC - adaetot <- adae_ %>% + adaetot <- adae_ |> mutate( AESEV = "Total", AEBODSYSx = AEBODSYS - ) %>% - arrange(USUBJID, AEBODSYS, AEDECOD) %>% - group_by(USUBJID, AEBODSYS, AEDECOD) %>% - slice(1) %>% + ) |> + arrange(USUBJID, AEBODSYS, AEDECOD) |> + group_by(USUBJID, AEBODSYS, AEDECOD) |> + slice(1) |> ungroup() # Take maximum severity - per PT - adaemaxpt <- adae_ %>% - filter(toupper(AESEV) %in% toupper(c("Mild", "Moderate", "Severe"))) %>% + adaemaxpt <- adae_ |> + filter(toupper(AESEV) %in% toupper(c("Mild", "Moderate", "Severe"))) |> mutate( AESEVN = case_when( toupper(AESEV) == "MILD" ~ 3, toupper(AESEV) == "MODERATE" ~ 2, toupper(AESEV) == "SEVERE" ~ 1 ) - ) %>% - arrange(USUBJID, AEBODSYS, AEDECOD, AESEVN) %>% - group_by(USUBJID, AEBODSYS, AEDECOD) %>% - slice(1) %>% + ) |> + arrange(USUBJID, AEBODSYS, AEDECOD, AESEVN) |> + group_by(USUBJID, AEBODSYS, AEDECOD) |> + slice(1) |> ungroup() # Take maximum severity - per SOC - adaemaxsoc <- adae_ %>% - filter(toupper(AESEV) %in% toupper(c("Mild", "Moderate", "Severe"))) %>% + adaemaxsoc <- adae_ |> + filter(toupper(AESEV) %in% toupper(c("Mild", "Moderate", "Severe"))) |> mutate( AESEVN = case_when( toupper(AESEV) == "MILD" ~ 3, @@ -366,11 +366,11 @@ test_that("a_freq_j with N_trt as denom - special situation", { toupper(AESEV) == "SEVERE" ~ 1 ), AEBODSYSx = AEBODSYS - ) %>% - arrange(USUBJID, AEBODSYS, AESEVN) %>% - group_by(USUBJID, AEBODSYS) %>% - slice(1) %>% - ungroup() %>% + ) |> + arrange(USUBJID, AEBODSYS, AESEVN) |> + group_by(USUBJID, AEBODSYS) |> + slice(1) |> + ungroup() |> select(USUBJID, AEBODSYS, AESEV, AEBODSYSx) # Merge back in an create a new SOC variable that is only populated @@ -382,28 +382,28 @@ test_that("a_freq_j with N_trt as denom - special situation", { ) # Add total - adaetot <- adae_ %>% + adaetot <- adae_ |> mutate( AESEV = "Total", AEBODSYSx = AEBODSYS - ) %>% - arrange(USUBJID, AEBODSYS, AEDECOD) %>% - group_by(USUBJID, AEBODSYS, AEDECOD) %>% - slice(1) %>% + ) |> + arrange(USUBJID, AEBODSYS, AEDECOD) |> + group_by(USUBJID, AEBODSYS, AEDECOD) |> + slice(1) |> ungroup() # Set data together - adaeall <- bind_rows(adaemax, adaetot) %>% + adaeall <- bind_rows(adaemax, adaetot) |> mutate( ASEV = factor( as.character(AESEV), levels = c("Total", levels(ex_adae$AESEV)) ) - ) %>% + ) |> select(USUBJID, TRTEMFL, ASEV, AEBODSYS, AEBODSYSx, AEDECOD) - adaeall <- adaeall %>% - inner_join(., adsl_ %>% select(USUBJID, ARM), by = c("USUBJID")) + adaeall <- adaeall |> + inner_join(adsl_ |> select(USUBJID, ARM), by = c("USUBJID"), relationship = "many-to-many") adaeall$spanheader <- factor( ifelse(adaeall$ASEV == "Total", " ", "Severity"), @@ -417,17 +417,17 @@ test_that("a_freq_j with N_trt as denom - special situation", { colgroup = "ARM", riskdiff = FALSE ) - lyt <- basic_table() %>% - split_cols_by(trtvar, show_colcounts = TRUE) %>% - split_cols_by("spanheader", split_fun = trim_levels_in_group("ASEV")) %>% - split_cols_by("ASEV", show_colcounts = TRUE) %>% + lyt <- basic_table(round_type = "sas") |> + split_cols_by(trtvar, show_colcounts = TRUE) |> + split_cols_by("spanheader", split_fun = trim_levels_in_group("ASEV")) |> + split_cols_by("ASEV", show_colcounts = TRUE) |> split_rows_by( "AEBODSYS", split_label = "System Organ Class", split_fun = trim_levels_in_group("AEDECOD"), label_pos = "topleft", section_div = c(" ") - ) %>% + ) |> summarize_row_groups( "AEBODSYSx", cfun = a_freq_j, @@ -456,8 +456,8 @@ test_that("a_freq_j with keep_levels (CHN, NGA) ", { denom = "N_col", val = c("CHN", "NGA") ) - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt1 <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze(vars = "COUNTRY", afun = a_freq_j, extra_args = extra_args_1) # apply to adsl diff --git a/tests/testthat/test-count_pct_relrisk.R b/tests/testthat/test-count_pct_relrisk.R index b3d51f41..47a8d9a6 100644 --- a/tests/testthat/test-count_pct_relrisk.R +++ b/tests/testthat/test-count_pct_relrisk.R @@ -2,8 +2,8 @@ library(rtables) library(dplyr) suppressPackageStartupMessages(library(tern)) -adsl <- ex_adsl %>% select(USUBJID, ARM, COUNTRY, STRATA1, SEX) -adae <- ex_adae %>% select(USUBJID, AEDECOD, AEBODSYS, ARM) +adsl <- ex_adsl |> select(USUBJID, ARM, COUNTRY, STRATA1, SEX) +adae <- ex_adae |> select(USUBJID, AEDECOD, AEBODSYS, ARM) adae$TRTEMFL <- "Y" trtvar <- "ARM" @@ -21,10 +21,10 @@ adsl$rrisk_label <- paste(adsl[["ARM"]], "vs Placebo") adae <- left_join(adae, adsl, by = join_by(USUBJID, ARM)) -core_lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) %>% - split_cols_by("ARM") %>% - split_cols_by("rrisk_header", nested = FALSE) %>% +core_lyt <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_cols_by("rrisk_header", nested = FALSE) |> split_cols_by( "ARM", labels_var = "rrisk_label", @@ -57,10 +57,11 @@ wald_diff <- function(inputs) { } count_unique_subjects <- function( - df, - id = "USUBJID", - sub_set = NULL, - var = NULL) { + df, + id = "USUBJID", + sub_set = NULL, + var = NULL +) { if (!is.null(sub_set)) { df <- subset(df, sub_set) } @@ -95,7 +96,7 @@ test_that("a_freq_j with val = NA and denom option", { method = "wald" ) - lyt1 <- core_lyt %>% + lyt1 <- core_lyt |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -106,7 +107,7 @@ test_that("a_freq_j with val = NA and denom option", { tbl1 <- build_table(lyt1, adsl) res1 <- cell_values(tbl1["CHN", "A: Drug X"]) res1_val <- unlist(unname(res1[[DrugX_column_val]])) - res1_rr <- res1[[DrugX_column_rr]] %>% as.numeric() + res1_rr <- res1[[DrugX_column_rr]] |> as.numeric() Ncol <- count_unique_subjects(adsl_col) N <- count_unique_subjects(adsl_col) @@ -147,7 +148,7 @@ test_that("a_freq_j with val = NA and denom option", { method = "wald" ) - lyt1b <- core_lyt %>% + lyt1b <- core_lyt |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -156,7 +157,7 @@ test_that("a_freq_j with val = NA and denom option", { tbl1b <- build_table(lyt1b, adae, adsl) res1b <- cell_values(tbl1b["CHN", "A: Drug X"]) res1b_val <- unlist(unname(res1b[[DrugX_column_val]])) - res1b_rr <- res1b[[DrugX_column_rr]] %>% as.numeric() + res1b_rr <- res1b[[DrugX_column_rr]] |> as.numeric() ### comparison of main columns (similar to tests in test-count_pct.R ) Ncol <- count_unique_subjects(adsl_col) @@ -196,7 +197,7 @@ test_that("a_freq_j with val = NA and denom option", { method = "wald" ) - lyt1c <- core_lyt %>% + lyt1c <- core_lyt |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -206,7 +207,7 @@ test_that("a_freq_j with val = NA and denom option", { res1c <- cell_values(tbl1c["CHN", "A: Drug X"]) res1c_val <- unlist(unname(res1c[[DrugX_column_val]])) - res1c_rr <- res1c[[DrugX_column_rr]] %>% as.numeric() + res1c_rr <- res1c[[DrugX_column_rr]] |> as.numeric() ### comparison of main columns (similar to tests in test-count_pct.R ) Ncol <- count_unique_subjects(adsl_col) @@ -237,10 +238,6 @@ test_that("a_freq_j with val = NA and denom option", { }) - - - - test_that("a_freq_j with risk difference method cmh", { adsl_col <- adsl[adsl$ARM == "A: Drug X", ] adae_col <- adae[adae$ARM == "A: Drug X", ] @@ -264,7 +261,7 @@ test_that("a_freq_j with risk difference method cmh", { ref_path = ref_path, variables = list(strata = "STRATA1") ) - lyt1d <- core_lyt %>% + lyt1d <- core_lyt |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -275,7 +272,7 @@ test_that("a_freq_j with risk difference method cmh", { res1d <- cell_values(tbl1d["CHN", "A: Drug X"]) res1d_val <- unlist(unname(res1d[[DrugX_column_val]])) - res1d_rr <- res1d[[DrugX_column_rr]] %>% as.numeric() + res1d_rr <- res1d[[DrugX_column_rr]] |> as.numeric() ### comparison of main columns (similar to tests in test-count_pct.R ) Ncol <- count_unique_subjects(adsl_col) @@ -300,9 +297,9 @@ test_that("a_freq_j with risk difference method cmh", { N_PBO <- count_unique_subjects(adae_colPBO_x) ### construct input vectors to utilize tern::prop_diff_cmh - adae_col_chn <- adae %>% + adae_col_chn <- adae |> filter(ARM == "A: Drug X" & COUNTRY == "CHN") - adae_colPBO_chn <- adae %>% + adae_colPBO_chn <- adae |> filter(ARM == ctrl_grp & COUNTRY == "CHN") subj_col <- adsl_col[["USUBJID"]] @@ -364,8 +361,8 @@ test_that("a_freq_j with N_subgroup as denom", { ctrl_grp = ctrl_grp, ref_path = ref_path ) - lyt1 <- core_lyt %>% - split_rows_by("SEX") %>% + lyt1 <- core_lyt |> + split_rows_by("SEX") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -386,7 +383,7 @@ test_that("a_freq_j with N_subgroup as denom", { ] ) res1_val <- unlist(unname(res1[[DrugX_column_val]])) - res1_rr <- res1[[DrugX_column_rr]] %>% as.numeric() + res1_rr <- res1[[DrugX_column_rr]] |> as.numeric() Ncol <- length(unique(adsl_col[["USUBJID"]])) Nsubgroup <- length(unique(adsl_col_subgroup[["USUBJID"]])) @@ -434,7 +431,7 @@ test_that("a_freq_j with N_subgroup as denom", { ] ) res1b_val <- unlist(unname(res1b[[DrugX_column_val]])) - res1b_rr <- res1b[[DrugX_column_rr]] %>% as.numeric() + res1b_rr <- res1b[[DrugX_column_rr]] |> as.numeric() Ncol <- length(unique(adsl_col[["USUBJID"]])) Nsubgroup <- length(unique(adsl_col_subgroup[["USUBJID"]])) @@ -482,8 +479,8 @@ test_that("a_freq_j with N_subgroup as denom", { ref_path = ref_path ) - lyt1c <- core_lyt %>% - split_rows_by("SEX") %>% + lyt1c <- core_lyt |> + split_rows_by("SEX") |> analyze( vars = "COUNTRY", afun = a_freq_j, @@ -503,7 +500,7 @@ test_that("a_freq_j with N_subgroup as denom", { ] ) res1c_val <- unlist(unname(res1c[[DrugX_column_val]])) - res1c_rr <- res1c[[DrugX_column_rr]] %>% as.numeric() + res1c_rr <- res1c[[DrugX_column_rr]] |> as.numeric() Ncol <- length(unique(adsl_col[["USUBJID"]])) Nsubgroup <- length(unique(adsl_col_subgroup[["USUBJID"]])) diff --git a/tests/testthat/test-coxph_hr.R b/tests/testthat/test-coxph_hr.R index 51399010..3c071250 100644 --- a/tests/testthat/test-coxph_hr.R +++ b/tests/testthat/test-coxph_hr.R @@ -3,11 +3,11 @@ library(survival) test_that("s_coxph_hr works with default arguments and no stratification factors", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate(is_event = CNSR == 0) - df <- adtte_f %>% dplyr::filter(ARMCD == "ARM A") - df_ref <- adtte_f %>% dplyr::filter(ARMCD == "ARM B") + df <- adtte_f |> dplyr::filter(ARMCD == "ARM A") + df_ref <- adtte_f |> dplyr::filter(ARMCD == "ARM B") result <- s_coxph_hr( df = df, @@ -46,12 +46,12 @@ test_that("s_coxph_hr works with default arguments and no stratification factors }) test_that("a_coxph_hr works with custom arguments and stratification factors", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate(is_event = CNSR == 0) - result <- basic_table() %>% - split_cols_by(var = "ARMCD") %>% + result <- basic_table(round_type = "sas") |> + split_cols_by(var = "ARMCD") |> analyze( vars = "AVAL", afun = a_coxph_hr, @@ -69,7 +69,7 @@ test_that("a_coxph_hr works with custom arguments and stratification factors", { ref_path = c("ARMCD", "ARM A"), .stats = c("hr_ci_3d", "pvalue") ) - ) %>% + ) |> build_table(df = adtte_f) res <- expect_silent(result) @@ -77,12 +77,12 @@ test_that("a_coxph_hr works with custom arguments and stratification factors", { }) test_that("a_coxph_hr works with stratification factors for Log-Rank test", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate(is_event = CNSR == 0) - result <- basic_table() %>% - split_cols_by(var = "ARMCD") %>% + result <- basic_table(round_type = "sas") |> + split_cols_by(var = "ARMCD") |> analyze( vars = "AVAL", afun = a_coxph_hr, @@ -100,7 +100,7 @@ test_that("a_coxph_hr works with stratification factors for Log-Rank test", { ref_path = c("ARMCD", "ARM A"), .stats = c("hr_ci_3d", "pvalue") ) - ) %>% + ) |> build_table(df = adtte_f) res <- expect_silent(result) diff --git a/tests/testthat/test-coxreg_multivar.R b/tests/testthat/test-coxreg_multivar.R index 2def990d..7958e1c7 100644 --- a/tests/testthat/test-coxreg_multivar.R +++ b/tests/testthat/test-coxreg_multivar.R @@ -27,7 +27,7 @@ test_that("h_extract_coxreg_multivar works as expected", { }) test_that("tefos03_first_split_fun works as expected", { - lyt <- basic_table() %>% + lyt <- basic_table() |> split_cols_by("ID", split_fun = tefos03_first_split_fun) result <- expect_silent(build_table(lyt, DM)) expect_snapshot(col_info(result)) @@ -36,7 +36,7 @@ test_that("tefos03_first_split_fun works as expected", { test_that("tefos03_second_split_fun_fct works as expected", { split_fun <- tefos03_second_split_fun_fct(conf_level = 0.92) - lyt <- basic_table() %>% + lyt <- basic_table() |> split_cols_by("ID", split_fun = tefos03_first_split_fun) |> split_cols_by("ID", split_fun = split_fun) result <- expect_silent(build_table(lyt, DM)) @@ -100,7 +100,7 @@ test_that("summarize_coxreg_multivar works as expected with custom options", { arm = "ARM", covariates = c("SEX", "AGE") ) - lyt <- basic_table() |> + lyt <- basic_table(round_type = "sas") |> summarize_coxreg_multivar( var = "STUDYID", variables = variables, @@ -110,7 +110,7 @@ test_that("summarize_coxreg_multivar works as expected with custom options", { ties = "breslow" ), formats = list( - coef_se = jjcsformat_xx("xx. (xx.)"), + coef_se = jjcsformat_xx("xx.x (xx.x)"), hr_est = jjcsformat_xx("xx.xxxx"), hr_ci = jjcsformat_xx("(xx.x, xx.x)"), pval = jjcsformat_pval_fct(0.1) diff --git a/tests/testthat/test-event_free.R b/tests/testthat/test-event_free.R index cbc36fc0..aa3fd105 100644 --- a/tests/testthat/test-event_free.R +++ b/tests/testthat/test-event_free.R @@ -1,6 +1,6 @@ test_that("s_event_free works with default arguments", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 @@ -19,8 +19,8 @@ test_that("s_event_free works with default arguments", { }) test_that("s_event_free works with percent format", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 @@ -40,14 +40,14 @@ test_that("s_event_free works with percent format", { }) test_that("a_event_free works with default arguments in a table layout", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 ) - lyt <- basic_table() %>% + lyt <- basic_table(round_type = "sas") |> split_cols_by(var = "ARMCD") for (time_point in c(3, 4, 5)) { lyt <- lyt |> @@ -72,14 +72,14 @@ test_that("a_event_free works with default arguments in a table layout", { }) test_that("a_event_free works with customized arguments in a table layout", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 ) - lyt <- basic_table() %>% + lyt <- basic_table(round_type = "sas") |> split_cols_by(var = "ARMCD") for (time_point in c(5, 1, 7)) { lyt <- lyt |> diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index 05cb494e..a53cee44 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -47,7 +47,7 @@ test_that("get_ref_info works with a df analysis function", { # Define the global reference group. ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") - lyt <- basic_table() |> + lyt <- basic_table(round_type = "sas") |> split_cols_by( "colspan_trt", split_fun = trim_levels_to_map(map = colspan_trt_map) @@ -62,7 +62,7 @@ test_that("get_ref_info works with a df analysis function", { expect_snapshot(result) # Compare with non-hierarchical layout. - std_lyt <- basic_table() |> + std_lyt <- basic_table(round_type = "sas") |> split_cols_by("ARM", ref_group = "B: Placebo") |> analyze( "AGE", @@ -109,7 +109,7 @@ test_that("get_ref_info works with a vector analysis function", { # Define the global reference group. ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") - lyt <- basic_table() |> + lyt <- basic_table(round_type = "sas") |> split_cols_by( "colspan_trt", split_fun = trim_levels_to_map(map = colspan_trt_map) @@ -124,7 +124,7 @@ test_that("get_ref_info works with a vector analysis function", { expect_snapshot(result) # Compare with non-hierarchical layout. - std_lyt <- basic_table() |> + std_lyt <- basic_table(round_type = "sas") |> split_cols_by("ARM", ref_group = "B: Placebo") |> analyze( c("AGE", "BMRKR1"), diff --git a/tests/testthat/test-jjcs_num_formats.R b/tests/testthat/test-jjcs_num_formats.R index d68273cd..0f7213a8 100644 --- a/tests/testthat/test-jjcs_num_formats.R +++ b/tests/testthat/test-jjcs_num_formats.R @@ -29,90 +29,94 @@ test_that("jjcs_num_formats works", { # jjcsformat_xx_SAS/R format tests expect_snapshot({ - format_value(values, format = jjcsformat_xx_SAS("xx.x (xx.xx)")) - format_value(values, format = jjcsformat_xx_R("xx.x (xx.xx)")) - format_value(c(5.05, values[2]), format = jjcsformat_xx_SAS("xx.x (xx.xx)")) - format_value(c(5.05, values[2]), format = jjcsformat_xx_R("xx.x (xx.xx)")) - format_value(c(5.15, values[2]), format = jjcsformat_xx_R("xx.x (xx.xx)")) + format_value(values, format = jjcsformat_xx("xx.x (xx.xx)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.x (xx.xx)"), round_type = "iec") + format_value(c(5.05, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), round_type = "sas") + format_value(c(5.05, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), round_type = "iec") + format_value(c(5.15, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), round_type = "iec") format_value(c(5.15, values[2]), format = "xx.x (xx.x)") - format_value(c(4.15, values[2]), format = jjcsformat_xx_SAS("xx.x (xx.xx)")) - format_value(c(4.15, values[2]), format = jjcsformat_xx_R("xx.x (xx.xx)")) + format_value(c(4.15, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), round_type = "sas") + format_value(c(4.15, values[2]), format = jjcsformat_xx("xx.x (xx.xx)"), round_type = "iec") format_value(c(4.15, values[2]), format = "xx.x (xx.x)") - format_value(c(4.15, values[2]), format = jjcsformat_xx_SAS("xx.x (xx.x)")) + format_value(c(4.15, values[2]), format = jjcsformat_xx("xx.x (xx.x)"), round_type = "sas") format_value(c(3.15, values[2]), format = "xx.x (xx.x)") - format_value(c(3.15, values[2]), format = jjcsformat_xx_SAS("xx.x (xx.x)")) - format_value(c(3.15, values[2]), format = jjcsformat_xx_R("xx.x (xx.x)")) + format_value(c(3.15, values[2]), format = jjcsformat_xx("xx.x (xx.x)"), round_type = "sas") + format_value(c(3.15, values[2]), format = jjcsformat_xx("xx.x (xx.x)"), round_type = "iec") }) # jjcsformat_xx_SAS format tests expect_snapshot({ - format_value(values, format = jjcsformat_xx_SAS("xx / xx")) - format_value(values, format = jjcsformat_xx_SAS("xx. / xx.")) - format_value(values, format = jjcsformat_xx_SAS("xx.x / xx.x")) - format_value(values, format = jjcsformat_xx_SAS("xx.xx / xx.xx")) - format_value(values, format = jjcsformat_xx_SAS("xx.xxx / xx.xxx")) - format_value(values, format = jjcsformat_xx_SAS("(xx, xx)")) - format_value(values, format = jjcsformat_xx_SAS("(xx., xx.)")) - format_value(values, format = jjcsformat_xx_SAS("(xx.x, xx.x)")) - format_value(values, format = jjcsformat_xx_SAS("(xx.xx, xx.xx)")) - format_value(values, format = jjcsformat_xx_SAS("(xx.xxx, xx.xxx)")) - format_value(values, format = jjcsformat_xx_SAS("(xx.xxxx, xx.xxxx)")) - format_value(values, format = jjcsformat_xx_SAS("xx - xx")) - format_value(values, format = jjcsformat_xx_SAS("xx.x - xx.x")) - format_value(values, format = jjcsformat_xx_SAS("xx.xx - xx.xx")) - format_value(values, format = jjcsformat_xx_SAS("xx (xx)")) - format_value(values, format = jjcsformat_xx_SAS("xx (xx.)")) - format_value(values, format = jjcsformat_xx_SAS("xx (xx.x)")) - format_value(values, format = jjcsformat_xx_SAS("xx (xx.xx)")) - format_value(values, format = jjcsformat_xx_SAS("xx. (xx.)")) - format_value(values, format = jjcsformat_xx_SAS("xx.x (xx.x)")) - format_value(values, format = jjcsformat_xx_SAS("xx.xx (xx.xx)")) - format_value(values, format = jjcsformat_xx_SAS("xx.x, xx.x")) - format_value(values, format = jjcsformat_xx_SAS("xx.x to xx.x")) + format_value(values, format = jjcsformat_xx("xx / xx"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx. / xx."), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.x / xx.x"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.xx / xx.xx"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.xxx / xx.xxx"), round_type = "sas") + format_value(values, format = jjcsformat_xx("(xx, xx)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("(xx., xx.)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("(xx.x, xx.x)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("(xx.xx, xx.xx)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("(xx.xxx, xx.xxx)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("(xx.xxxx, xx.xxxx)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx - xx"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.x - xx.x"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.xx - xx.xx"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx (xx)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx (xx.)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx (xx.x)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx (xx.xx)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx. (xx.)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.x (xx.x)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.xx (xx.xx)"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.x, xx.x"), round_type = "sas") + format_value(values, format = jjcsformat_xx("xx.x to xx.x"), round_type = "sas") format_value( c(values, 10.1235), - format = jjcsformat_xx_SAS("xx. (xx. - xx.)") + format = jjcsformat_xx("xx. (xx. - xx.)"), + round_type = "sas" ) format_value( c(values, 10.1235), - format = jjcsformat_xx_SAS("xx.x (xx.x - xx.x)") + format = jjcsformat_xx("xx.x (xx.x - xx.x)"), + round_type = "sas" ) format_value( c(values, 10.1235), - format = jjcsformat_xx_SAS("xx.xx (xx.xx - xx.xx)") + format = jjcsformat_xx("xx.xx (xx.xx - xx.xx)"), + round_type = "sas" ) format_value( c(values, 10.1235), - format = jjcsformat_xx_SAS("xx.xxx (xx.xxx - xx.xxx)") + format = jjcsformat_xx("xx.xxx (xx.xxx - xx.xxx)"), + round_type = "sas" ) - format_value(NULL, jjcsformat_xx_SAS("xx")) - format_value(c(500), jjcsformat_xx_SAS("N=xx")) - format_value(c(500), jjcsformat_xx_SAS("(N=xx)")) + format_value(NULL, jjcsformat_xx("xx"), round_type = "sas") + format_value(c(500), jjcsformat_xx("N=xx"), round_type = "sas") + format_value(c(500), jjcsformat_xx("(N=xx)"), round_type = "sas") }) ## errors expect_error( - format_value(5.1, jjcsformat_xx_SAS("abcd")), + format_value(5.1, jjcsformat_xx("abcd")), "input str must contain xx" ) expect_error( - format_value(5.1, jjcsformat_xx_SAS("xx - xx")), - "jjcs_format_xx must contain same number of xx as the number of stats" + format_value(5.1, jjcsformat_xx("xx + xx")), + "jjcsformat_xx must contain same number of xx as the number of stats" ) expect_error( - format_value(c(5.1, 2, 3), jjcsformat_xx_SAS("xx - xx")), - "jjcs_format_xx must contain same number of xx as the number of stats" + format_value(c(5.1, 2, 3), jjcsformat_xx("xx + xx")), + "jjcsformat_xx must contain same number of xx as the number of stats" ) ## trailing 0s are correct expect_snapshot({ - format_value(0, jjcsformat_xx_SAS("xx.")) - format_value(0, jjcsformat_xx_SAS("xx.x")) - format_value(0, jjcsformat_xx_SAS("xx.xx")) - format_value(0, jjcsformat_xx_SAS("xx.xxx")) - format_value(0, jjcsformat_xx_SAS("xx.xxxx")) + format_value(0, jjcsformat_xx("xx."), round_type = "sas") + format_value(0, jjcsformat_xx("xx.x"), round_type = "sas") + format_value(0, jjcsformat_xx("xx.xx"), round_type = "sas") + format_value(0, jjcsformat_xx("xx.xxx"), round_type = "sas") + format_value(0, jjcsformat_xx("xx.xxxx"), round_type = "sas") }) }) @@ -121,29 +125,32 @@ test_that("jjcsformats NA works", { ## handling NAs expect_snapshot({ - format_value(NA, jjcsformat_xx_SAS("xx."), na_str = "-") - format_value(NA, jjcsformat_xx_SAS("xx"), na_str = "-") + format_value(NA, jjcsformat_xx("xx."), round_type = "sas", na_str = "-") + format_value(NA, jjcsformat_xx("xx"), round_type = "sas", na_str = "-") }) expect_error( - format_value(c(1, NA), jjcsformat_xx_SAS("xx")), - "jjcs_format_xx must contain same number of xx as the number of stats" + format_value(c(1, NA), format = jjcsformat_xx("xx.x (xx.x - xx.x"), round_type = "sas"), + "jjcsformat_xx must contain same number of xx as the number of stats" ) expect_snapshot({ format_value( c(1.2, NA, NA), - jjcsformat_xx_SAS("xx.x (xx.x - xx.x)"), - na_str = "NA" + jjcsformat_xx("xx.x (xx.x - xx.x)"), + round_type = "sas", + na_str = "NE" ) format_value( c(1.2, NA, NA), - jjcsformat_xx_SAS("xx.x (xx.x - xx.x)"), + jjcsformat_xx("xx.x (xx.x - xx.x)"), + round_type = "sas", na_str = "x" ) format_value( c(NA, NA, NA), - jjcsformat_xx_SAS("xx.x (xx.x - xx.x)"), + jjcsformat_xx("xx.x (xx.x - xx.x)"), + round_type = "sas", na_str = "x" ) }) @@ -151,51 +158,59 @@ test_that("jjcsformats NA works", { expect_snapshot({ format_value( c(NA, NA), - format = jjcsformat_xx_SAS("xx.x - xx.x"), + format = jjcsformat_xx("xx.x - xx.x"), + round_type = "sas", na_str = c("hi", "lo") ) format_value( c(NA, 5.2), - format = jjcsformat_xx_SAS("xx.x - xx.x"), + format = jjcsformat_xx("xx.x - xx.x"), + round_type = "sas", na_str = "what" ) format_value( c(NA, 5.2), - format = jjcsformat_xx_SAS("xx.x - xx.x"), + format = jjcsformat_xx("xx.x - xx.x"), + round_type = "sas", na_str = c("hi", "lo") ) format_value( c(NA, NA), - format = jjcsformat_xx_SAS("xx.x - xx.x"), + format = jjcsformat_xx("xx.x - xx.x"), + round_type = "sas", na_str = "what" ) }) expect_snapshot({ - format_value(NA, format = jjcsformat_xx_SAS("xx.x"), na_str = character()) - format_value(NA, format = jjcsformat_xx_SAS("xx.x"), na_str = NA_character_) + format_value(NA, format = jjcsformat_xx("xx.x"), round_type = "sas", na_str = character()) + format_value(NA, format = jjcsformat_xx("xx.x"), round_type = "sas", na_str = NA_character_) }) # 3 d formats expect_snapshot({ format_value( c(6.23, NA, NA), - format = jjcsformat_xx_SAS("xx.x (xx.xx, xx.xx)"), + format = jjcsformat_xx("xx.x (xx.xx, xx.xx)"), + round_type = "sas", na_str = "-" ) format_value( c(NA, NA, NA), - format = jjcsformat_xx_SAS("xx.x (xx.xx, xx.xx)"), + format = jjcsformat_xx("xx.x (xx.xx, xx.xx)"), + round_type = "sas", na_str = "-" ) format_value( c(6.23, NA, NA), - format = jjcsformat_xx_SAS("xx.x (xx.xx, xx.xx)"), + format = jjcsformat_xx("xx.x (xx.xx, xx.xx)"), + round_type = "sas", na_str = c("-", "x", "x") ) format_value( c(6.23, NA, NA), - format = jjcsformat_xx_SAS("xx.x (xx.xx, xx.xx)"), + format = jjcsformat_xx("xx.x (xx.xx, xx.xx)"), + round_type = "sas", na_str = c("-", "x", "y") ) }) @@ -203,33 +218,42 @@ test_that("jjcsformats NA works", { test_that("jjcsformats count_fraction works", { expect_snapshot({ - format_value(cdf, format = jjcsformat_count_denom_fraction) - format_value(cf, format = jjcsformat_count_fraction) - format_value(cf, format = "xx (xx.x%)") + format_value(cdf, format = jjcsformat_count_denom_fraction, round_type = "sas") + format_value(cf, format = jjcsformat_count_fraction, round_type = "sas") + format_value(cf, format = "xx (xx.x%)", round_type = "iec") format_value( c(2000, 2001, 2000 / 2001), - format = jjcsformat_count_denom_fraction + format = jjcsformat_count_denom_fraction, + round_type = "sas" ) - format_value(c(2000, 2000 / 2001), format = "xx (xx.x%)") - format_value(c(1, 2001, 1 / 2001), format = jjcsformat_count_denom_fraction) - format_value(c(1, 1 / 2001), format = "xx (xx.x%)") - format_value(c(3, 3, 3 / 3), format = jjcsformat_count_denom_fraction) - format_value(c(3, 3 / 3), format = "xx (xx.x%)") + format_value(c(2000, 2000 / 2001), format = "xx (xx.x%)", round_type = "iec") + format_value(c(1, 2001, 1 / 2001), format = jjcsformat_count_denom_fraction, round_type = "sas") + format_value(c(1, 1 / 2001), format = "xx (xx.x%)", round_type = "iec") + format_value(c(3, 3, 3 / 3), format = jjcsformat_count_denom_fraction, round_type = "sas") + format_value(c(3, 3 / 3), format = "xx (xx.x%)", round_type = "iec") format_value( rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), - na_str = rep("NA", 10) + round_type = "sas", + na_str = rep("NE", 10) ) format_value( rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), + round_type = "sas", na_str = rep("NA", 1) ) - format_value(rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)")) - format_value(c(1, rep(NA, 2)), format = jjcsformat_xx("xx.x (xx.x, xx.x)")) + format_value(rep(NA, 3), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), round_type = "sas", na_str = "NA") format_value( c(1, rep(NA, 2)), format = jjcsformat_xx("xx.x (xx.x, xx.x)"), + round_type = "sas", + na_str = rep("NE", 10) + ) + format_value( + c(1, rep(NA, 2)), + format = jjcsformat_xx("xx.x (xx.x, xx.x)"), + round_type = "sas", na_str = c("ne1", "ne2", "ne3") ) }) diff --git a/tests/testthat/test-jjcsformats.R b/tests/testthat/test-jjcsformats.R index a4c77138..2095ae46 100644 --- a/tests/testthat/test-jjcsformats.R +++ b/tests/testthat/test-jjcsformats.R @@ -108,27 +108,27 @@ test_that("jjjcs formats work", { ## round type works -test_that("roundmethod support works", { +test_that("round_type support works", { val <- 7.05 ## differs for xx.x between round types expect_equal( - format_value(val, format = jjcsformat_xx("xx.x")), + format_value(val, format = jjcsformat_xx("xx.x"), round_type = "sas"), format_value(val, format = "xx.x", round_type = "sas") ) # nolint start - expect_false(format_value(val, format = jjcsformat_xx("xx.x")) == + expect_false(format_value(val, format = jjcsformat_xx("xx.x"), round_type = "sas") == format_value(val, format = "xx.x", round_type = "iec")) # nolint end val2 <- c(5, 0.9945) expect_equal( format_value(val2, format = "xx (xx.x%)", round_type = "sas"), - jjcsformat_count_fraction(val2, roundmethod = "sas") + jjcsformat_count_fraction(val2, round_type = "sas") ) expect_equal( format_value(val2, format = "xx (xx.x%)", round_type = "iec"), - jjcsformat_count_fraction(val2, roundmethod = "iec") + jjcsformat_count_fraction(val2, round_type = "iec") ) # nolint start - expect_false(jjcsformat_count_fraction(val2, roundmethod = "sas") == + expect_false(jjcsformat_count_fraction(val2, round_type = "sas") == format_value(val2, "xx (xx.x%)", round_type = "iec")) # nolint end val3 <- c(5, 10, 0.9945) @@ -137,28 +137,30 @@ test_that("roundmethod support works", { add_spcs_fmt <- function(str) gsub("/", " / ", str, fixed = TRUE) expect_equal( format_value(val3, format = "xx / xx (xx.x%)", round_type = "sas"), - add_spcs_fmt(jjcsformat_count_denom_fraction(val3, roundmethod = "sas")) + add_spcs_fmt(jjcsformat_count_denom_fraction(val3, round_type = "sas")) ) expect_equal( format_value(val3, format = "xx / xx (xx.x%)", round_type = "iec"), - add_spcs_fmt(jjcsformat_count_denom_fraction(val3, roundmethod = "iec")) + add_spcs_fmt(jjcsformat_count_denom_fraction(val3, round_type = "iec")) ) # nolint start - expect_false(add_spcs_fmt(jjcsformat_count_denom_fraction(val3, roundmethod = "sas")) == + expect_false(add_spcs_fmt(jjcsformat_count_denom_fraction(val3, round_type = "sas")) == format_value(val3, "xx / xx (xx.x%)", round_type = "iec")) - expect_false(jjcsformat_fraction_count_denom(val3, roundmethod = "sas") == - jjcsformat_fraction_count_denom(val3, roundmethod = "iec")) + expect_false(jjcsformat_fraction_count_denom(val3, round_type = "sas") == + jjcsformat_fraction_count_denom(val3, round_type = "iec")) # nolint end }) test_that("jjcsformat_range_fct is formatting ranges as expected", { my_range_format <- jjcsformat_range_fct("xx.xx") + my_range_format2 <- jjcsformat_range_fct("xx.xx", censor_char = "*") expect_snapshot({ my_range_format(c(0.35235, 99.2342, 1, 0)) my_range_format(c(0.35235, 99.2342, 0, 1)) my_range_format(c(0.35235, 99.2342, 0, 0)) my_range_format(c(0.35235, 99.2342, 1, 1)) + my_range_format2(c(0.35235, 99.2342, 0, 1)) }) }) @@ -166,6 +168,7 @@ test_that("jjcsformat_pval_fct works", { expect_snapshot({ jjcsformat_pval_fct(0.005)(0.0048) jjcsformat_pval_fct(0.005)(0.00499) + jjcsformat_pval_fct(0.005)(0.000499) jjcsformat_pval_fct(0)(0.0048) jjcsformat_pval_fct(0.05)(0.0048) jjcsformat_pval_fct(0.005)(0.0051) @@ -175,9 +178,29 @@ test_that("jjcsformat_pval_fct works", { jjcsformat_pval_fct(0)(0.9999) jjcsformat_pval_fct(0)(0.999) jjcsformat_pval_fct(0)(0.9990000001) + jjcsformat_pval_fct(0)(NA_real_, na_str = "ne") + jjcsformat_pval_fct(0.0005)(NA_real_, na_str = "ne") + jjcsformat_pval_fct(0.005)(0.004999999) + jjcsformat_pval_fct(0.005)(0.0049999999) + jjcsformat_pval_fct(0.005)(0.00499999999) }) }) +test_that("some special cases for jjcsformat_pval_fct", { + expect_identical( + format_value(NA_real_, format = jjcsformat_pval_fct(0), na_str = "NE"), + "NE" + ) + expect_identical( + format_value(NA_real_, format = jjcsformat_pval_fct(0.0005), na_str = "NE"), + "NE" + ) + expect_error( + format_value(0.00000123, format = jjcsformat_pval_fct(0.0005), na_str = "NE"), + "jjcsformat_pval_fct: argument alpha should be 0 or at least 0.001." + ) +}) + test_that("jjcsformat_xx works also for empty cells", { expect_silent(in_rows( .list = list( diff --git a/tests/testthat/test-kaplan_meier.R b/tests/testthat/test-kaplan_meier.R index f9336606..7891ef9b 100644 --- a/tests/testthat/test-kaplan_meier.R +++ b/tests/testthat/test-kaplan_meier.R @@ -1,15 +1,15 @@ library(tern) test_that("s_kaplan_meier works with default arguments", { - adtte_f <- tern::tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern::tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 ) result <- expect_silent(s_kaplan_meier( - df = adtte_f %>% dplyr::filter(ARMCD == "ARM B"), + df = adtte_f |> dplyr::filter(ARMCD == "ARM B"), .var = "AVAL", is_event = "is_event" )) @@ -18,8 +18,8 @@ test_that("s_kaplan_meier works with default arguments", { }) test_that("s_kaplan_meier works with customized arguments", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 @@ -42,8 +42,8 @@ test_that("s_kaplan_meier works with customized arguments", { }) test_that("a_kaplan_meier works with default arguments", { - adtte_f <- tern::tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern::tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 @@ -61,8 +61,8 @@ test_that("a_kaplan_meier works with default arguments", { }) test_that("a_kaplan_meier works with customized arguments", { - adtte_f <- tern::tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern::tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 @@ -85,8 +85,8 @@ test_that("a_kaplan_meier works with customized arguments", { }) test_that("a_kaplan_meier works inside analyze in table", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 @@ -95,10 +95,10 @@ test_that("a_kaplan_meier works inside analyze in table", { adtte_f$AVAL == max(adtte_f$AVAL[adtte_f$ARMCD == "ARM A"]) ] <- FALSE - result <- basic_table() %>% + result <- basic_table(round_type = "sas") |> split_cols_by( var = "ARMCD" - ) %>% + ) |> analyze( vars = "AVAL", afun = a_kaplan_meier, @@ -107,7 +107,7 @@ test_that("a_kaplan_meier works inside analyze in table", { extra_args = list( is_event = "is_event" ) - ) %>% + ) |> build_table(df = adtte_f) res <- expect_silent(result) @@ -115,8 +115,8 @@ test_that("a_kaplan_meier works inside analyze in table", { }) test_that("a_kaplan_meier works inside analyze in table with custom arguments", { - adtte_f <- tern_ex_adtte %>% - dplyr::filter(PARAMCD == "OS") %>% + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( AVAL = tern::day2month(AVAL), is_event = CNSR == 0 @@ -125,10 +125,10 @@ test_that("a_kaplan_meier works inside analyze in table with custom arguments", adtte_f$AVAL == max(adtte_f$AVAL[adtte_f$ARMCD == "ARM A"]) ] <- FALSE - result <- basic_table() %>% + result <- basic_table(round_type = "sas") |> split_cols_by( var = "ARMCD" - ) %>% + ) |> analyze( vars = "AVAL", afun = a_kaplan_meier, @@ -144,7 +144,7 @@ test_that("a_kaplan_meier works inside analyze in table with custom arguments", .labels = c(range_with_cens_info = "Min and Max"), .indent_mods = c(median_ci_3d = 3L) ) - ) %>% + ) |> build_table(df = adtte_f) res <- expect_silent(result) diff --git a/tests/testthat/test-patyrs-eair100.R b/tests/testthat/test-patyrs-eair100.R index 70632323..feaa6088 100644 --- a/tests/testthat/test-patyrs-eair100.R +++ b/tests/testthat/test-patyrs-eair100.R @@ -4,26 +4,26 @@ library(dplyr) ref_path <- c("ARM", "B: Placebo") -adsl <- ex_adsl %>% - mutate(TRTDURY = substring(USUBJID, nchar(USUBJID) - 3 + 1), "-", "") %>% - mutate(TRTDURY = sub("-", "", TRTDURY)) %>% - mutate(TRTDURY = sub("d", "", TRTDURY)) %>% - mutate(TRTDURY = as.numeric(TRTDURY)) %>% - mutate(TRTDURY2 = TRTDURY + 25) %>% +adsl <- ex_adsl |> + mutate(TRTDURY = substring(USUBJID, nchar(USUBJID) - 3 + 1), "-", "") |> + mutate(TRTDURY = sub("-", "", TRTDURY)) |> + mutate(TRTDURY = sub("d", "", TRTDURY)) |> + mutate(TRTDURY = as.numeric(TRTDURY)) |> + mutate(TRTDURY2 = TRTDURY + 25) |> select(USUBJID, ARM, COUNTRY, STRATA1, TRTDURY, TRTDURY2, SEX) -adae <- ex_adae %>% +adae <- ex_adae |> select(USUBJID, AEDECOD, AEBODSYS, ASTDY) adae$TRTEMFL <- "Y" # set up occurrence flag for first occurrence of event -adaefirst <- adae %>% - arrange(USUBJID, AEBODSYS, AEDECOD, ASTDY) %>% - group_by(USUBJID, AEBODSYS, AEDECOD) %>% - slice(1) %>% - ungroup() %>% - mutate(AOCCPFL = "Y") %>% +adaefirst <- adae |> + arrange(USUBJID, AEBODSYS, AEDECOD, ASTDY) |> + group_by(USUBJID, AEBODSYS, AEDECOD) |> + slice(1) |> + ungroup() |> + mutate(AOCCPFL = "Y") |> select(USUBJID, AEBODSYS, AEDECOD, ASTDY, AOCCPFL) adae <- left_join( @@ -44,13 +44,13 @@ adsl$colspan_trt <- factor( adsl$rrisk_header <- "Risk Difference (%) (95% CI)" adsl$rrisk_label <- paste(adsl[["ARM"]], "vs Placebo") -adae <- left_join(adsl, adae, by = "USUBJID") %>% +adae <- left_join(adsl, adae, by = "USUBJID") |> mutate(ASTDY2 = ASTDY + 10) -core_lyt <- basic_table(show_colcounts = FALSE) %>% - split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) %>% - split_cols_by("ARM") %>% - split_cols_by("rrisk_header", nested = FALSE) %>% +core_lyt <- basic_table(show_colcounts = FALSE, round_type = "sas") |> + split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_cols_by("rrisk_header", nested = FALSE) |> split_cols_by( "ARM", labels_var = "rrisk_label", @@ -65,7 +65,7 @@ test_that("Check patient years numbers are giving expected result", { label = c("Subject years\u1D43") ) - lyt1 <- core_lyt %>% + lyt1 <- core_lyt |> analyze( "TRTDURY", nested = FALSE, @@ -77,10 +77,10 @@ test_that("Check patient years numbers are giving expected result", { res1 <- cell_values(tbl1[c("TRTDURY", "patyrs"), "A: Drug X"]) result <- as.numeric(unlist(unname(res1))[[1]]) - adae_sub <- adae %>% - filter(ARM == "A: Drug X") %>% - group_by(USUBJID) %>% - slice(1) %>% + adae_sub <- adae |> + filter(ARM == "A: Drug X") |> + group_by(USUBJID) |> + slice(1) |> ungroup() expected <- sum(adae_sub$TRTDURY) @@ -92,7 +92,7 @@ test_that("Check patient years numbers are giving expected result", { }) test_that("Check aeir100 numbers are giving expected result", { - lyt1 <- core_lyt %>% + lyt1 <- core_lyt |> analyze( "AEDECOD", nested = FALSE, @@ -110,28 +110,28 @@ test_that("Check aeir100 numbers are giving expected result", { res1 <- cell_values(tbl1["dcd A.1.1.1.1", "A: Drug X"]) result <- as.numeric(unlist(unname(res1))[[1]]) - adae_onecode <- adae %>% - filter(AEDECOD == "dcd A.1.1.1.1" & !is.na(AOCCPFL)) %>% + adae_onecode <- adae |> + filter(AEDECOD == "dcd A.1.1.1.1" & !is.na(AOCCPFL)) |> select(USUBJID, AEDECOD, AEBODSYS, ASTDY, TRTEMFL, AOCCPFL) adae_sub <- left_join(adsl, adae_onecode, by = "USUBJID") - adae_sub <- adae_sub %>% - filter(ARM == "A: Drug X") %>% - arrange(USUBJID, AEDECOD, ASTDY) %>% - group_by(USUBJID) %>% - slice(1) %>% - ungroup() %>% + adae_sub <- adae_sub |> + filter(ARM == "A: Drug X") |> + arrange(USUBJID, AEDECOD, ASTDY) |> + group_by(USUBJID) |> + slice(1) |> + ungroup() |> mutate(EXP_TIME = if_else(!is.na(ASTDY), (ASTDY / 365.25), TRTDURY)) total_exp_years <- sum(adae_sub$EXP_TIME) - adae_sub2 <- adae %>% + adae_sub2 <- adae |> filter( AEDECOD == "dcd A.1.1.1.1" & ARM == "A: Drug X" & !is.na(AOCCPFL) - ) %>% - group_by(USUBJID) %>% - slice(1) %>% + ) |> + group_by(USUBJID) |> + slice(1) |> ungroup() number_with_event <- nrow(adae_sub2) @@ -145,7 +145,7 @@ test_that("Check aeir100 numbers are giving expected result", { }) test_that("Check aeir100 numbers are giving expected result when fup_var argument is changed", { - lyt1 <- core_lyt %>% + lyt1 <- core_lyt |> analyze( "AEDECOD", nested = FALSE, @@ -163,28 +163,28 @@ test_that("Check aeir100 numbers are giving expected result when fup_var argumen res1 <- cell_values(tbl1["dcd A.1.1.1.1", "A: Drug X"]) result <- as.numeric(unlist(unname(res1))[[1]]) - adae_onecode <- adae %>% - filter(AEDECOD == "dcd A.1.1.1.1" & !is.na(AOCCPFL)) %>% + adae_onecode <- adae |> + filter(AEDECOD == "dcd A.1.1.1.1" & !is.na(AOCCPFL)) |> select(USUBJID, AEDECOD, AEBODSYS, ASTDY, TRTEMFL, AOCCPFL) adae_sub <- left_join(adsl, adae_onecode, by = "USUBJID") - adae_sub <- adae_sub %>% - filter(ARM == "A: Drug X") %>% - arrange(USUBJID, AEDECOD, ASTDY) %>% - group_by(USUBJID) %>% - slice(1) %>% - ungroup() %>% + adae_sub <- adae_sub |> + filter(ARM == "A: Drug X") |> + arrange(USUBJID, AEDECOD, ASTDY) |> + group_by(USUBJID) |> + slice(1) |> + ungroup() |> mutate(EXP_TIME = if_else(!is.na(ASTDY), (ASTDY / 365.25), TRTDURY2)) total_exp_years <- sum(adae_sub$EXP_TIME) - adae_sub2 <- adae %>% + adae_sub2 <- adae |> filter( AEDECOD == "dcd A.1.1.1.1" & ARM == "A: Drug X" & !is.na(AOCCPFL) - ) %>% - group_by(USUBJID) %>% - slice(1) %>% + ) |> + group_by(USUBJID) |> + slice(1) |> ungroup() number_with_event <- nrow(adae_sub2) @@ -198,7 +198,7 @@ test_that("Check aeir100 numbers are giving expected result when fup_var argumen }) test_that("Check aeir100 numbers are giving expected result when occ_dy argument is changed", { - lyt1 <- core_lyt %>% + lyt1 <- core_lyt |> analyze( "AEDECOD", nested = FALSE, @@ -216,28 +216,28 @@ test_that("Check aeir100 numbers are giving expected result when occ_dy argument res1 <- cell_values(tbl1["dcd A.1.1.1.1", "A: Drug X"]) result <- as.numeric(unlist(unname(res1))[[1]]) - adae_onecode <- adae %>% - filter(AEDECOD == "dcd A.1.1.1.1" & !is.na(AOCCPFL)) %>% + adae_onecode <- adae |> + filter(AEDECOD == "dcd A.1.1.1.1" & !is.na(AOCCPFL)) |> select(USUBJID, AEDECOD, AEBODSYS, ASTDY2, TRTEMFL, AOCCPFL) adae_sub <- left_join(adsl, adae_onecode, by = "USUBJID") - adae_sub <- adae_sub %>% - filter(ARM == "A: Drug X") %>% - arrange(USUBJID, AEDECOD, ASTDY2) %>% - group_by(USUBJID) %>% - slice(1) %>% - ungroup() %>% + adae_sub <- adae_sub |> + filter(ARM == "A: Drug X") |> + arrange(USUBJID, AEDECOD, ASTDY2) |> + group_by(USUBJID) |> + slice(1) |> + ungroup() |> mutate(EXP_TIME = if_else(!is.na(ASTDY2), (ASTDY2 / 365.25), TRTDURY2)) total_exp_years <- sum(adae_sub$EXP_TIME) - adae_sub2 <- adae %>% + adae_sub2 <- adae |> filter( AEDECOD == "dcd A.1.1.1.1" & ARM == "A: Drug X" & !is.na(AOCCPFL) - ) %>% - group_by(USUBJID) %>% - slice(1) %>% + ) |> + group_by(USUBJID) |> + slice(1) |> ungroup() number_with_event <- nrow(adae_sub2) diff --git a/tests/testthat/test-proportions.R b/tests/testthat/test-proportions.R index eaff4e39..f5897d17 100644 --- a/tests/testthat/test-proportions.R +++ b/tests/testthat/test-proportions.R @@ -103,7 +103,7 @@ test_that("a_proportion_ci_factor works as expected", { }) test_that("prop_split_fun works as expected", { - result <- basic_table() %>% + result <- basic_table(round_type = "sas") |> split_cols_by("ID", split_fun = prop_split_fun) |> build_table(formatters::DM) expect_snapshot(result) diff --git a/tests/testthat/test-pruning_functions.R b/tests/testthat/test-pruning_functions.R index 4a4ad061..ba8271ed 100644 --- a/tests/testthat/test-pruning_functions.R +++ b/tests/testthat/test-pruning_functions.R @@ -2,12 +2,12 @@ library(dplyr) library(tern) # Pre-processing the table -tab <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("RACE") %>% - split_rows_by("STRATA1") %>% - summarize_row_groups() %>% - analyze_vars("COUNTRY", .stats = "count_fraction") %>% +tab <- basic_table(round_type = "sas") |> + split_cols_by("ARM") |> + split_rows_by("RACE") |> + split_rows_by("STRATA1") |> + summarize_row_groups() |> + analyze_vars("COUNTRY", .stats = "count_fraction") |> build_table(formatters::DM) trtvar <- "ARM" @@ -125,19 +125,19 @@ testthat::test_that("test keep_non_null_rows", { rcell(NULL, label = "") } - tabsx <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("ARM") %>% - analyze("ARM", afun = xnull_cell_fn, show_labels = "hidden") %>% - analyze("STRATA1", show_labels = "hidden") %>% + tabsx <- basic_table(round_type = "sas") |> + split_cols_by("ARM") |> + split_rows_by("ARM") |> + analyze("ARM", afun = xnull_cell_fn, show_labels = "hidden") |> + analyze("STRATA1", show_labels = "hidden") |> build_table(formatters::DM) result <- prune_table(tabsx, keep_rows(keep_non_null_rows)) - tabsx2 <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("ARM") %>% - analyze("STRATA1") %>% + tabsx2 <- basic_table(round_type = "sas") |> + split_cols_by("ARM") |> + split_rows_by("ARM") |> + analyze("STRATA1") |> build_table(formatters::DM) expected <- tabsx2 @@ -174,9 +174,9 @@ testthat::test_that("bspt_pruner both fraction and diff_from_control are NULL", }) testthat::test_that("bspt_pruner with fraction", { - tab_bspt_pruner <- basic_table() %>% - split_cols_by("ARM") %>% - analyze_vars("COUNTRY", .stats = "count_fraction") %>% + tab_bspt_pruner <- basic_table(round_type = "sas") |> + split_cols_by("ARM") |> + analyze_vars("COUNTRY", .stats = "count_fraction") |> build_table(formatters::DM) result <- prune_table( @@ -194,9 +194,9 @@ testthat::test_that("bspt_pruner with fraction", { }) testthat::test_that("bspt_pruner with fraction and diff_from_control", { - tab_bspt_pruner <- basic_table() %>% - split_cols_by("ARM") %>% - analyze_vars("COUNTRY", .stats = "count_fraction") %>% + tab_bspt_pruner <- basic_table(round_type = "sas") |> + split_cols_by("ARM") |> + analyze_vars("COUNTRY", .stats = "count_fraction") |> build_table(formatters::DM) result <- prune_table( @@ -216,9 +216,9 @@ testthat::test_that("bspt_pruner with fraction and diff_from_control", { }) testthat::test_that("bspt_pruner with fraction and diff_from_control and keeprowtext", { - tab_bspt_pruner <- basic_table() %>% - split_cols_by("ARM") %>% - analyze_vars("COUNTRY", .stats = "count_fraction") %>% + tab_bspt_pruner <- basic_table(round_type = "sas") |> + split_cols_by("ARM") |> + analyze_vars("COUNTRY", .stats = "count_fraction") |> build_table(formatters::DM) result1 <- prune_table( @@ -253,8 +253,8 @@ testthat::test_that("bspt_pruner with fraction and diff_from_control and keeprow }) testthat::test_that("count_pruner in small groups", { - DM_sub <- subset(DM, COUNTRY %in% c("USA", "CAN")) %>% - mutate(COUNTRY = factor(as.character(COUNTRY))) %>% + DM_sub <- subset(DM, COUNTRY %in% c("USA", "CAN")) |> + mutate(COUNTRY = factor(as.character(COUNTRY))) |> mutate( colspan_trt = factor( ifelse(ARM == "B: Placebo", " ", "Active Study Agent"), @@ -270,16 +270,16 @@ testthat::test_that("count_pruner in small groups", { ref_path = ref_path ) - tab_bspt_pruner <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) %>% - split_cols_by("ARM") %>% - split_cols_by("rrisk_header", nested = FALSE) %>% + tab_bspt_pruner <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_cols_by("rrisk_header", nested = FALSE) |> split_cols_by( "ARM", labels_var = "rrisk_label", split_fun = remove_split_levels("B: Placebo") - ) %>% - analyze("COUNTRY", afun = a_freq_j, extra_args = extra_args) %>% + ) |> + analyze("COUNTRY", afun = a_freq_j, extra_args = extra_args) |> build_table(DM_sub) result <- prune_table( @@ -298,7 +298,7 @@ testthat::test_that("bspt_pruner in AE like tables", { my_adsl <- bind_rows( as_tibble(cbind(ARM = rep("Group A", 100), USUBJID = paste0("A", 1:100))), as_tibble(cbind(ARM = rep("Group B", 100), USUBJID = paste0("B", 1:100))) - ) %>% + ) |> mutate(ARM = factor(ARM)) my_adsl$colspan <- factor( @@ -316,51 +316,51 @@ testthat::test_that("bspt_pruner in AE like tables", { my_adae <- bind_rows( - my_adsl %>% - filter(USUBJID %in% c(paste0("A", 1:4), paste0("B", 1:2))) %>% + my_adsl |> + filter(USUBJID %in% c(paste0("A", 1:4), paste0("B", 1:2))) |> mutate( AEBODSYS = "BODSYS1", AEDECOD = "Decod 1" ), - my_adsl %>% - filter(USUBJID %in% c(paste0("A", 5:6), paste0("B", 3:6))) %>% + my_adsl |> + filter(USUBJID %in% c(paste0("A", 5:6), paste0("B", 3:6))) |> mutate( AEBODSYS = "BODSYS1", AEDECOD = "Decod 2" ), - my_adsl %>% - filter(USUBJID %in% c(paste0("A", 1:6), paste0("B", 1:4))) %>% + my_adsl |> + filter(USUBJID %in% c(paste0("A", 1:6), paste0("B", 1:4))) |> mutate( AEBODSYS = "BODSYS2", AEDECOD = "Decod 3" ), - my_adsl %>% - filter(USUBJID %in% c(paste0("A", 1:6), paste0("B", 1:4))) %>% + my_adsl |> + filter(USUBJID %in% c(paste0("A", 1:6), paste0("B", 1:4))) |> mutate( AEBODSYS = "BODSYS2", AEDECOD = "Decod 4" ), - my_adsl %>% - filter(USUBJID %in% c(paste0("A", 1:6), paste0("B", 1:2))) %>% + my_adsl |> + filter(USUBJID %in% c(paste0("A", 1:6), paste0("B", 1:2))) |> mutate( AEBODSYS = "BODSYS3", AEDECOD = "Decod 5" ), - my_adsl %>% - filter(USUBJID %in% c(paste0("A", 1:2), paste0("B", 1:6))) %>% + my_adsl |> + filter(USUBJID %in% c(paste0("A", 1:2), paste0("B", 1:6))) |> mutate( AEBODSYS = "BODSYS3", AEDECOD = "Decod 6" ), - my_adsl %>% - filter(USUBJID %in% c(paste0("A", 1:8), paste0("B", 1:8))) %>% + my_adsl |> + filter(USUBJID %in% c(paste0("A", 1:8), paste0("B", 1:8))) |> mutate( AEBODSYS = "BODSYS3", AEDECOD = "Decod 7" ) - ) %>% - mutate(AEBODSYS = factor(AEBODSYS)) %>% - mutate(AEDECOD = factor(AEDECOD)) %>% + ) |> + mutate(AEBODSYS = factor(AEBODSYS)) |> + mutate(AEDECOD = factor(AEDECOD)) |> mutate(TRTEMFL = "Y") extra_args_rr <- list( @@ -369,39 +369,39 @@ testthat::test_that("bspt_pruner in AE like tables", { .stats = "count_unique_fraction" ) - tbl1 <- basic_table(show_colcounts = TRUE, top_level_section_div = " ") %>% - split_cols_by("colspan", split_fun = trim_levels_in_group("ARM")) %>% - split_cols_by("ARM") %>% - split_cols_by("rrisk_header", nested = FALSE) %>% + tbl1 <- basic_table(show_colcounts = TRUE, top_level_section_div = " ", round_type = "sas") |> + split_cols_by("colspan", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_cols_by("rrisk_header", nested = FALSE) |> split_cols_by( "ARM", labels_var = "rrisk_label", split_fun = remove_split_levels("Group B") - ) %>% + ) |> analyze( "TRTEMFL", afun = a_freq_j, show_labels = "hidden", extra_args = append(extra_args_rr, list(label = "Subjects with >=1 AE")) - ) %>% + ) |> split_rows_by( "AEBODSYS", split_fun = trim_levels_in_group("AEDECOD"), section_div = c(" "), nested = FALSE - ) %>% + ) |> summarize_row_groups( "AEBODSYS", cfun = a_freq_j, extra_args = extra_args_rr - ) %>% + ) |> analyze( vars = "AEDECOD", afun = a_freq_j, indent_mod = 1L, show_labels = "hidden", extra_args = extra_args_rr - ) %>% + ) |> build_table(my_adae, my_adsl) result1 <- safe_prune_table( @@ -453,14 +453,14 @@ testthat::test_that("bspt_pruner in AE like tables", { testthat::test_that("bspt_pruner with less obvious control specifications", { - DM_sub <- formatters::DM %>% - mutate(COUNTRY = factor(as.character(COUNTRY))) %>% + DM_sub <- formatters::DM |> + mutate(COUNTRY = factor(as.character(COUNTRY))) |> mutate(SEX = factor(as.character(SEX))) - tab_bspt_pruner <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_cols_by("SEX") %>% - analyze_vars("COUNTRY", .stats = "count_fraction") %>% + tab_bspt_pruner <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> + split_cols_by("SEX") |> + analyze_vars("COUNTRY", .stats = "count_fraction") |> build_table(DM_sub) rps_label <- make_row_df(tab_bspt_pruner)$label @@ -510,12 +510,12 @@ testthat::test_that("bspt_pruner with less obvious control specifications", { }) #### Tests for safe_prune_table function#### -my_DM <- formatters::DM %>% +my_DM <- formatters::DM |> filter(RACE == "THIS LEAVES EMPTY DF") -my_tab <- basic_table() %>% - split_cols_by("ARM") %>% - analyze("AGE") %>% +my_tab <- basic_table(round_type = "sas") |> + split_cols_by("ARM") |> + analyze("AGE") |> build_table(my_DM) testthat::test_that("check that if all data is pruned leaving no rows, the outcome is the message", { diff --git a/tests/testthat/test-rbmi.R b/tests/testthat/test-rbmi.R index ac405133..dab46ac5 100644 --- a/tests/testthat/test-rbmi.R +++ b/tests/testthat/test-rbmi.R @@ -219,7 +219,7 @@ test_that("Parallelisation works with rbmi_analyse and produces identical result c(2, 1, 0.7, 1.5), c(0.5, 0.3, 0.2, 0.3, 0.5, 0.4) ) - dat <- get_sim_data(200, sigma, trt = 8) %>% + dat <- get_sim_data(200, sigma, trt = 8) |> dplyr::mutate( outcome = dplyr::if_else( rbinom(dplyr::n(), 1, 0.3) == 1 & group == "A", @@ -228,13 +228,13 @@ test_that("Parallelisation works with rbmi_analyse and produces identical result ) ) - dat_ice <- dat %>% - dplyr::group_by(id) %>% - dplyr::arrange(id, visit) %>% - dplyr::filter(is.na(outcome)) %>% - dplyr::slice(1) %>% - dplyr::ungroup() %>% - dplyr::select(id, visit) %>% + dat_ice <- dat |> + dplyr::group_by(id) |> + dplyr::arrange(id, visit) |> + dplyr::filter(is.na(outcome)) |> + dplyr::slice(1) |> + dplyr::ungroup() |> + dplyr::select(id, visit) |> dplyr::mutate(strategy = "JR") vars <- rbmi::set_vars( @@ -267,7 +267,7 @@ test_that("Parallelisation works with rbmi_analyse and produces identical result ### Delta 1 - dat_delta_1 <- rbmi::delta_template(imputations = imputeobj) %>% + dat_delta_1 <- rbmi::delta_template(imputations = imputeobj) |> dplyr::mutate(delta = is_missing * 5) vars2 <- vars @@ -312,7 +312,7 @@ test_that("Parallelisation works with rbmi_analyse and produces identical result ### Delta 2 - dat_delta_2 <- rbmi::delta_template(imputations = imputeobj) %>% + dat_delta_2 <- rbmi::delta_template(imputations = imputeobj) |> dplyr::mutate(delta = is_missing * 50) anaobj_d2_t1 <- rbmi_analyse( diff --git a/tests/testthat/test-relative_risk.R b/tests/testthat/test-relative_risk.R index 86aa27bb..9760a696 100644 --- a/tests/testthat/test-relative_risk.R +++ b/tests/testthat/test-relative_risk.R @@ -341,7 +341,7 @@ test_that("a_relative_risk in table layout gives same results as with SAS", { )) ) - lyt <- basic_table() |> + lyt <- basic_table(round_type = "sas") |> split_cols_by("Treatment") |> analyze( vars = "Response", diff --git a/tests/testthat/test-remove_col_count.R b/tests/testthat/test-remove_col_count.R index a6fd6c0d..9cea9dce 100644 --- a/tests/testthat/test-remove_col_count.R +++ b/tests/testthat/test-remove_col_count.R @@ -12,11 +12,12 @@ testthat::test_that("remove_col_count works", { lyt <- basic_table( top_level_section_div = " ", show_colcounts = TRUE, - colcount_format = "N=xx" - ) %>% - split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) %>% - split_cols_by("ARM") %>% - split_cols_by("set2", nested = FALSE) %>% + colcount_format = "N=xx", + round_type = "sas" + ) |> + split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_cols_by("set2", nested = FALSE) |> split_cols_by("ARM", split_fun = remove_split_levels("B: Placebo")) tbl <- build_table(lyt, adsl) diff --git a/tests/testthat/test-resp01_functions.R b/tests/testthat/test-resp01_functions.R index fbf52144..c38473e2 100644 --- a/tests/testthat/test-resp01_functions.R +++ b/tests/testthat/test-resp01_functions.R @@ -5,8 +5,8 @@ test_that("resp01_split_fun_fct 1 works as expected", { method = "or_cmh", conf_level = 0.95 ) - result <- basic_table() %>% - split_cols_by("ARM", split_fun = add_overall_level("Overall")) %>% + result <- basic_table(round_type = "sas") |> + split_cols_by("ARM", split_fun = add_overall_level("Overall")) |> split_cols_by("ID", split_fun = split_fun) |> build_table(formatters::DM) expect_snapshot(result) @@ -17,8 +17,8 @@ test_that("resp01_split_fun_fct 2 works as expected", { method = "rr", conf_level = 0.92 ) - result <- basic_table() %>% - split_cols_by("ARM", split_fun = add_overall_level("Overall")) %>% + result <- basic_table(round_type = "sas") |> + split_cols_by("ARM", split_fun = add_overall_level("Overall")) |> split_cols_by("ID", split_fun = split_fun) |> build_table(formatters::DM) expect_snapshot(col_info(result)) diff --git a/tests/testthat/test-response_by_var.R b/tests/testthat/test-response_by_var.R index d3c618e8..4682664c 100644 --- a/tests/testthat/test-response_by_var.R +++ b/tests/testthat/test-response_by_var.R @@ -6,18 +6,18 @@ adsl <- ex_adsl adae <- ex_adae adae$TRTEMFL <- "Y" -had_ae <- adae %>% - filter(TRTEMFL == "Y") %>% - select(USUBJID, TRTEMFL) %>% +had_ae <- adae |> + filter(TRTEMFL == "Y") |> + select(USUBJID, TRTEMFL) |> distinct(USUBJID, .keep_all = TRUE) -adsl <- adsl %>% - left_join(had_ae, by = "USUBJID") %>% +adsl <- adsl |> + left_join(had_ae, by = "USUBJID") |> mutate(TRTEMFL = ifelse(is.na(TRTEMFL), "N", "Y")) test_that("response_by_var various scenarios", { - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE, round_type = "sas") |> + split_cols_by("ARM") |> analyze( vars = "SEX", var_labels = "Sex, n/Ns (%)", @@ -51,7 +51,7 @@ test_that("response_by_var various scenarios", { expect_snapshot(tbl2) ## Scenario 3: TRTEMFL has missing values and Y only, and analysis variable has missing values - adsl3 <- adsl %>% select(USUBJID, ARM, SEX, TRTEMFL) + adsl3 <- adsl |> select(USUBJID, ARM, SEX, TRTEMFL) adsl3$TRTEMFL <- ifelse(adsl3$TRTEMFL == "Y", "Y", NA) adsl3$TRTEMFL <- factor(adsl3$TRTEMFL, levels = "Y") adsl3$SEX[1:10] <- NA_character_ @@ -71,7 +71,7 @@ test_that("response_by_var various scenarios", { expect_snapshot(tbl3) ## Scenario 4: TRTEMFL has missing values and Y/N, and analysis variable has missing values - adsl4 <- adsl %>% select(USUBJID, ARM, SEX, TRTEMFL) + adsl4 <- adsl |> select(USUBJID, ARM, SEX, TRTEMFL) adsl4$SEX[1:10] <- NA_character_ adsl4$TRTEMFL[8:15] <- NA_character_ @@ -90,7 +90,7 @@ test_that("response_by_var various scenarios", { expect_snapshot(tbl4) ## Scenario 5: Analysis variable has a level not observed in data - adsl5 <- adsl %>% select(USUBJID, ARM, SEX, TRTEMFL) + adsl5 <- adsl |> select(USUBJID, ARM, SEX, TRTEMFL) adsl5$SEX <- factor( as.character(adsl5$SEX), levels = c(levels(adsl5$SEX), "extra level") diff --git a/tests/testthat/test-sorting_functions.R b/tests/testthat/test-sorting_functions.R index b1f1125e..bb355f0e 100644 --- a/tests/testthat/test-sorting_functions.R +++ b/tests/testthat/test-sorting_functions.R @@ -10,12 +10,12 @@ DM2$spanhead <- factor( levels = c("This is a Spanning Header", " ") ) -tab <- basic_table() %>% - split_cols_by("spanhead", split_fun = trim_levels_in_group("ARM")) %>% - split_cols_by("ARM") %>% - split_rows_by("STRATA1") %>% - summarize_row_groups() %>% - analyze_vars("COUNTRY", .stats = "count_fraction") %>% +tab <- basic_table(round_type = "sas") |> + split_cols_by("spanhead", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_rows_by("STRATA1") |> + summarize_row_groups() |> + analyze_vars("COUNTRY", .stats = "count_fraction") |> build_table(DM2) #### Tests for jj_complex_scorefun function #### @@ -131,13 +131,13 @@ testthat::test_that("jj_complex_scorefun places specified category at the end: l testthat::expect_identical(result, expected) }) -tab2 <- basic_table() %>% - split_cols_by("spanhead", split_fun = trim_levels_in_group("ARM")) %>% - split_cols_by("ARM") %>% - split_cols_by("RACE") %>% - split_rows_by("STRATA1") %>% - summarize_row_groups() %>% - analyze_vars("COUNTRY", .stats = "count_fraction") %>% +tab2 <- basic_table(round_type = "sas") |> + split_cols_by("spanhead", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_cols_by("RACE") |> + split_rows_by("STRATA1") |> + summarize_row_groups() |> + analyze_vars("COUNTRY", .stats = "count_fraction") |> build_table(DM2) testthat::test_that("jj_complex_scorefun uses first column to sort: usefirstcol", { diff --git a/tests/testthat/test-split_functions.R b/tests/testthat/test-split_functions.R index 6be02f04..e4c99c35 100644 --- a/tests/testthat/test-split_functions.R +++ b/tests/testthat/test-split_functions.R @@ -25,9 +25,10 @@ testthat::test_that("cond_rm_facets works", { lyt <- basic_table( top_level_section_div = " ", show_colcounts = TRUE, - colcount_format = "N=xx" - ) %>% - split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) %>% + colcount_format = "N=xx", + round_type = "sas" + ) |> + split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) |> split_cols_by("ARM", split_fun = mysplit) tbl <- build_table(lyt, adsl) @@ -55,8 +56,8 @@ testthat::test_that("rm_levels works", { pre = list(rm_levels(excl = c("JPN", "USA", "NGA"))) ) - lyt <- basic_table() %>% - split_rows_by("COUNTRY", split_fun = split_fun) %>% + lyt <- basic_table(round_type = "sas") |> + split_rows_by("COUNTRY", split_fun = split_fun) |> summarize_row_groups() # for simplicity tbl <- build_table(lyt, adsl) @@ -76,8 +77,8 @@ testthat::test_that("real_add_overall_facet works", { post = list(real_add_overall_facet("Overall", "Overall")) ) - lyt <- basic_table() %>% - split_rows_by("COUNTRY", split_fun = split_fun) %>% + lyt <- basic_table(round_type = "sas") |> + split_rows_by("COUNTRY", split_fun = split_fun) |> summarize_row_groups() # for simplicity tbl <- build_table(lyt, adsl) @@ -100,8 +101,8 @@ testthat::test_that("make_combo_splitfun works", { levels = c("USA", "CAN") ) - lyt <- basic_table() %>% - split_rows_by("COUNTRY", split_fun = split_fun) %>% + lyt <- basic_table(round_type = "sas") |> + split_rows_by("COUNTRY", split_fun = split_fun) |> summarize_row_groups() # for simplicity tbl <- build_table(lyt, adsl) @@ -137,8 +138,8 @@ testthat::test_that("combine_nonblank works", { split_fun <- make_split_fun(post = list(combine_nonblank("Overall", "Overall"))) - lyt <- basic_table() %>% - split_rows_by("COUNTRY", split_fun = split_fun) %>% + lyt <- basic_table(round_type = "sas") |> + split_rows_by("COUNTRY", split_fun = split_fun) |> summarize_row_groups() # for simplicity tbl <- build_table(lyt, adsl) @@ -172,14 +173,14 @@ testthat::test_that("rm_blank_levels works", { pre = list(rm_blank_levels) ) - lyt <- basic_table() %>% - split_rows_by("COUNTRY") %>% + lyt <- basic_table(round_type = "sas") |> + split_rows_by("COUNTRY") |> summarize_row_groups() tbl <- build_table(lyt, adsl) row_names_before <- rtables::row.names(tbl) - lyt <- basic_table() %>% - split_rows_by("COUNTRY", split_fun = split_fun) %>% + lyt <- basic_table(round_type = "sas") |> + split_rows_by("COUNTRY", split_fun = split_fun) |> summarize_row_groups() tbl <- build_table(lyt, adsl) row_names_after <- rtables::row.names(tbl) diff --git a/tests/testthat/test-summarize_ancova.R b/tests/testthat/test-summarize_ancova.R index cbfdc6dc..3256783e 100644 --- a/tests/testthat/test-summarize_ancova.R +++ b/tests/testthat/test-summarize_ancova.R @@ -143,9 +143,9 @@ test_that("s_summarize_ancova works as expected", { }) test_that("a_summarize_ancova_j works as expected in table layout", { - result <- basic_table() %>% - split_cols_by("Species") %>% - add_colcounts() %>% + result <- basic_table(round_type = "sas") |> + split_cols_by("Species") |> + add_colcounts() |> analyze( vars = "Petal.Length", afun = a_summarize_ancova_j, @@ -167,7 +167,7 @@ test_that("a_summarize_ancova_j works as expected in table layout", { "pval" ) ) - ) %>% + ) |> analyze( vars = "Petal.Length", afun = a_summarize_ancova_j, @@ -187,7 +187,7 @@ test_that("a_summarize_ancova_j works as expected in table layout", { "pval" ) ) - ) %>% + ) |> build_table(iris) expect_snapshot(result) }) diff --git a/tests/testthat/test-summarize_row_counts.R b/tests/testthat/test-summarize_row_counts.R index 7f540a5a..e2ae1c9f 100644 --- a/tests/testthat/test-summarize_row_counts.R +++ b/tests/testthat/test-summarize_row_counts.R @@ -1,11 +1,11 @@ library(rtables) test_that("summarize_row_counts works as expected without alt counts", { - lyt <- basic_table() %>% - split_cols_by("ARM") %>% - add_colcounts() %>% - split_rows_by("RACE", split_fun = drop_split_levels) %>% - summarize_row_counts(label_fstr = "Race: %s", alt_counts = FALSE) %>% + lyt <- basic_table() |> + split_cols_by("ARM") |> + add_colcounts() |> + split_rows_by("RACE", split_fun = drop_split_levels) |> + summarize_row_counts(label_fstr = "Race: %s", alt_counts = FALSE) |> analyze("AGE", afun = list_wrap_x(summary), format = "xx.xx") res <- expect_silent(build_table(lyt, formatters::DM)) @@ -18,11 +18,11 @@ test_that("summarize_row_counts works as expected without alt counts", { }) test_that("summarize_row_counts works as expected with alt counts", { - lyt <- basic_table() %>% - split_cols_by("ARM") %>% - add_colcounts() %>% - split_rows_by("RACE", split_fun = drop_split_levels) %>% - summarize_row_counts(label_fstr = "RACE value - %s") %>% + lyt <- basic_table() |> + split_cols_by("ARM") |> + add_colcounts() |> + split_rows_by("RACE", split_fun = drop_split_levels) |> + summarize_row_counts(label_fstr = "RACE value - %s") |> analyze("AGE", afun = list_wrap_x(summary), format = "xx.xx") res <- expect_silent(build_table( diff --git a/tests/testthat/test-tabulate_lsmeans.R b/tests/testthat/test-tabulate_lsmeans.R index 4a732ae4..6f9116c6 100644 --- a/tests/testthat/test-tabulate_lsmeans.R +++ b/tests/testthat/test-tabulate_lsmeans.R @@ -68,12 +68,12 @@ test_that("summarize_lsmeans can show two- and one-sided p-values correctly", { names(df) ) - dat_adsl <- mmrm::fev_data %>% - select(USUBJID, ARMCD) %>% + dat_adsl <- mmrm::fev_data |> + select(USUBJID, ARMCD) |> unique() - start_lyt <- basic_table() %>% - split_cols_by("ARMCD") %>% - add_colcounts() %>% + start_lyt <- basic_table() |> + split_cols_by("ARMCD") |> + add_colcounts() |> split_rows_by("AVISIT") lyt_two_sided <- start_lyt |> diff --git a/tests/testthat/test-tabulate_rbmi.R b/tests/testthat/test-tabulate_rbmi.R index d2b71e63..7fcd7c2e 100644 --- a/tests/testthat/test-tabulate_rbmi.R +++ b/tests/testthat/test-tabulate_rbmi.R @@ -290,9 +290,9 @@ test_that("s_rbmi_lsmeans also works with show_relative = increase", { test_that("a_rbmi_lsmeans works as expected in table layout", { df <- tidy(rbmi_test_data_ancova, visits = c("4", "5")) - lyt <- basic_table() %>% - split_cols_by("group") %>% - split_rows_by("visit", split_label = "Visit", label_pos = "topleft") %>% + lyt <- basic_table() |> + split_cols_by("group") |> + split_rows_by("visit", split_label = "Visit", label_pos = "topleft") |> analyze( "group", afun = a_rbmi_lsmeans, diff --git a/tests/testthat/test-tern_utils_default_stats_formats_labels.R b/tests/testthat/test-tern_utils_default_stats_formats_labels.R index 33f7408c..dd7ee94f 100644 --- a/tests/testthat/test-tern_utils_default_stats_formats_labels.R +++ b/tests/testthat/test-tern_utils_default_stats_formats_labels.R @@ -176,7 +176,7 @@ testthat::test_that("tern_get_labels_from_stats works as expected", { names(stats_to_do), labels_in = c(stats_to_do, "catch_me" = "xx") ), - stats_to_do %>% as.list() + stats_to_do |> as.list() ) }) @@ -206,7 +206,7 @@ testthat::test_that("tern_get_labels_from_stats with labels in works when adding "count_fraction.a" = "any A", "count_fraction.b" = "CF: B", "count_fraction.c" = "Lvl c:" - ) %>% + ) |> as.list() ) }) @@ -268,7 +268,7 @@ testthat::test_that("tern_get_indents_from_stats works as expected", { c(names(stats_to_do), "n"), indents_in = stats_to_do ), - c(stats_to_do, n = 0L) %>% as.list() + c(stats_to_do, n = 0L) |> as.list() ) }) diff --git a/tests/testthat/test-tt_to_tblfile.R b/tests/testthat/test-tt_to_tblfile.R index cebbc81f..a1550ef3 100644 --- a/tests/testthat/test-tt_to_tblfile.R +++ b/tests/testthat/test-tt_to_tblfile.R @@ -17,9 +17,22 @@ mk_part_names <- function(nfiles, fname) { } } -rtf_out_wrapper <- function(tt, filnm, ..., part = 1, combined = FALSE) { +rtf_out_wrapper <- function( + tt, + filnm, + ..., + part = 1, + combined = FALSE, + round_type = obj_round_type(tt) +) { fullfl <- file.path(tempdir(), filnm) - res <- tt_to_tlgrtf(tt, file = fullfl, ..., combined_rtf = combined) + res <- tt_to_tlgrtf( + tt, + file = fullfl, + ..., + combined_rtf = combined, + round_type = round_type + ) nf <- length(res) if (combined) { paste0(fullfl, "allparts.rtf") @@ -33,6 +46,96 @@ rtf_out_wrapper <- function(tt, filnm, ..., part = 1, combined = FALSE) { } } +# all elements result in different rounding sas vs iec with format xx.xx +# third element only results in different rounding iec_mod vs iec with format xx.xx +vals_round_type <- c(1.865, 2.985, -0.001) + +vals_round_type_fmt <- function(vals = vals_round_type, round_type = "sas") { + mapply(format_value, x = vals, format = "xx.xx", round_type = round_type) +} + +tt_to_test_round_type <- function(vals = vals_round_type, round_type = "iec") { + require(dplyr, quietly = TRUE) + txtvals_iec <- vals_round_type_fmt(vals = vals, round_type = "iec") + txtvals_sas <- vals_round_type_fmt(vals = vals, round_type = "sas") + + # confirmation that at least one of the values result in different format presentation + expect_true(any(txtvals_iec != txtvals_sas)) + + adsl <- ex_adsl + + adsl <- adsl |> + mutate(new_var = case_when( + ARMCD == "ARM A" ~ vals[1], + ARMCD == "ARM B" ~ vals[2], + ARMCD == "ARM C" ~ vals[3] + )) + + lyt <- basic_table(show_colcounts = FALSE, round_type = round_type) |> + split_cols_by("ARMCD") |> + analyze(c("new_var"), function(x) { + in_rows( + mean = mean(x), + .formats = c("xx.xx"), + .labels = c("Mean") + ) + }) + + tbl <- build_table(lyt, adsl) +} + +listingdf_to_test_round_type <- function(vals = vals_round_type, round_type = "iec") { + require(dplyr, quietly = TRUE) + txtvals_iec <- vals_round_type_fmt(vals = vals, round_type = "iec") + txtvals_sas <- vals_round_type_fmt(vals = vals, round_type = "sas") + + # confirmation that at least one of the values result in different format presentation + expect_true(any(txtvals_iec != txtvals_sas)) + + lsting <- ex_adae |> + dplyr::select(USUBJID, AGE, SEX, RACE, ARM, BMRKR1) |> + dplyr::distinct() |> + dplyr::group_by(ARM) |> + dplyr::slice_head(n = 2) |> + dplyr::ungroup() + + lsting[1, "BMRKR1"] <- 1.865 + lsting[2, "BMRKR1"] <- 2.985 + lsting[3, "BMRKR1"] <- -0.001 + + lsting <- lsting |> + dplyr::mutate( + AGE = tern::explicit_na(as.character(AGE), ""), + SEX = tern::explicit_na(SEX, ""), + RACE = explicit_na(RACE, ""), + COL0 = explicit_na(.data[["ARM"]], ""), + COL1 = explicit_na(USUBJID, ""), + COL2 = paste(AGE, SEX, RACE, sep = " / "), + COL3 = BMRKR1 + ) |> + arrange(COL0, COL1) + + lsting <- formatters::var_relabel( + lsting, + COL0 = "Treatment Group", + COL1 = "Subject ID", + COL2 = paste("Age (years)", "Sex", "Race", sep = " / "), + COL3 = "Biomarker 1" + ) + + ls1 <- rlistings::as_listing( + df = lsting, + key_cols = c("COL0", "COL1"), + disp_cols = c("COL0", "COL1", "COL2", "COL3"), + col_formatting = list(COL3 = formatters::fmt_config(format = "xx.xx")) + ) + + list( + df = lsting, + lsting = ls1 + ) +} + test_that("tt_to_tlgrtf works with input Table and fontspec size 8", { lyt_wide <- basic_table() |> split_cols_by("ARM") |> @@ -121,8 +224,8 @@ test_that("tt_to_tlgrtf works with argument combined_rtf = TRUE", { test_that("tt_to_tlgrtf converts table tree to tlg without error", { # Create a simple table for testing - lyt <- basic_table() %>% - split_cols_by("ARM") %>% + lyt <- basic_table() |> + split_cols_by("ARM") |> analyze("AGE") tbl <- build_table(lyt, ex_adsl) @@ -142,9 +245,21 @@ test_that("tt_to_tlgrtf converts table tree to tlg without error", { badtbl <- build_table(badlyt, ex_adsl) - ## this test is largely meaningless because it doesn't get caught - ## when calling tt_to_tlgrtf directly.... + ## Test that an error is issued when validate=TRUE (default behavior) expect_error(tt_to_tbldf(badtbl)) + expect_error(tt_to_tbldf(badtbl, validate = TRUE)) + + ## Test that a message is issued when validate=FALSE + expect_message( + tt_to_tbldf(badtbl, validate = FALSE), + "Invalid table structure detected" + ) + + ## Test that a different message is issued for valid tables when validate=FALSE + expect_message( + tt_to_tbldf(tbl, validate = FALSE), + "Table structure validation succeeded" + ) lyt_pgby <- basic_table() |> split_cols_by("ARM") |> @@ -206,25 +321,25 @@ test_that("tt_to_tlgrtf validates table structure correctly", { badtbl <- build_table(badlyt, ex_adsl) - # Test that a warning is issued when validate=TRUE - expect_warning( + # Test that a message is issued when validate=TRUE + expect_message( tt_to_tlgrtf(badtbl, file = NULL, validate = TRUE), "Invalid table structure detected" ) - # Test that no warning is issued when validate=FALSE - expect_no_warning( + # Test that no message is issued when validate=FALSE + expect_no_message( tt_to_tlgrtf(badtbl, file = NULL, validate = FALSE) ) - # Test that the default behavior (validate=TRUE) issues a warning - expect_warning( + # Test that the default behavior (validate=TRUE) issues a message + expect_message( tt_to_tlgrtf(badtbl, file = NULL), "Invalid table structure detected" ) }) -test_that("tt_to_tlgrtf does not warn for valid table structures", { +test_that("tt_to_tlgrtf does not message for valid table structures with validate=TRUE", { # Create a valid table structure data(ex_adsl) lyt <- basic_table() |> @@ -233,38 +348,31 @@ test_that("tt_to_tlgrtf does not warn for valid table structures", { tbl <- build_table(lyt, ex_adsl) - # Test that no warning is issued for a valid table - expect_no_warning( + # Test that no message is issued for a valid table with validate=TRUE + expect_no_message( tt_to_tlgrtf(tbl, file = NULL, validate = TRUE) ) }) -test_that("tt_to_tlgrtf respects JUNCO_DISABLE_VALIDATION environment variable", { - # Create an invalid table structure +test_that("tt_to_tlgrtf validates valid table structures correctly", { + # Create a valid table structure data(ex_adsl) - badlyt <- basic_table() |> - split_rows_by("ARM") |> - summarize_row_groups() - - badtbl <- build_table(badlyt, ex_adsl) - - # Save current environment variable state - old_env <- Sys.getenv("JUNCO_DISABLE_VALIDATION") + lyt <- basic_table() |> + split_cols_by("ARM") |> + analyze("AGE") - # Set environment variable to disable validation - Sys.setenv(JUNCO_DISABLE_VALIDATION = "TRUE") + tbl <- build_table(lyt, ex_adsl) - # Test that no warning is issued when environment variable is set - expect_no_warning( - tt_to_tlgrtf(badtbl, file = NULL, validate = TRUE) + # Test that a message is issued for valid tables when validate=FALSE + expect_message( + tt_to_tlgrtf(tbl, file = NULL, validate = FALSE), + "Table structure validation succeeded" ) - # Reset environment variable - if (old_env == "") { - Sys.unsetenv("JUNCO_DISABLE_VALIDATION") - } else { - Sys.setenv(JUNCO_DISABLE_VALIDATION = old_env) - } + # Test that no message is issued for valid tables when validate=TRUE + expect_no_message( + tt_to_tlgrtf(tbl, file = NULL, validate = TRUE) + ) }) test_that("more top left than col headers works", { @@ -291,3 +399,71 @@ test_that("more top left than col headers works", { expect_true(file.exists(paste0(tmpfile, ".rtf"))) unlink(tmpfile) }) + +test_that("round_type in tt_to_tbldf works as expected for tabletree object", { + tbl_iec <- tt_to_test_round_type(round_type = "iec") + tbldf <- tt_to_tbldf(tbl_iec) + tbldf_sas <- tt_to_tbldf(tbl_iec, round_type = "sas") + expect_true(any(tbldf != tbldf_sas)) + expect_true(all( + tbldf[, c("col 1", "col 2", "col 3")] == + vals_round_type_fmt( + vals = vals_round_type, + round_type = "iec" + ) + )) + expect_true(all( + tbldf_sas[, c("col 1", "col 2", "col 3")] == + vals_round_type_fmt( + vals = vals_round_type, + round_type = "sas" + ) + )) +}) + +test_that("round_type in tt_to_tlgrtf works as expected for tabletree object", { + tbl_iec <- tt_to_test_round_type(round_type = "iec") + expect_silent(suppressMessages(rtf_sas <- rtf_out_wrapper(tbl_iec, "test4sas", round_type = "sas"))) + expect_snapshot_file(rtf_sas, cran = TRUE) + expect_silent(suppressMessages(rtf_iec_mod <- rtf_out_wrapper(tbl_iec, "test4iecmod", round_type = "iec_mod"))) + expect_snapshot_file(rtf_iec_mod, cran = TRUE) + expect_silent(suppressMessages(rtf_iec <- rtf_out_wrapper(tbl_iec, "test4iec", round_type = "iec"))) + expect_snapshot_file(rtf_iec, cran = TRUE) + + # test actual values for sas rounding + res_nullfl <- expect_silent(tt_to_tlgrtf(tbl_iec, round_type = "sas", file = NULL)) + + vals_from_res_nullfl <- res_nullfl[[1]][[1]] + vals_from_res_nullfl <- unname(unlist(vals_from_res_nullfl[3, 2:4])) + + expect_true(all( + vals_from_res_nullfl == + vals_round_type_fmt( + vals = vals_round_type, + round_type = "sas" + ) + )) +}) + +test_that("round_type in tt_to_tlgrtf works as expected for listing object", { + listdf_iec <- listingdf_to_test_round_type() + list_iec <- listdf_iec$lsting + df <- listdf_iec$df + + res_nullfl_sas <- expect_silent(tt_to_tlgrtf(list_iec, round_type = "sas", file = NULL)) + res_nullfl_iec <- expect_silent(tt_to_tlgrtf(list_iec, round_type = "iec", file = NULL)) + vals_from_res_nullfl_sas <- res_nullfl_sas[[1]][[4]][-c(1:2)] + vals_from_res_nullfl_iec <- res_nullfl_iec[[1]][[4]][-c(1:2)] + + expect_identical( + vals_round_type_fmt(vals = df[["BMRKR1"]], round_type = "sas"), + vals_from_res_nullfl_sas + ) + + expect_identical( + vals_round_type_fmt(vals = df[["BMRKR1"]], round_type = "iec"), + vals_from_res_nullfl_iec + ) + + expect_true(any(vals_from_res_nullfl_iec != vals_from_res_nullfl_sas)) +}) diff --git a/tests/testthat/test-varia.R b/tests/testthat/test-varia.R index 07e23608..48de980a 100644 --- a/tests/testthat/test-varia.R +++ b/tests/testthat/test-varia.R @@ -12,7 +12,7 @@ testthat::test_that("a_freq_j works (old count_unq case)", { top_level_section_div = " ", show_colcounts = TRUE, colcount_format = "N=xx" - ) %>% + ) |> analyze( "TRTEMFL", afun = a_freq_j, @@ -36,7 +36,7 @@ testthat::test_that("a_freq_j works (old count_unq case)", { top_level_section_div = " ", show_colcounts = TRUE, colcount_format = "N=xx" - ) %>% + ) |> analyze( "TRTEMFL", afun = a_freq_j, @@ -58,7 +58,7 @@ testthat::test_that("a_freq_j works (old count_unq case)", { testthat::test_that("a_freq_subcol_j works (old case of cpct_subcol)", { adsl <- ex_adsl - adae <- ex_adae %>% dplyr::select(USUBJID, AEBODSYS, AEDECOD, AREL) + adae <- ex_adae |> dplyr::select(USUBJID, AEBODSYS, AEDECOD, AREL) adae$TRTEMFL <- "Y" adsl$COLSPAN_REL <- "AEs" @@ -87,12 +87,12 @@ testthat::test_that("a_freq_subcol_j works (old case of cpct_subcol)", { top_level_section_div = " ", show_colcounts = TRUE, colcount_format = "N=xx" - ) %>% + ) |> split_cols_by( "COLSPAN_REL", split_fun = add_combo_levels(combodf, trim = TRUE) - ) %>% - split_cols_by("ARM") %>% + ) |> + split_cols_by("ARM") |> analyze( "TRTEMFL", afun = a_freq_subcol_j, @@ -125,7 +125,7 @@ testthat::test_that("a_freq_subcol_j works (old case of cpct_subcol)", { }) testthat::test_that("a_freq_combos_j (old cpct_filter_combos case) works", { - adsl <- ex_adsl %>% + adsl <- ex_adsl |> mutate( months = (EOSDY + 30) / 30.4375, ACAT1 = case_when( @@ -139,16 +139,16 @@ testthat::test_that("a_freq_combos_j (old cpct_filter_combos case) works", { ACAT1, levels = c("Within 3 months", "4 to 12 months", "Beyond 13 months") ) - ) %>% + ) |> select(USUBJID, ARM, EOSDY, ACAT1, months) - adae <- ex_adae %>% dplyr::select(USUBJID, AEBODSYS, AEDECOD, ASTDY, ARM) + adae <- ex_adae |> dplyr::select(USUBJID, AEBODSYS, AEDECOD, ASTDY, ARM) adae$TRTEMFL <- "Y" adae$TRTEMFL <- factor(adae$TRTEMFL) - adae <- adae %>% + adae <- adae |> # ACAT1 derivation - mutate(months = (ASTDY + 30) / 30.4375) %>% + mutate(months = (ASTDY + 30) / 30.4375) |> mutate( ACAT1 = case_when( months <= 3 ~ "Within 3 months", @@ -156,7 +156,7 @@ testthat::test_that("a_freq_combos_j (old cpct_filter_combos case) works", { months > 12 ~ "Beyond 13 months", .default = NA_character_ ) - ) %>% + ) |> mutate( ACAT1 = factor( ACAT1, @@ -167,11 +167,11 @@ testthat::test_that("a_freq_combos_j (old cpct_filter_combos case) works", { NA ) ) - ) %>% - select(-months) %>% + ) |> + select(-months) |> # first occurrence derivation - arrange(USUBJID, ASTDY) %>% - group_by(USUBJID) %>% + arrange(USUBJID, ASTDY) |> + group_by(USUBJID) |> mutate(AOCCFL = case_when(row_number() == 1 ~ "Y")) # This df generates facets for column space : levels from adsl ACAT1 need to be cumulative @@ -211,8 +211,8 @@ testthat::test_that("a_freq_combos_j (old cpct_filter_combos case) works", { "Subjects with >= 1 AE" ) - lyt <- basic_table(top_level_section_div = " ", show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(top_level_section_div = " ", show_colcounts = TRUE) |> + split_cols_by("ARM") |> split_cols_by( "ACAT1", split_fun = add_combo_levels( @@ -220,7 +220,7 @@ testthat::test_that("a_freq_combos_j (old cpct_filter_combos case) works", { trim = FALSE, keep_levels = combodf$valname ) - ) %>% + ) |> analyze( "TRTEMFL", nested = FALSE, @@ -247,20 +247,20 @@ testthat::test_that("a_freq_combos_j (old cpct_filter_combos case) works", { n_denom <- nrow( unique( - adsl %>% + adsl |> filter( ARM == "A: Drug X" & ACAT1 %in% c("4 to 12 months", "Beyond 13 months") - ) %>% + ) |> select(USUBJID) ) ) n_val <- nrow(unique( - adae %>% + adae |> filter( ARM == "A: Drug X" & ACAT1 %in% c("4 to 12 months") & AOCCFL == "Y" - ) %>% + ) |> select(USUBJID) )) @@ -283,7 +283,7 @@ testthat::test_that("`a_freq_j()` works", { adsl$rrisk_header <- "Risk Difference (%) (95% CI)" adsl$rrisk_label <- paste(adsl[["ARM"]], "vs Placebo") - advs <- ex_advs %>% select(USUBJID, PARAMCD, PARAM, AVISIT, ANRIND) + advs <- ex_advs |> select(USUBJID, PARAMCD, PARAM, AVISIT, ANRIND) advs <- dplyr::inner_join(advs, adsl, by = c("USUBJID")) advs <- advs[advs$AVISIT %in% c("BASELINE", "WEEK 1 DAY 8"), ] @@ -291,9 +291,9 @@ testthat::test_that("`a_freq_j()` works", { advs$AVISIT <- factor(as.character(advs$AVISIT)) advs$PARAM <- factor(as.character(advs$PARAM)) - advs <- advs %>% - group_by(ARM, PARAMCD, AVISIT) %>% - arrange(USUBJID) %>% + advs <- advs |> + group_by(ARM, PARAMCD, AVISIT) |> + arrange(USUBJID) |> mutate(id = row_number()) # set ANRIND to missing for first 10 subjects from each arm @@ -311,17 +311,17 @@ testthat::test_that("`a_freq_j()` works", { lyt <- basic_table( show_colcounts = TRUE, colcount_format = "N=xx" - ) %>% - split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) %>% - split_cols_by("ARM") %>% - split_cols_by("rrisk_header", nested = FALSE) %>% + ) |> + split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_cols_by("rrisk_header", nested = FALSE) |> split_cols_by( "ARM", labels_var = "rrisk_label", split_fun = remove_split_levels("B: Placebo") - ) %>% - split_rows_by("PARAM", label_pos = "topleft", section_div = " ") %>% - split_rows_by("AVISIT") %>% + ) |> + split_rows_by("PARAM", label_pos = "topleft", section_div = " ") |> + split_rows_by("AVISIT") |> analyze( "ANRIND", afun = a_freq_j, @@ -340,19 +340,19 @@ testthat::test_that("`a_freq_j()` works", { n_expected <- as.double( table( - advs %>% - ungroup() %>% + advs |> + ungroup() |> filter( PARAM == "Diastolic Blood Pressure" & AVISIT == "WEEK 1 DAY 8" & !is.na(ANRIND) - ) %>% + ) |> mutate( ARM = factor( as.character(ARM), levels = c("A: Drug X", "C: Combination", "B: Placebo") ) - ) %>% + ) |> select(ARM) ) ) @@ -384,10 +384,10 @@ testthat::test_that("a_freq_j works (old count_subject case)", { ) # scenario 1: cfun - subgroup coming from adsl, not df - lyt1 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% - summarize_row_groups("SEX", cfun = a_freq_j, extra_args = extra_args_1) %>% + lyt1 <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> + summarize_row_groups("SEX", cfun = a_freq_j, extra_args = extra_args_1) |> analyze( "TRTEMFL", afun = simple_afun, @@ -405,10 +405,10 @@ testthat::test_that("a_freq_j works (old count_subject case)", { ## 2 cell value : content + n n_1 <- nrow(unique( - adsl %>% filter(ARM == "B: Placebo" & SEX == "F") %>% select(USUBJID) + adsl |> filter(ARM == "B: Placebo" & SEX == "F") |> select(USUBJID) )) n_2 <- nrow(unique( - adae %>% filter(ARM == "B: Placebo" & SEX == "F") %>% select(USUBJID) + adae |> filter(ARM == "B: Placebo" & SEX == "F") |> select(USUBJID) )) expected1 <- c(n_1, n_2) @@ -416,28 +416,27 @@ testthat::test_that("a_freq_j works (old count_subject case)", { testthat::expect_identical(result1, expected1) # scenario 2: shift table for lab/vs - advs <- ex_advs %>% - select(USUBJID, PARAMCD, PARAM, ANRIND, AVAL, BASE, ABLFL, AVISIT) %>% + advs <- ex_advs |> + select(USUBJID, PARAMCD, PARAM, ANRIND, AVAL, BASE, ABLFL, AVISIT) |> filter(PARAMCD == "DIABP" & (AVISIT == "WEEK 1 DAY 8" | ABLFL == "Y")) ### remove subjects from advs, so that N is not same as from adsl advs <- advs[!(advs$USUBJID %in% adsl$USUBJID[1:10]), ] - BNRIND <- advs %>% - filter(ABLFL == "Y") %>% - mutate(BNRIND = ANRIND) %>% + BNRIND <- advs |> + filter(ABLFL == "Y") |> + mutate(BNRIND = ANRIND) |> select(USUBJID, PARAMCD, BNRIND) - advs <- advs %>% - left_join(., BNRIND, by = join_by(USUBJID, PARAMCD)) + advs <- left_join(advs, BNRIND, by = join_by(USUBJID, PARAMCD)) - adsl <- adsl %>% - mutate(BNRIND = "N") %>% + adsl <- adsl |> + mutate(BNRIND = "N") |> mutate(BNRIND = factor(BNRIND, levels = c("N", levels(advs$ANRIND)))) adsl$BNRIND_header <- " " adsl$BNRIND_header2 <- "Baseline NRIND" - advs <- advs %>% + advs <- advs |> mutate( BNRIND = factor( as.character(BNRIND), @@ -445,29 +444,33 @@ testthat::test_that("a_freq_j works (old count_subject case)", { ) ) - advs <- advs %>% - left_join( - ., - adsl %>% select(USUBJID, ARM, BNRIND_header, BNRIND_header2), - by = "USUBJID" - ) %>% + # Create a temporary variable to store the result of the join + advs_joined <- left_join( + advs, + adsl |> select(USUBJID, ARM, BNRIND_header, BNRIND_header2), + by = "USUBJID", + relationship = "many-to-many" + ) + + # Now filter using the temporary variable + advs <- advs_joined |> filter(ABLFL != "Y") ANRIND_levels <- levels(advs$ANRIND) - lyt <- basic_table(show_colcounts = FALSE) %>% + lyt <- basic_table(show_colcounts = FALSE) |> ## to ensure N column is not under the Baseline column span header - split_cols_by("BNRIND_header") %>% - split_cols_by("BNRIND", split_fun = keep_split_levels("N")) %>% - split_cols_by("BNRIND_header2", nested = FALSE) %>% + split_cols_by("BNRIND_header") |> + split_cols_by("BNRIND", split_fun = keep_split_levels("N")) |> + split_cols_by("BNRIND_header2", nested = FALSE) |> split_cols_by( "BNRIND", split_fun = make_split_fun( pre = list(rm_levels(excl = "N")), post = list(add_overall_facet("TOTAL", "Total")) ) - ) %>% - split_rows_by("ARM", child_labels = "hidden") %>% + ) |> + split_rows_by("ARM", child_labels = "hidden") |> # these counts will be checked as result1/expected1 summarize_row_groups( var = "ARM", @@ -479,14 +482,14 @@ testthat::test_that("a_freq_j works (old count_subject case)", { restr_columns = "N", extrablanklineafter = "C: Combination" ) - ) %>% - split_rows_by("PARAM", nested = FALSE, split_fun = drop_split_levels) %>% + ) |> + split_rows_by("PARAM", nested = FALSE, split_fun = drop_split_levels) |> split_rows_by( "ARM", label_pos = "hidden", split_label = "Treatment Group", section_div = " " - ) %>% + ) |> # these counts will be checked as result2/expected2 summarize_row_groups( "ARM", @@ -496,7 +499,7 @@ testthat::test_that("a_freq_j works (old count_subject case)", { .stats = "denom", restr_columns = "N" ) - ) %>% + ) |> # these counts will be checked as result3/expected3 analyze( "ANRIND", @@ -541,10 +544,10 @@ testthat::test_that("a_freq_j works (old count_subject case)", { ) ))) expected2 <- unname(unlist(as.list(table( - advs %>% + advs |> filter( PARAMCD == "DIABP" & AVISIT == "WEEK 1 DAY 8" & ARM == "C: Combination" - ) %>% + ) |> select(ARM) )))["C: Combination"]) @@ -564,10 +567,10 @@ testthat::test_that("a_freq_j works (old count_subject case)", { ) )) expected3 <- table( - advs %>% + advs |> filter( PARAMCD == "DIABP" & AVISIT == "WEEK 1 DAY 8" & ARM == "B: Placebo" - ) %>% + ) |> select(BNRIND, ANRIND) )["NORMAL", "HIGH"] @@ -582,8 +585,8 @@ testthat::test_that("`a_freq_j()` works", { adsl <- ex_adsl adae <- ex_adae - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> analyze( vars = "STUDYID", afun = a_freq_j, @@ -614,8 +617,8 @@ testthat::test_that("a_freq_j works (old a_countpat_newlevels case)", { new_BMRKR2_levels <- list(c("Medium - High"), list(c("MEDIUM", "HIGH"))) - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> ### add extra combined level for BMRKR2 analyze( vars = "BMRKR2", @@ -644,8 +647,8 @@ testthat::test_that("a_freq_j works (old a_countpat_newlevels case)", { testthat::expect_identical(result_label, expected_label) expected_value <- table( - adsl %>% - filter(ARM == "A: Drug X") %>% + adsl |> + filter(ARM == "A: Drug X") |> select(BMRKR2) ) @@ -694,15 +697,15 @@ testthat::test_that("a_summarize_ex_j works", { top_level_section_div = " ", show_colcounts = TRUE, colcount_format = "N=xx" - ) %>% - split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) %>% - split_cols_by("ARM") %>% - split_cols_by("diff_header", nested = FALSE) %>% + ) |> + split_cols_by("colspan_trt", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_cols_by("diff_header", nested = FALSE) |> split_cols_by( "ARM", split_fun = remove_split_levels("B: Placebo"), labels_var = "diff_label" - ) %>% + ) |> analyze( "EOSDY", afun = a_summarize_ex_j, @@ -720,7 +723,7 @@ testthat::test_that("a_summarize_ex_j works", { tbl <- build_table(lyt, adsl) - rps <- make_row_df(tbl) %>% + rps <- make_row_df(tbl) |> filter(node_class == "DataRow") result_1 <- unname(cell_values(tbl[, c( @@ -735,7 +738,7 @@ testthat::test_that("a_summarize_ex_j works", { })) names(result_1[[4]]) <- NULL - xx_1 <- adsl %>% filter(ARM == "C: Combination" & !is.na(EOSDY)) + xx_1 <- adsl |> filter(ARM == "C: Combination" & !is.na(EOSDY)) xx_1. <- xx_1[["EOSDY"]] ## quantiles rather than IQR, label misleading @@ -774,7 +777,7 @@ testthat::test_that("a_summarize_ex_j works", { })) names(result_2[[4]]) <- NULL - xx_2 <- adsl %>% filter(ARM == "B: Placebo" & !is.na(EOSDY)) + xx_2 <- adsl |> filter(ARM == "B: Placebo" & !is.na(EOSDY)) xx_2. <- xx_2[["EOSDY"]] ## quantiles rather than IQR, label misleading @@ -807,7 +810,7 @@ testthat::test_that("a_summarize_ex_j works", { attr(result_3, "label") <- NULL df <- xx_1 - .df_row <- adsl %>% filter(!is.na(EOSDY)) + .df_row <- adsl |> filter(!is.na(EOSDY)) .ref_group <- xx_2 .in_ref_col <- FALSE