diff --git a/DESCRIPTION b/DESCRIPTION index 5a6fe700d7..ca7f70abc5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -105,3 +105,4 @@ Collate: 'tt_from_df.R' 'validate_table_struct.R' 'zzz_constants.R' + 'no_auto_fmt_handler.R' diff --git a/NAMESPACE b/NAMESPACE index 3029658a18..c4bfa8407c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -125,6 +125,7 @@ export(make_col_df) export(make_split_fun) export(make_split_result) export(manual_cols) +export(no_auto_fmt) export(no_colinfo) export(non_ref_rcell) export(obj_avar) @@ -192,6 +193,7 @@ export(trim_rows) export(tt_at_path) export(tt_normalize_row_path) export(tt_row_path_exists) +export(update_afun_no_auto) export(update_ref_indexing) export(validate_table_struct) export(value_at) diff --git a/R/colby_constructors.R b/R/colby_constructors.R index 9ee82134f9..e02ce192e1 100644 --- a/R/colby_constructors.R +++ b/R/colby_constructors.R @@ -1159,6 +1159,19 @@ analyze <- function(lyt, defrowlab <- var_labels } + if (!is.null(extra_args[[".stats"]]) && !is.null(extra_args[[".formats"]]) && + inherits(extra_args[[".formats"]], "no_auto_fmt")) { + # this will be applied + no_auto_fmt <- no_auto_fmt_handler( + extra_args, + format, + afun, + vars + ) + format <- no_auto_fmt$format + afun <- no_auto_fmt$afun + } + spl <- AnalyzeMultiVars(vars, var_labels, afun = afun, split_format = format, diff --git a/R/no_auto_fmt_handler.R b/R/no_auto_fmt_handler.R new file mode 100644 index 0000000000..972a145e41 --- /dev/null +++ b/R/no_auto_fmt_handler.R @@ -0,0 +1,323 @@ +#' analyze no auto formatting feature +#' +#' These are internal methods for no auto formatting handling with the analyze function.\cr +#' End users can find more details on how to use the `no auto formatting feature` in vignette .... +#' +#' @name no_auto_fmt +#' @rdname no_auto_fmt +#' @return Various, but not described here. +NULL + +#' @order 1 +#' @rdname no_auto_fmt +#' @export +no_auto_fmt <- structure(list(), class = "no_auto_fmt") + +#' @inheritParams gen_args +#' @inheritParams lyt_args +#' @order 5 +#' @keywords internal +#' @rdname no_auto_fmt +#' +#' +no_auto_fmt_handler <- function(extra_args, + format, + afun, + vars) { + .stats <- extra_args[[".stats"]] + fmt_spec_type <- format_spec_type(format) + + # perform some basic checks on format + format_spec_check(format, .stats, vars) + + if ((fmt_spec_type %in% c("format spec", "format variable name"))) { + if (fmt_spec_type == "format spec") { + # restrict format to requested stats only + format <- format[.stats] + } + # both calling afun and .formats will be updated -- in each split facet based upon spl_context + afun <- update_afun_no_auto(format = format, afun = afun, method = "format_from_splcontext") + } else if (fmt_spec_type == "list analysis variable name") { + # both calling afun and .formats will be updated -- in each split facet based upon vars + afun <- update_afun_no_auto(format = format, afun = afun, method = "format_from_var") + } + + # updated afun and format are key for further processing + return( + list( + afun = afun, + format = format + ) + ) +} + + +### look into match_extra_args in tt_dotabulation +# taken from tern +extra_afun_params <- list( + .N_col = integer(), + .N_total = integer(), + .N_row = integer(), + .df_row = data.frame(), + .var = character(), + .ref_group = character(), + .ref_full = vector(mode = "numeric"), + .in_ref_col = logical(), + .spl_context = data.frame(), + .all_col_exprs = vector(mode = "expression"), + .all_col_counts = vector(mode = "integer") +) + + + +#' @param extra_afun_params (`list`)\cr list of additional parameters (`character`) to be +#' retrieved from the environment. Curated list is present in [rtables::additional_fun_params]. +#' @rdname no_auto_fmt +#' @order 4 +#' @keywords internal + +# taken from tern - except from restricting to non-symbolics only +# this is to cover cases where .ref_group is not defined, then it is a symbolic + +retrieve_extra_afun_params <- function(extra_afun_params) { + envir <- parent.frame() + symbolics <- sapply(extra_afun_params, function(x) { + typeof(envir[[x]]) %in% c("language", "symbol") + }) + extra_afun_params <- extra_afun_params[!symbolics] + + out <- list() + for (extra_param in extra_afun_params) { + out <- c(out, list(get(extra_param, envir = envir))) + } + + setNames(out, extra_afun_params) +} + +#' @inheritParams gen_args +#' @inheritParams lyt_args +#' @order 1 +#' @keywords internal +#' @rdname no_auto_fmt +#' +afun_ext_add_fun_params <- function(afun) { + extended_func <- afun + if (".spl_context" %in% names(formals(afun))) { + # cat("no update to afun in step afun_ext_add_fun_params") + extended_func <- afun + } else { + # cat("afun is updated in step afun_ext_add_fun_params") + formals(extended_func) <- c(formals(afun), extra_afun_params) + } + # return this function + extended_func +} + + + +#' @inheritParams gen_args +#' @inheritParams lyt_args +#' @order 3 +#' @rdname no_auto_fmt +#' @keywords internal +#' +upd_fmt_args <- function(args, .spl_context = NULL, .var = NULL, format) { + if (is.null(.spl_context) && is.null(.var)) { + stop("upd_fmt_args error: .spl_context and .var cannot both be NULL.") + } + if (!is.null(.spl_context)) { + #### this is the piece for getting format from variable on .spl_context + parent_df <- .spl_context$full_parent_df[[NROW(.spl_context)]] + } + + fmt_spec_type <- format_spec_type(format) + + if (fmt_spec_type == "format spec") { + # Method 1: take .formats from format + args[[".formats"]] <- format + } else if (fmt_spec_type == "format variable name") { + # Method 2: take .formats from spl_context format spec -- variable + # first check this variable is indeed present on input dataframe + # this check could not yet be covered in format_spec_check - need to be done inside facet + if (!(format %in% names(parent_df))) { + stop(paste0("format variable (", format, ") not present in input dataframe")) + } + args[[".formats"]] <- unlist(unique(parent_df[[format]])) + } else if (fmt_spec_type == "list analysis variable name") { + if (!.var %in% names(format) && "default" %in% names(format)) .var <- "default" + # Method 3: take .formats from format input + args[[".formats"]] <- unlist(unname(format[.var])) + } + + return(args) +} + + +#' @inheritParams gen_args +#' @inheritParams lyt_args +#' @order 2 +#' @rdname no_auto_fmt +#' @param method (`character`)\cr method to be used for retrieving formatting specifications. +#' +#' Options are: `format_from_splcontext` and `format_from_var`. +#' +#' @export +update_afun_no_auto <- function(format = NULL, + afun, + method = c("format_from_splcontext", "format_from_var")) { + method <- match.arg(method) + + # update afun (only in some cases) + updated_afun1 <- afun_ext_add_fun_params(afun) + # note that function updated_afun1 will be used in the call inside corepartall + + # corepartall body code to avoid using the same code in 2 blocks + # this part of code deals with updating .formats in each facet + corepartall <- quote({ + .additional_fun_parameters <- retrieve_extra_afun_params(names(extra_afun_params)) + + # Get original arguments --- critical here is envir parent.frame(3) + first_arg <- get("dat", envir = parent.frame(3)) + + # .additional_fun_parameters is passed twice in order to work with tern functions + # this is in order to properly execute following step in tern afuns + # extra_afun_params <- retrieve_extra_afun_params( + # names(dots_extra_args$.additional_fun_parameters) + # ) + args <- c( + list(first_arg, ..., ".additional_fun_parameters" = .additional_fun_parameters), + .additional_fun_parameters + ) + + # update of .formats : appropriate method passed to upd_fmt_args + # the approriate method is passed in no_auto_fmt_handler + if (method == "format_from_splcontext") { + args <- upd_fmt_args(args, .spl_context = .spl_context, format = format) + } else if (method == "format_from_var") { + args <- upd_fmt_args(args, .var = .var, format = format) + } + + # Call original function with updated args + result <- do.call(updated_afun1, args) + result + }) + + if (.takes_df(afun)) { + # first argument is df + updated_afun <- function(df, ..., + .N_col, + .N_total, + .N_row, + .df_row, + .var, + .ref_group, + .ref_full, + .in_ref_col, + .spl_context, + .all_col_exprs, + .all_col_counts) { + # cat("afun update for input df\n") + eval(corepartall) + } + } else { + # first arg is x + updated_afun <- function(x, ..., + .N_col, + .N_total, + .N_row, + .df_row, + .var, + .ref_group, + .ref_full, + .in_ref_col, + .spl_context, + .all_col_exprs, + .all_col_counts) { + # cat("afun update for input x\n") + eval(corepartall) + } + } + # return this function + return(updated_afun) +} + + +format_spec_type <- function(format) { + if (is.null(format)) { + type <- "null" + } else if (length(format) == 1 && is.null(names(format))) { + type <- "format variable name" + } else if (!is.list(format) || is.list(format) && any(sapply(format, is.function))) { + type <- "format spec" + } else if (is.list(format)) { + type <- "list analysis variable name" + } else { + stop("format_spec_type issue: inproper format input") + } + return(type) +} + + +format_spec_check <- function(format, .stats, vars) { + fmt_spec_type <- format_spec_type(format) + + # perform some basic checks on format + if (fmt_spec_type == "null") { + # no check needed + } else if (fmt_spec_type == "format variable name") { + # check will be done later in facet - variable name present on input df + } else if (fmt_spec_type == "format spec") { + # 1. check that all stats have a format + misstats <- .stats[!(.stats %in% names(format))] + if (length(misstats) > 0) { + stop(paste("Following .stats have no format specification: ", paste(misstats, collapse = ", "))) + } + # 2. check that all formats are valid (or function) + format <- format[.stats] + cond <- sapply(format, is_valid_format) + invalid <- unique(unlist(format[!cond])) + if (length(invalid) > 0) { + stop(paste("Following format specifications are invalid: ", paste(invalid, collapse = "; "))) + } + } else if (fmt_spec_type == "list analysis variable name") { + # 0. format is a named list (names are the variable names from vars) + if (is.null(names(format))) { + stop("when format is a list it should be a named list") + } + # 1. check that all vars have a specification + misvars <- vars[!(vars %in% names(format))] + if (!("default" %in% names(format)) && length(misvars) > 0) { + stop(paste("Following vars have no format specification: ", paste(misvars, collapse = ", "))) + } + # 2. check that for each var all stats have a format + misstats2 <- sapply(names(format), + function(x) { + y <- format[[x]] + misstats <- .stats[!(.stats %in% names(y))] + misstats + }, + simplify = FALSE, USE.NAMES = TRUE + ) + misstats2 <- unique(unlist(misstats2)) + if (length(misstats2) > 0) { + stop(paste("Following stats have no format specification for at least one variable: ", paste(misstats2, collapse = ", "))) + } + + # 3. check that for each var all formats are valid (or function) + invalid2 <- sapply( + names(format), + function(x) { + y <- format[[x]] + ret <- sapply(y, is_valid_format) + invalid <- format[!ret] + invalid + } + ) + + invalid2 <- unique(unlist(invalid2)) + if (length(invalid2) > 0) { + stop(paste("Following format specifications are invalid: ", paste(invalid2, collapse = "; "))) + } + return(NULL) + } +} diff --git a/man/brackets.Rd b/man/brackets.Rd index d550fa3248..9aa038973b 100644 --- a/man/brackets.Rd +++ b/man/brackets.Rd @@ -3,12 +3,12 @@ \name{brackets} \alias{brackets} \alias{[<-,VTableTree,ANY,ANY,list-method} -\alias{[,VTableTree,logical,logical-method} +\alias{[,VTableTree,logical,logical,ANY-method} \title{Retrieve and assign elements of a \code{TableTree}} \usage{ \S4method{[}{VTableTree,ANY,ANY,list}(x, i, j, ...) <- value -\S4method{[}{VTableTree,logical,logical}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,logical,logical,ANY}(x, i, j, ..., drop = FALSE) } \arguments{ \item{x}{(\code{TableTree})\cr a \code{TableTree} object.} diff --git a/man/int_methods.Rd b/man/int_methods.Rd index e19c04cbfd..85ef507cfe 100644 --- a/man/int_methods.Rd +++ b/man/int_methods.Rd @@ -366,17 +366,17 @@ \alias{tt_at_path<-,VTableTree,ANY,NULL-method} \alias{tt_at_path<-,VTableTree,ANY,TableRow-method} \alias{[<-,VTableTree,ANY,ANY,CellValue-method} -\alias{[,VTableTree,logical,ANY-method} -\alias{[,VTableTree,logical,missing-method} -\alias{[,VTableTree,ANY,logical-method} -\alias{[,VTableTree,ANY,missing-method} -\alias{[,VTableTree,missing,ANY-method} -\alias{[,VTableTree,ANY,character-method} -\alias{[,VTableTree,character,ANY-method} -\alias{[,VTableTree,character,missing-method} -\alias{[,VTableTree,character,character-method} -\alias{[,VTableTree,missing,numeric-method} -\alias{[,VTableTree,numeric,numeric-method} +\alias{[,VTableTree,logical,ANY,ANY-method} +\alias{[,VTableTree,logical,missing,ANY-method} +\alias{[,VTableTree,ANY,logical,ANY-method} +\alias{[,VTableTree,ANY,missing,ANY-method} +\alias{[,VTableTree,missing,ANY,ANY-method} +\alias{[,VTableTree,ANY,character,ANY-method} +\alias{[,VTableTree,character,ANY,ANY-method} +\alias{[,VTableTree,character,missing,ANY-method} +\alias{[,VTableTree,character,character,ANY-method} +\alias{[,VTableTree,missing,numeric,ANY-method} +\alias{[,VTableTree,numeric,numeric,ANY-method} \alias{cell_values,VTableTree-method} \alias{cell_values,TableRow-method} \alias{cell_values,LabelRow-method} @@ -1158,27 +1158,27 @@ obj_stat_names(obj) <- value \S4method{[}{VTableTree,ANY,ANY,CellValue}(x, i, j, ...) <- value -\S4method{[}{VTableTree,logical,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,logical,ANY,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,logical,missing}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,logical,missing,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,ANY,logical}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,ANY,logical,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,ANY,missing}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,ANY,missing,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,missing,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,missing,ANY,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,ANY,character}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,ANY,character,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,character,ANY}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,character,ANY,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,character,missing}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,character,missing,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,character,character}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,character,character,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,missing,numeric}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,missing,numeric,ANY}(x, i, j, ..., drop = FALSE) -\S4method{[}{VTableTree,numeric,numeric}(x, i, j, ..., drop = FALSE) +\S4method{[}{VTableTree,numeric,numeric,ANY}(x, i, j, ..., drop = FALSE) \S4method{cell_values}{VTableTree}(tt, rowpath = NULL, colpath = NULL, omit_labrows = TRUE) diff --git a/man/no_auto_fmt.Rd b/man/no_auto_fmt.Rd new file mode 100644 index 0000000000..28ff7cc11e --- /dev/null +++ b/man/no_auto_fmt.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/no_auto_fmt_handler.R +\docType{data} +\name{no_auto_fmt} +\alias{no_auto_fmt} +\alias{afun_ext_add_fun_params} +\alias{update_afun_no_auto} +\alias{upd_fmt_args} +\alias{retrieve_extra_afun_params} +\alias{no_auto_fmt_handler} +\title{analyze no auto formatting feature} +\format{ +An object of class \code{no_auto_fmt} of length 0. +} +\usage{ +no_auto_fmt + +afun_ext_add_fun_params(afun) + +update_afun_no_auto( + format = NULL, + afun, + method = c("format_from_splcontext", "format_from_var") +) + +upd_fmt_args(args, .spl_context = NULL, .var = NULL, format) + +retrieve_extra_afun_params(extra_afun_params) + +no_auto_fmt_handler(extra_args, format, afun, vars) +} +\arguments{ +\item{afun}{(\code{function})\cr analysis function. Must accept \code{x} or \code{df} as its first parameter. Can optionally take +other parameters which will be populated by the tabulation framework. See Details in \code{\link[=analyze]{analyze()}}.} + +\item{format}{(\code{string}, \code{function}, or \code{list})\cr format associated with this split. Formats can be declared via +strings (\code{"xx.x"}) or function. In cases such as \code{analyze} calls, they can be character vectors or lists of +functions. See \code{\link[formatters:list_formats]{formatters::list_valid_format_labels()}} for a list of all available format strings.} + +\item{method}{(\code{character})\cr method to be used for retrieving formatting specifications. + +Options are: \code{format_from_splcontext} and \code{format_from_var}.} + +\item{.var}{(\code{string})\cr variable name.} + +\item{extra_afun_params}{(\code{list})\cr list of additional parameters (\code{character}) to be +retrieved from the environment. Curated list is present in \link{additional_fun_params}.} + +\item{extra_args}{(\code{list})\cr extra arguments to be passed to the tabulation function. Element position in the list +corresponds to the children of this split. Named elements in the child-specific lists are ignored if they do +not match a formal argument of the tabulation function.} + +\item{vars}{(\code{character})\cr vector of variable names.} +} +\value{ +Various, but not described here. +} +\description{ +These are internal methods for no auto formatting handling with the analyze function.\cr +End users can find more details on how to use the \verb{no auto formatting feature} in vignette .... +} +\keyword{datasets} +\keyword{internal} diff --git a/vignettes/no_auto_fmt.Rmd b/vignettes/no_auto_fmt.Rmd new file mode 100644 index 0000000000..be0278162b --- /dev/null +++ b/vignettes/no_auto_fmt.Rmd @@ -0,0 +1,532 @@ +--- +title: "Disabling auto formatting feature for afuns in analyze setup" +author: "Gabriel Becker and Ilse Augustyns" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Disabling auto formatting feature for afuns in analyze setup} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + chunk_output_type: console +--- + + + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +```{css, echo=FALSE} + +.sourcecode { + background-color:lightblue; +} +.reveal .r code { + white-space: pre; +} +``` +## Note +This vignette is based upon a version of `rtables` and `tern` that is not yet released. See here installation instructions for both packages. + +```{r, echo=FALSE, eval=FALSE} +devtools::install_github(repo = "iaugusty/rtables", ref = "no_auto_fmt_alternative", force = TRUE, upgrade = "never") +devtools::install_github(repo = "iaugusty/tern", ref = "no_auto_fmt_alternative", force = TRUE, upgrade = "never") + +``` + +## Setup + +In the below we perform some setup to be utilized in the remainder of the vignette. + +```{r, message=FALSE} +library(rtables) +library(tern) +library(dplyr) + +ex_advs2a <- ex_advs %>% + filter(PARAMCD %in% c("DIABP", "PULSE")) %>% + select(ARMCD, PARAMCD, AVAL,SEX) + +format_set1 <- c(n = "xx", dumb = "xx.x", mean = "xx.xxx", range = "xx.xx - xx.xx", count_fraction = "xx (xx.xx%)") +format_set2 <- c(n = "xx", dumb = "xx.x", mean = "xx.xxx", range = "xx.xx - xx.xx", count_fraction = junco::jjcsformat_count_fraction) + + + +``` + + + +## Introduction: Need for varying format specifications per facet + +Here we describe 2 basic scenarios that we often encounter, where we would like to easily control the behavior of the format specifications per different facet. + +The first situation where we’d like to update the formats according to facet we are in is demonstrated with the following example. +We have a table with different parameters (here `DIABP` and `PULSE`), in which we like the formatting specifications being different for these 2 parameters. + +In the below layout, we only can specify a fixed formatting, ie the same `.formats` is being applied to all facet splits within the table. + +Our goal is to avoid the need for rewriting afuns that can deal with adjusting formats according to which split you are in. + + +```{r} +lyt1 <- basic_table() %>% + split_cols_by("ARMCD") %>% + split_rows_by("PARAMCD", split_fun = drop_split_levels) %>% + analyze( + vars = "AVAL", + afun = a_summary, + extra_args = list( + .stats = c("n", "mean", "range"), + .formats = c(n = "xx", mean = "xx.xx", range = "xx.xx - xx.xx") + ) + + ) + +tbl1 <- build_table(lyt1, ex_advs2a, ex_adsl) +tbl1 +``` +Another common situation where we’d like to update the formats according to facet we are in is described with the following example. + +We have a table with different variables being analyzed (here `AGE`, `BMRKR1`, `STRATA1`, `EOSDY`), in which we like the formatting specifications being different for these 4 variables. + +In the below layout, at least with one call to `analyze`, we only can specify a fixed formatting, ie the same `.formats` is being applied to all facet splits (here variables) within the table. + + +```{r, message=FALSE} +lyt2 <- basic_table() %>% + split_cols_by("ARMCD") %>% + analyze( + vars = c("AGE", "BMRKR1", "STRATA1", "EOSDY"), + afun = a_summary, + extra_args = list( + .stats = c("n", "mean", "range", "count_fraction"), + .formats = format_set1 + ) + ) + +tbl2 <- build_table(lyt2, ex_adsl) +tbl2 +``` + +For this table, there is obviously the option to construct the table with 4 different calls to `analyze`, and in each call the desired `.format` argument is specified. + +Our goal is to avoid the need for calling `analyze` for each variable separately or rewriting afuns that can deal with adjusting formats according to which split you are in. + +Note that above 2 layout definitions make use of `tern` `afun` `a_summary`. A note on this later. + +## new feature to analyze function to turn off auto formatting + +As a solution to the above problem, a new `rtables` feature, called `no_auto_fmt`, has been introduced. + +This `no_auto_fmt` approach can be applied to afuns that take the arguments `.formats` and `.stats` to specify statistics and formats to control formatting of requested statistics. + +All `tern` afuns are written in this way. In addition to that, the argument `.formats`, when incomplete or `NULL`, is being updated inside the afun to always end up with formatting specification passed onto an `in_rows` call. This is what we refer to as `auto_fmt` or auto formatting handling. + +The goal of this new feature is to be able to turn off this automated formatting handling when calling these afuns. + +The idea is that, when `.formats` = `no_auto_fmt`, the automatic updating is turned off, and the `format` argument from `analyze` can be used to control the formats of the requested statistics. + + +Let's start with the following simple table, a simplified version of the second scenario. +Note that in below layout definition the `.format` argument is not specified, implying `tern` auto formatting feature is still on. +In this case, the `analyze` `format` argument is ignored. +```{r, message=FALSE} + +lyt2x <- basic_table() %>% + split_cols_by("ARMCD") %>% + analyze( + vars = "AGE", + afun = a_summary, + extra_args = list( + .stats = c("n", "mean", "range") + ), + format = format_set2 + ) + +tbl2x <- build_table(lyt2x, ex_adsl) +tbl2x + +``` + +For purpose of comparison with a later table, the same table is regenerated with a user defined `.formats` argument. +Again, the `format` argument to `analyze` is being ignored. + +```{r, message=FALSE} + +lyt2a <- basic_table() %>% + split_cols_by("ARMCD") %>% + analyze( + vars = "AGE", + afun = a_summary, + extra_args = list( + .stats = c("n", "mean", "range"), + .formats = format_set1 + ), + format = format_set2 + ) + +tbl2a <- build_table(lyt2a, ex_adsl) +tbl2a + +``` + +### Simply turning off auto formatting feature, showing raw values + +In the below example, as a first step the formatting from within `afun` is turned off, which is done by setting `.formats` = `no_auto_fmt`. +As `format` = `NULL`, no formatting will be applied, and raw values are being presented. +This is not yet how users would apply the new features, it is just to demonstrate the steps in the process. + +```{r, message=FALSE} +lyt2b <- basic_table() %>% + split_cols_by("ARMCD") %>% + analyze( + vars = "AGE", + afun = a_summary, + extra_args = list( + .stats = c("n", "mean", "range"), + .formats = no_auto_fmt + ), + format = NULL + ) + +tbl2b <- build_table(lyt2b, ex_adsl) +tbl2b +``` + +### Turning off auto formatting feature, with format argument to show formatted values, but not yet per facet + +In the below example, as a second step in the process, note the `format` argument to `analyze` is now a regular format specification, which is used in the table creation. +The current example is not yet how users would apply the new features either, as the outcome is still the same as the original situation with `.formats` = format_set1 (see earlier example). + +```{r, message=FALSE} +lyt2c <- basic_table() %>% + split_cols_by("ARMCD") %>% + analyze( + vars = "AGE", + afun = a_summary, + extra_args = list( + .stats = c("n", "mean", "range"), + .formats = no_auto_fmt + ), + format = format_set1 + ) + +tbl2c <- build_table(lyt2c, ex_adsl) +tbl2c + + +identical(get_formatted_cells(tbl2a), get_formatted_cells(tbl2c)) +``` + + +### Turning off auto formatting feature, with format argument to show formatted values different formats accross facets +#### tern function a_summary + +As a final step in the process towards our goal of different formats across different facets, look at the following layout specification. + +First take a look at the following `format_list` specification. +`format_list` is a list specification setup for specific variables (and an extra `default` to cover unspecified variables). + +```{r} +format_list <- list( + "AGE" = c(n = "xx", mean = "xx.x", range = "xx - xx", dumb = "xx.x", "count_fraction" = "xx (xx.xx%)"), + "BMRKR1" = c(n = "xx", mean = "xx.xxxx", range = "xx.xx - xx.xx", dumb = "xx.x", "count_fraction" = "xx (xx.xx%)"), + "default" = c(n = "xx", mean = "xx.xx", range = "xx.xx - xx.xx", "count_fraction" = "xx (xx.xx%)") +) + +format_list +``` + +Now take a look at the beow layout, which uses `analyze`, `afun` = `a_summary`, `.formats` = `no_auto_fmt` and format = `format_list`. + +This example fulfills our need to be able to have easy approach for providing variable specific formatting specifications to analyze multiple variables together, see initial version `lyt2` as the starting point. + +```{r} +lyt2d <- basic_table() %>% + split_cols_by("ARMCD") %>% + analyze( + vars = c("AGE", "SEX", "BMRKR1", "STRATA1", "EOSDY"), + afun = a_summary, + extra_args = list( + .stats = c("n", "mean", "range", "count_fraction"), + .formats = no_auto_fmt), + format = format_list + ) + +tbl2d <- build_table(lyt2d, ex_adsl) +tbl2d +``` +As you can see in the above output, we succeeded in our goal to have different formats for each of the different variables presented in the table. + +Now we continue with the first layout goal: facets in the table coming from multiple parameters rather than multiple variables (see `lyt1` as the starting point). + + +```{r, message=FALSE} + +ex_advs2 <- ex_advs2a %>% + mutate(fmt_col = case_when( + PARAMCD == "DIABP" ~ list(c(n = "xx", dumb = "xx.x", mean = "xx.xx", range = "xx.x - xx.x", lsmean = "xx.xx")), + PARAMCD == "PULSE" ~ list(c(n = "xx", dumb = "xx.x", mean = "xx.xxx", range = "xx.xx - xx.xx", lsmean = "xx.xxx")) + )) + + + +``` + +As part of the process to specify formats per `PARAMCD`, we have extended the input dataframe with a column `fmt_col`, in which the formatting specifications are provided per `PARAMCD`. +For `PARAMCD` = `DIABP`, the specifications are to present mean with 2 decimals, while for `PARAMCD` = `PULSE`, the specifications are to present mean with 3 decimals. + + + +```{r, message=FALSE} + + fmt_spec <- unique(ex_advs2 %>% + select(PARAMCD, fmt_col)) + fmt_spec + fmt_spec[["fmt_col"]] + +``` +Similar as before, turning off the tern auto formatting is done by `.formats` = `no_auto_fmt` and the parameter dependent formatting specifications are handled by `analyze` argument `format` = "fmt_col". + +```{r, message=FALSE} + +lyt1a <- basic_table() %>% + split_cols_by("ARMCD") %>% + split_rows_by("PARAMCD", split_fun = drop_split_levels) %>% + analyze( + vars = "AVAL", + afun = a_summary, + extra_args = list( + .stats = c("n", "mean", "range"), + .formats = no_auto_fmt + ), + format = "fmt_col" + ) + +tbl1a <- build_table(lyt1a, ex_advs2, ex_adsl) +tbl1a +``` + +The same code, but without `.formats` = `no_auto_fmt` and providing `format` = "fmt_col" to `analyze` call, still would result in the original `tern` behaviour, ie fixed formats for all `PARAMCD`. + +```{r, message=FALSE} +lyt1b <- basic_table() %>% + split_cols_by("ARMCD") %>% + split_rows_by("PARAMCD", split_fun = drop_split_levels) %>% + analyze( + vars = "AVAL", + afun = a_summary, + extra_args = list( + .stats = c("n", "mean", "range") + ), + format = "fmt_col" + ) + +tbl1b <- build_table(lyt1b, ex_advs2, ex_adsl) +tbl1b +``` + +#### other tern functions eg a_ancova +In the above examples we have discussed so far, we were using the `tern` `afun` `a_summary`. +Note that not all `tern` afuns can be used in `analyze` call, see a short explanation on this later in this vignette. + +As a general rule, instead, the **analyze functions** need to be used. +The **analyze function** associated with `a_summary` is `analyze_vars`. +Another `tern` **analyze function** is `summarize_ancova`, which is based upon the `afun` `tern:::a_ancova`. +See list of `tern` **analyze functions** [here](https://insightsengineering.github.io/tern/latest-tag/reference/analyze_functions.html). + +Here we demonstrate, that the `no_auto_fmt` approach can be utilized for these analyze functions. +Again, the `tern` auto formatting is turned off by `.formats` argument, and the formatting is taken from the `format` argument to `analyze`. + +```{r, message=FALSE} +lyt5a <- basic_table() %>% + split_cols_by("ARMCD", ref_group = "ARM A") %>% + split_rows_by("PARAMCD", split_fun = drop_split_levels) %>% + analyze_vars( + vars = "AVAL", + table_names = "table 1", + var_labels = "Analyze_vars", + conf_level = 0.95, + .stats = c("n", "mean"), + .formats = no_auto_fmt, + format = "fmt_col" + ) %>% + summarize_ancova( + vars = "AVAL", + table_names = "table 2", + variables = list(arm = "ARMCD", covariates = "SEX"), + var_labels = "summarize_ancova", + conf_level = 0.95, + .stats = c("n", "lsmean"), + .formats = no_auto_fmt, + format = "fmt_col" + ) + +tbl5a <- build_table(lyt5a, ex_advs2, ex_adsl) +tbl5a +``` + +Similar as before, when the `tern` auto formatting is not turned off by `.formats` argument, the `format` argument to `analyze` is being ignored. + +```{r, message=FALSE} + +lyt5b <- basic_table() %>% + split_cols_by("ARMCD", ref_group = "ARM A") %>% + split_rows_by("PARAMCD", split_fun = drop_split_levels) %>% + analyze_vars( + vars = "AVAL", + table_names = "table 1", + var_labels = "Analyze_vars", + conf_level = 0.95, + .stats = c("n", "mean"), + format = "fmt_col" + ) %>% + summarize_ancova( + vars = "AVAL", + table_names = "table 2", + variables = list(arm = "ARMCD", covariates = "SEX"), + var_labels = "summarize_ancova", + conf_level = 0.95, + .stats = c("n", "lsmean"), + format = "fmt_col" + ) + +tbl5b <- build_table(lyt5b, ex_advs2, ex_adsl) +tbl5b +``` + + + + +#### a note on using tern afuns directly in analyze call +As noted before in the above examples we have switched to using `tern` analyze functions (`summarize_vars` and `summarize_ancova`), not afuns. + + +Here we demonstrate that also the `tern` afuns can be utilized directly in `analyze` calls, when utilizing the `no_auto_fmt` feature. + +We start again with the basic `a_summary` `afun` in one call and the `tern:::a_ancova` function in another `analyze` call. +Note the usage of `.formats` = `no_auto_fmt` in both calls. + +```{r, message=FALSE} +lyt6a <- basic_table() %>% + split_cols_by("ARMCD", ref_group = "ARM A") %>% + split_rows_by("PARAMCD", split_fun = drop_split_levels) %>% + analyze( + vars = "AVAL", + afun = a_summary, + table_names = "SUMMARY", + var_labels = "My label- summary", + extra_args = list( + .stats = c("n", "mean", "range"), + .formats = no_auto_fmt + ), + format = "fmt_col" + ) %>% + analyze( + vars = "AVAL", + afun = tern:::a_ancova, + table_names = "ANCOVA", + var_labels = "My label- ANCOVA", + extra_args = list( + variables = list(arm = "ARMCD", covariates = "SEX"), + conf_level = 0.95, + .stats = c("n", "lsmean"), + .formats = no_auto_fmt + ), + format = "fmt_col") + +tbl6a <- build_table(lyt6a, ex_advs2, ex_adsl) +tbl6a +``` + +Note that it is not possible to not disabling auto formatting and using an `analyze` call with a `tern` `afun` directly, unless the `afun` takes `x` as the first argument (like `a_summary` does). + +The below code (the part to `afun` = `tern:::a_ancova`) does not run and yields the following error : + +`Error: Error applying analysis function (var - AVAL): argument ".var" is missing, with no default` + +```{r, message=FALSE, eval = FALSE} +lyt6b <- basic_table() %>% + split_cols_by("ARMCD", ref_group = "ARM A") %>% + split_rows_by("PARAMCD", split_fun = drop_split_levels) %>% + analyze( + vars = "AVAL", + afun = a_summary, + table_names = "SUMMARY", + var_labels = "My label- summary", + extra_args = list( + .stats = c("n", "mean", "range") + ) + ) %>% + analyze( + vars = "AVAL", + afun = tern:::a_ancova, + table_names = "ANCOVA", + var_labels = "My label- ANCOVA", + extra_args = list( + variables = list(arm = "ARMCD", covariates = "SEX"), + conf_level = 0.95, + .stats = c("n", "lsmean") + )) + +tbl6b <- build_table(lyt6b, ex_advs2, ex_adsl) +tbl6b +``` + + +A solution to that is to apply the new `update_afun_no_auto` function to the underlying `tern` `afun`, and to utilize that updated function in the `analyze` call. + + +```{r, message=FALSE, eval=TRUE} +myafun <- update_afun_no_auto(afun = tern:::a_ancova) + + +lyt6c <- basic_table() %>% + split_cols_by("ARMCD", ref_group = "ARM A") %>% + split_rows_by("PARAMCD", split_fun = drop_split_levels) %>% + analyze( + vars = "AVAL", + afun = a_summary, + table_names = "SUMMARY", + var_labels = "My label- summary", + extra_args = list( + .stats = c("n", "mean", "range") + ) + ) %>% + analyze( + vars = "AVAL", + afun = myafun, + table_names = "ANCOVA", + var_labels = "My label- ANCOVA", + extra_args = list( + variables = list(arm = "ARMCD", covariates = "SEX"), + conf_level = 0.95, + .stats = c("n", "lsmean") + )) + +tbl6c <- build_table(lyt6c, ex_advs2, ex_adsl) +tbl6c + +``` + +#### background for tern afuns + +As indicated earlier, it is not possible to directly utilize `tern` afuns that take `df` as the first argument inside an `analyze` call. + +The reason for this is how the afuns are being defined. The specialized arguments (see `?additional_fun_params`) are not named in formals, and go anonymously into `...` instead. Due to this reason, the splitting machinery cannnot be directly applied to these afuns. + +Inside the corresponding **analyze function** (eg `summarize_ancova` corresponds to afun `tern:::a_ancova`), the underlying `afun` is updated in order to retrieve the facet values for these specialized arguments. + +A similar technique has been used in the current solution of `no_auto_fmt`. + +This technique has an impact on debugging methods. See next section. + + + + + + + + +