From 281cc1a7287687cf3acac853fbd940dd3c4621fc Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 15 Dec 2022 14:48:11 -0500 Subject: [PATCH 001/110] Add function to create `blockData` object --- R/blockData.R | 237 ++++++++++++++++++++++++++++++++++++++++++++ man/table_blocks.Rd | 64 ++++++++++++ 2 files changed, 301 insertions(+) create mode 100644 R/blockData.R create mode 100644 man/table_blocks.Rd diff --git a/R/blockData.R b/R/blockData.R new file mode 100644 index 00000000..5fc8d117 --- /dev/null +++ b/R/blockData.R @@ -0,0 +1,237 @@ +#' import R6 +table_blocks <- + R6::R6Class("table_blocks", + list( + datalist = NULL, + all_rows = NULL, + blocks = dplyr::tibble( + agg = character(), + block = character(), + dataset = character(), + dropdown = character(), + S3 = list(), + gt_group = glue::glue(), + label = character(), + label_source = character() + ), + initialize = function(datalist) { + self$datalist <- datalist + + init <- sapply(datalist, function(x) "PARAMCD" %in% colnames(x) & !("CNSR" %in% colnames(x))) + BDS <- datalist[init] + + ADSL <- datalist$ADSL + metadata <- data.frame(col_names = colnames(ADSL)) + metadata$code <- NA + + for (i in 1:nrow(metadata)) { + if("label" %in% names(attributes(ADSL[[metadata$col_names[i]]]))){ + metadata$code[i] <- attr(ADSL[[metadata$col_names[i]]], "label") + } + } + + new_list <- lapply(BDS, function(x) x %>% select(PARAMCD, PARAM) %>% distinct()) + + new_list[[length(new_list) + 1 ]] <- metadata + names(new_list)[length(new_list)] <- "ADSL" + + # only display ADAE column blocks if an ADAE is uploaded! + if ("ADAE" %in% names(datalist)) { + # this also doesn't need to depend on pre-filters + ADAE <- datalist$ADAE + # Display variable blocks that are only unique to ADAE + ADAE_blocks <- data.frame( + col_names = dplyr::setdiff(colnames(ADAE), metadata$col_names) + ) + ADAE_blocks$code <- NA + + for (i in 1:nrow(ADAE_blocks)) { + if("label" %in% names(attributes(ADAE[[ADAE_blocks$col_names[i]]]))){ + ADAE_blocks$code[i] <- attr(ADAE[[ADAE_blocks$col_names[i]]], "label") + } + } + new_list[[length(new_list) + 1 ]] <- ADAE_blocks + names(new_list)[length(new_list)] <- "ADAE" + } + + self$all_rows <- new_list + + avisit_words <- + if(any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))){ + purrr::map(BDS, function(x) x %>% dplyr::select(AVISIT)) %>% + dplyr::bind_rows() %>% + dplyr::distinct(AVISIT) %>% + dplyr::pull() + } else { + NULL + } + + avisit_fctr <- + if(any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))){ + purrr::map(BDS, function(x) x %>% dplyr::select(AVISITN)) %>% + dplyr::bind_rows() %>% + dplyr::distinct(AVISITN) %>% + dplyr::pull() + } else { + 1:2 + } + + private$my_weeks <- + if (is.null(avisit_words)) { + NULL + } else { + awd <- tidyr::tibble(AVISIT = avisit_words, AVISITN = avisit_fctr) + avisit_words <- + awd %>% + dplyr::mutate(AVISIT = factor(AVISIT, + levels = awd[order(awd$AVISITN), "AVISIT"][[1]] %>% unique() )) %>% + dplyr::pull(AVISIT) %>% + unique() + avisit_words[avisit_words != ""] %>% + as.vector() + } + + private$all_cols <- + if("ADAE" %in% names(datalist)){ + unique(c( + colnames(datalist$ADSL)[sapply(datalist$ADSL, class) %in% c('character', 'factor')], + colnames(datalist$ADAE)[sapply(datalist$ADAE, class) %in% c('character', 'factor')] + )) + } else { # just adsl cols + unique(c( + colnames(datalist$ADSL)[sapply(datalist$ADSL, class) %in% c('character', 'factor')] + )) + } + + }, + print = function(...) { + print(self$blocks) + invisible(self) + }, + add_block = function(variable, stat, dropdown) { + blocks <- list() + aggs <- list() + get_var <- function(x) { + if (missing(x)) { + block_txt <- readline("INPUT: ") + } else { + block_txt <- x + } + if (block_txt == "1") { + purrr::iwalk(tmp$all_rows, ~ {cat(.y, ":\n ", sep = ""); cat(.x[[1]], sep = ", "); cat("\n")}) + get_var() + } else if (block_txt == "2") { + cat(names(self$all_rows), sep = ", ") + get_var() + } else if (block_txt %in% names(self$all_rows)) { + cat(self$all_rows[[block_txt]][[1]], sep = ","); cat("\n") + get_var() + } else { + if (!any(purrr::map_lgl(self$all_rows, ~ block_txt %in% .x[[1]]))) { + cat("Param/field not found. Please type 1 to see all available options.\n") + get_var() + } + return(block_txt) + } + } + get_stat <- function(x) { + if (missing(x)) { + agg_txt <- readline("INPUT: ") + } else { + agg_txt <- x + } + if (agg_txt == "A") { + cat("Please type statistic or the number corresponding to desired stat.\n") + cat(paste0(seq_along(private$stats), ": ", private$stats), sep = "\n"); cat("\n") + get_stat() + } else if (agg_txt %in% seq_along(private$stats)) { + return(private$stats[as.numeric(agg_txt)]) + } else if (agg_txt %in% private$stats) { + return(agg_txt) + } else { + cat('Statistic not valid. Please type "A" to see all available options.\n') + get_stat() + } + } + get_dropdown <- function(x, opts = c("weeks", "cols")) { + opts <- match.arg(opts) + + opt_lst <- + if (opts == "weeks") { + c("NONE", "ALL", private$my_weeks) + } else { + c("NONE", private$all_cols) + } + + if (missing(x)) { + agg_val <- readline("INPUT: ") + } else { + agg_val <- x + } + if (agg_val == "A") { + cat("Please typ the week or the number corresponding to the desired option.\n") + cat(paste0(seq_along(opt_lst), ": ", opt_lst), sep = "\n"); cat("\n") + get_dropdown(opts=opts) + } else if (agg_val %in% seq_along(opt_lst)) { + return(opt_lst[as.numeric(agg_val)]) + } else if (agg_val %in% opt_lst) { + return(agg_val) + } else { + cat('Option not valid. Please type "A" to see all available.\n') + get_dropdown(opts=opts) + } + } + + if (missing(variable)) + cat('Please provide a PARAMCD or field.', + 'To see all options, type 1. To see all datasets, type 2. The see options for a particular dataset, type its name (e.g. "ADAE").\n', sep = "\n") + blocks$txt <- get_var(variable) + blocks$df <- names(self$all_rows)[purrr::map_lgl(self$all_rows, ~ blocks$txt %in% .x[[1]])] + + if (missing(stat)) + cat('Please provide an aggregator.', + 'To see all options, type "A".\n', sep = "\n") + aggs$txt <- get_stat(stat) + + if (aggs$txt %in% c("ANOVA", "CHG", "MEAN") & !is.null(private$my_weeks)) { + if (missing(dropdown)) + cat('Please provide an AVISIT.', + 'To see all options, type "A".\n', sep = "\n") + aggs$val <- get_dropdown(dropdown, "weeks") + if (aggs$val == "ALL") + aggs$lst <- as.list(private$my_weeks) + } else if (aggs$txt %in% c("NESTED_FREQ_DSC", "NESTED_FREQ_ABC")) { + if (missing(dropdown)) + cat('Please provide a field.', + 'To see all options, type "A",\n', sep = "\n") + aggs$val <- get_dropdown(dropdown, "cols") + } + + private$block_drop[[length(private$block_drop) + 1]] <- blocks + private$agg_drop[[length(private$agg_drop) + 1]] <- aggs + + private$create_TG(private$agg_drop, private$block_drop) + + self + } + ), + list( + stats = c("ANOVA", "CHG", "MEAN", "FREQ", "Y_FREQ", "MAX_FREQ", "NON_MISSING", "NESTED_FREQ_DSC", "NESTED_FREQ_ABC"), + my_weeks = NULL, + all_cols = NULL, + block_drop = list(), + agg_drop = list(), + create_TG = function(aggs, blocks) { + blockData <- convertTGOutput(list(numbers = aggs), list(numbers = blocks)) + + blockData$label <- + "N/A" + + blockData$label_source <- + "N/A" + + self$blocks <- blockData + invisible(self) + } + ) + ) diff --git a/man/table_blocks.Rd b/man/table_blocks.Rd new file mode 100644 index 00000000..606660bb --- /dev/null +++ b/man/table_blocks.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/blockData.R +\name{table_blocks} +\alias{table_blocks} +\title{import R6} +\description{ +import R6 + +import R6 +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-table_blocks-new}{\code{table_blocks$new()}} +\item \href{#method-table_blocks-print}{\code{table_blocks$print()}} +\item \href{#method-table_blocks-add_block}{\code{table_blocks$add_block()}} +\item \href{#method-table_blocks-clone}{\code{table_blocks$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-table_blocks-new}{}}} +\subsection{Method \code{new()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{table_blocks$new(datalist)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-table_blocks-print}{}}} +\subsection{Method \code{print()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{table_blocks$print(...)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-table_blocks-add_block}{}}} +\subsection{Method \code{add_block()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{table_blocks$add_block()}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-table_blocks-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{table_blocks$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} From 50a3d51a34bae5370e5f70ff52432a2ecf816412 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 5 Jan 2023 09:42:29 -0500 Subject: [PATCH 002/110] Add wrappers for block data object --- R/blockData.R | 55 +++++++++++++++++++++++++++++++++++++++++- man/addBlock.Rd | 36 +++++++++++++++++++++++++++ man/createBlockdata.Rd | 23 ++++++++++++++++++ man/table_blocks.Rd | 36 +++++++++++++++++++++++++-- 4 files changed, 147 insertions(+), 3 deletions(-) create mode 100644 man/addBlock.Rd create mode 100644 man/createBlockdata.Rd diff --git a/R/blockData.R b/R/blockData.R index 5fc8d117..a462eb34 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -2,8 +2,11 @@ table_blocks <- R6::R6Class("table_blocks", list( + #' @field datalist A list of ADaM-ish datasets used to generate the table datalist = NULL, + #' @field all_rows A list of parameters/fields from the datalist with descriptions all_rows = NULL, + #' @field blocks A data frame containing the block data blocks = dplyr::tibble( agg = character(), block = character(), @@ -14,6 +17,9 @@ table_blocks <- label = character(), label_source = character() ), + #' @description + #' Create a new block data object + #' @param datalist A list of ADaM-ish datasets used to generate the table initialize = function(datalist) { self$datalist <- datalist @@ -104,10 +110,17 @@ table_blocks <- } }, - print = function(...) { + #' @description + #' Print the data frame containing the blocks + print = function() { print(self$blocks) invisible(self) }, + #' @description + #' Add block to the block data object + #' @param variable The parameter or field the statistic is based on + #' @param stat The statistic to be calculated + #' @param dropdown A subgroup on which the statistic is calculated (usually an AVISIT) add_block = function(variable, stat, dropdown) { blocks <- list() aggs <- list() @@ -235,3 +248,43 @@ table_blocks <- } ) ) + +#' Create Block Data Object +#' +#' @param datalist A list of ADaM-ish datasets used to generate the table +#' +#' @return A block data object +#' +#' @examples +#' +#' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +#' bd <- createBlockdata(datalist) +#' bd +createBlockdata <- function(datalist) { + invisible(table_blocks$new(datalist)) +} + +#' Add Block to Block Data Object +#' +#' @param bd A block data object +#' @param variable The parameter or field the statistic is based on +#' @param stat The statistic to be calculated +#' @param dropdown A subgroup on which the statistic is calculated (usually an AVISIT) +#' +#' @return The \code{bd} block data object with additional block +#' +#' @examples +#' +#' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +#' bd <- createBlockdata(datalist) +#' +#' if (interactive()) { +#' addBlock(bd) +#' bd +#' } +#' +#' addBlock(bd, "DIABP", "MEAN", "ALL") +#' bd +addBlock <- function(bd, variable, stat, dropdown) { + invisible(bd$add_block(variable, stat, dropdown)) +} diff --git a/man/addBlock.Rd b/man/addBlock.Rd new file mode 100644 index 00000000..22b33d3a --- /dev/null +++ b/man/addBlock.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/blockData.R +\name{addBlock} +\alias{addBlock} +\title{Add Block to Block Data Object} +\usage{ +addBlock(bd, variable, stat, dropdown) +} +\arguments{ +\item{bd}{A block data object} + +\item{variable}{The parameter or field the statistic is based on} + +\item{stat}{The statistic to be calculated} + +\item{dropdown}{A subgroup on which the statistic is calculated (usually an AVISIT)} +} +\value{ +The \code{bd} block data object with additional block +} +\description{ +Add Block to Block Data Object +} +\examples{ + +datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +bd <- createBlockdata(datalist) + +if (interactive()) { + addBlock(bd) + bd +} + +addBlock(bd, "DIABP", "MEAN", "ALL") +bd +} diff --git a/man/createBlockdata.Rd b/man/createBlockdata.Rd new file mode 100644 index 00000000..aea92f7f --- /dev/null +++ b/man/createBlockdata.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/blockData.R +\name{createBlockdata} +\alias{createBlockdata} +\title{Create Block Data Object} +\usage{ +createBlockdata(datalist) +} +\arguments{ +\item{datalist}{A list of ADaM-ish datasets used to generate the table} +} +\value{ +A block data object +} +\description{ +Create Block Data Object +} +\examples{ + +datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +bd <- createBlockdata(datalist) +bd +} diff --git a/man/table_blocks.Rd b/man/table_blocks.Rd index 606660bb..1d20a41f 100644 --- a/man/table_blocks.Rd +++ b/man/table_blocks.Rd @@ -8,6 +8,17 @@ import R6 import R6 } +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{datalist}}{A list of ADaM-ish datasets used to generate the table} + +\item{\code{all_rows}}{A list of parameters/fields from the datalist with descriptions} + +\item{\code{blocks}}{A data frame containing the block data} +} +\if{html}{\out{
}} +} \section{Methods}{ \subsection{Public methods}{ \itemize{ @@ -21,17 +32,26 @@ import R6 \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-table_blocks-new}{}}} \subsection{Method \code{new()}}{ +Create a new block data object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{table_blocks$new(datalist)}\if{html}{\out{
}} } +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{datalist}}{A list of ADaM-ish datasets used to generate the table} +} +\if{html}{\out{
}} +} } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-table_blocks-print}{}}} \subsection{Method \code{print()}}{ +Print the data frame containing the blocks \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{table_blocks$print(...)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{table_blocks$print()}\if{html}{\out{
}} } } @@ -39,10 +59,22 @@ import R6 \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-table_blocks-add_block}{}}} \subsection{Method \code{add_block()}}{ +Add block to the block data object \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{table_blocks$add_block()}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{table_blocks$add_block(variable, stat, dropdown)}\if{html}{\out{
}} } +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{variable}}{The parameter or field the statistic is based on} + +\item{\code{stat}}{The statistic to be calculated} + +\item{\code{dropdown}}{A subgroup on which the statistic is calculated (usually an AVISIT)} +} +\if{html}{\out{
}} +} } \if{html}{\out{
}} \if{html}{\out{}} From 4b9767423dfa1553d6c4df6b75904ebb919ac98e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 5 Jan 2023 10:18:38 -0500 Subject: [PATCH 003/110] Allow passing of block data object to `tg_gt()` --- R/mod_tableGen_utils.R | 5 ++++- man/tg_gt.Rd | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/R/mod_tableGen_utils.R b/R/mod_tableGen_utils.R index e5660888..4798c733 100644 --- a/R/mod_tableGen_utils.R +++ b/R/mod_tableGen_utils.R @@ -480,13 +480,16 @@ std_footnote <- function(data, source) { #' A wrapper for other functions to create the `gt` object from the data #' #' @param tg_datalist A list containing the data frames used to create the table -#' @param blockData The data for the construction of the blocks in the table +#' @param blockData The data frame for the construction of the blocks in the table or the block data object #' @param total_df A data frame containing the totals by grouping variable #' @param group A character denoting the grouping variable #' #' @export #' @keywords tabGen_repro tg_gt <- function(tg_datalist, blockData, total_df, group) { + if (all(c("table_blocks", "R6") %in% class(blockData))) + blockData <- blockData$blocks + purrr::pmap(list( blockData$agg, blockData$S3, diff --git a/man/tg_gt.Rd b/man/tg_gt.Rd index e02eda8c..eaedfe32 100644 --- a/man/tg_gt.Rd +++ b/man/tg_gt.Rd @@ -9,7 +9,7 @@ tg_gt(tg_datalist, blockData, total_df, group) \arguments{ \item{tg_datalist}{A list containing the data frames used to create the table} -\item{blockData}{The data for the construction of the blocks in the table} +\item{blockData}{The data frame for the construction of the blocks in the table or the block data object} \item{total_df}{A data frame containing the totals by grouping variable} From 31f4d481a707152e68dd41fafc8af3d68e08cd2d Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 5 Jan 2023 10:59:29 -0500 Subject: [PATCH 004/110] Export block data functions --- NAMESPACE | 2 ++ R/blockData.R | 10 ++++++++-- man/addBlock.Rd | 3 ++- man/createBlockdata.Rd | 3 ++- 4 files changed, 14 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 728c434c..28d7c1d6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,10 @@ # Generated by roxygen2: do not edit by hand +export(addBlock) export(app_methods) export(col_for_list_expr) export(common_rownames) +export(createBlockdata) export(data_to_filter) export(data_to_use_str) export(get_levels) diff --git a/R/blockData.R b/R/blockData.R index a462eb34..47b1e6d5 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -255,9 +255,12 @@ table_blocks <- #' #' @return A block data object #' +#' @export +#' #' @examples #' -#' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +#' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, +#' ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) #' bd <- createBlockdata(datalist) #' bd createBlockdata <- function(datalist) { @@ -273,9 +276,12 @@ createBlockdata <- function(datalist) { #' #' @return The \code{bd} block data object with additional block #' +#' @export +#' #' @examples #' -#' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +#' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, +#' ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) #' bd <- createBlockdata(datalist) #' #' if (interactive()) { diff --git a/man/addBlock.Rd b/man/addBlock.Rd index 22b33d3a..a22578bf 100644 --- a/man/addBlock.Rd +++ b/man/addBlock.Rd @@ -23,7 +23,8 @@ Add Block to Block Data Object } \examples{ -datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, + ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) bd <- createBlockdata(datalist) if (interactive()) { diff --git a/man/createBlockdata.Rd b/man/createBlockdata.Rd index aea92f7f..6dc8efa7 100644 --- a/man/createBlockdata.Rd +++ b/man/createBlockdata.Rd @@ -17,7 +17,8 @@ Create Block Data Object } \examples{ -datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, + ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) bd <- createBlockdata(datalist) bd } From e84365dc0a5f6852054de48e5a895b066258431b Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 9 Jan 2023 09:57:43 -0500 Subject: [PATCH 005/110] Account for multiple data sets containing field --- R/blockData.R | 29 ++++++++++++++++++++++++----- man/addBlock.Rd | 4 +++- man/table_blocks.Rd | 4 +++- 3 files changed, 30 insertions(+), 7 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 47b1e6d5..9c836cfe 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -121,7 +121,8 @@ table_blocks <- #' @param variable The parameter or field the statistic is based on #' @param stat The statistic to be calculated #' @param dropdown A subgroup on which the statistic is calculated (usually an AVISIT) - add_block = function(variable, stat, dropdown) { + #' @param df The dataset the parameter or field is from + add_block = function(variable, stat, dropdown, df) { blocks <- list() aggs <- list() get_var <- function(x) { @@ -194,12 +195,29 @@ table_blocks <- get_dropdown(opts=opts) } } + get_df <- function(x, possible_dfs) { + if (!missing(x) && !(x %in% possible_dfs || x %in% seq_along(possible_dfs))) { + cat("The selected variable is not in the supplied dataset.\n") + } else if (!missing(x) && x %in% possible_dfs) { + return(x) + } else if (!missing(x) && x %in% seq_along(possible_dfs)) { + return(possible_dfs[as.numeric(x)]) + } else if (missing(x) & length(possible_dfs) == 1) { + return(possible_dfs) + } + + cat("Please type the dataset or the number corresponding to the desired option.\n") + cat(paste0(seq_along(possible_dfs), ": ", possible_dfs), sep = "\n"); cat("\n") + df_val <- readline("Input: ") + get_df(df_val, possible_dfs) + } if (missing(variable)) cat('Please provide a PARAMCD or field.', - 'To see all options, type 1. To see all datasets, type 2. The see options for a particular dataset, type its name (e.g. "ADAE").\n', sep = "\n") + 'To see all options, type 1. To see all datasets, type 2. To see options for a particular dataset, type its name (e.g. "ADAE").\n', sep = "\n") blocks$txt <- get_var(variable) - blocks$df <- names(self$all_rows)[purrr::map_lgl(self$all_rows, ~ blocks$txt %in% .x[[1]])] + possible_dfs <- names(self$all_rows)[purrr::map_lgl(self$all_rows, ~ blocks$txt %in% .x[[1]])] + blocks$df <- get_df(df, possible_dfs) if (missing(stat)) cat('Please provide an aggregator.', @@ -273,6 +291,7 @@ createBlockdata <- function(datalist) { #' @param variable The parameter or field the statistic is based on #' @param stat The statistic to be calculated #' @param dropdown A subgroup on which the statistic is calculated (usually an AVISIT) +#' @param df The dataset the parameter or field is from #' #' @return The \code{bd} block data object with additional block #' @@ -291,6 +310,6 @@ createBlockdata <- function(datalist) { #' #' addBlock(bd, "DIABP", "MEAN", "ALL") #' bd -addBlock <- function(bd, variable, stat, dropdown) { - invisible(bd$add_block(variable, stat, dropdown)) +addBlock <- function(bd, variable, stat, dropdown, df) { + invisible(bd$add_block(variable, stat, dropdown, df)) } diff --git a/man/addBlock.Rd b/man/addBlock.Rd index a22578bf..f0964b09 100644 --- a/man/addBlock.Rd +++ b/man/addBlock.Rd @@ -4,7 +4,7 @@ \alias{addBlock} \title{Add Block to Block Data Object} \usage{ -addBlock(bd, variable, stat, dropdown) +addBlock(bd, variable, stat, dropdown, df) } \arguments{ \item{bd}{A block data object} @@ -14,6 +14,8 @@ addBlock(bd, variable, stat, dropdown) \item{stat}{The statistic to be calculated} \item{dropdown}{A subgroup on which the statistic is calculated (usually an AVISIT)} + +\item{df}{The dataset the parameter or field is from} } \value{ The \code{bd} block data object with additional block diff --git a/man/table_blocks.Rd b/man/table_blocks.Rd index 1d20a41f..c3c539fa 100644 --- a/man/table_blocks.Rd +++ b/man/table_blocks.Rd @@ -61,7 +61,7 @@ Print the data frame containing the blocks \subsection{Method \code{add_block()}}{ Add block to the block data object \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{table_blocks$add_block(variable, stat, dropdown)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{table_blocks$add_block(variable, stat, dropdown, df)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -72,6 +72,8 @@ Add block to the block data object \item{\code{stat}}{The statistic to be calculated} \item{\code{dropdown}}{A subgroup on which the statistic is calculated (usually an AVISIT)} + +\item{\code{df}}{The dataset the parameter or field is from} } \if{html}{\out{}} } From d9fd1e06af140aef0207a7d9bdde16d3a6d06d43 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 9 Jan 2023 10:07:37 -0500 Subject: [PATCH 006/110] Allow NA or NULL to be passed to dropdown --- R/blockData.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 9c836cfe..bd7f40d7 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -182,8 +182,10 @@ table_blocks <- } else { agg_val <- x } - if (agg_val == "A") { - cat("Please typ the week or the number corresponding to the desired option.\n") + if (is.null(agg_val) || is.na(agg_val)) { + return(NULL) + } else if (agg_val == "A") { + cat("Please type the week or the number corresponding to the desired option.\n") cat(paste0(seq_along(opt_lst), ": ", opt_lst), sep = "\n"); cat("\n") get_dropdown(opts=opts) } else if (agg_val %in% seq_along(opt_lst)) { @@ -229,7 +231,7 @@ table_blocks <- cat('Please provide an AVISIT.', 'To see all options, type "A".\n', sep = "\n") aggs$val <- get_dropdown(dropdown, "weeks") - if (aggs$val == "ALL") + if (!is.null(aggs$val) && aggs$val == "ALL") aggs$lst <- as.list(private$my_weeks) } else if (aggs$txt %in% c("NESTED_FREQ_DSC", "NESTED_FREQ_ABC")) { if (missing(dropdown)) From a070413eecf509e666d7bf8543ddeb3aa5ac2c9c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 22 Feb 2023 14:55:37 -0500 Subject: [PATCH 007/110] Set up the easier tables --- R/mod_tableGen.R | 40 +++++++----- inst/app/www/recipe.js | 132 +++++++++----------------------------- recipes.json | 139 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 193 insertions(+), 118 deletions(-) create mode 100644 recipes.json diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index c409cc1c..5e5c7c42 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -28,6 +28,14 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL old <- options() on.exit(options(old)) + recipes <- reactiveVal(jsonlite::read_json("recipes.json")) + + observe({ + req(recipes()) + + session$sendCustomMessage("recipes", recipes()) + }) + observeEvent( input$help, { tg_guide$init()$start() }) @@ -44,22 +52,22 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL HTML(paste(' - - ${values} - - - ` +function createRecipeBlock(newid, df, selection, values = '') { + return `
` + + `` + + (selection === undefined ? `` : ``) + + `` + + `
` } // this is used for combining block rows (on either the Var or STAT agg @@ -28,7 +19,7 @@ function selectRecipeBlock(newid, df, selection, values = '') { function combineRows(block_array, df) { let t = [] block_array.forEach(function (blk) { - t.push(simpleRecipeRowBlock(blk, df)) + t.push(createRecipeBlock(blk, df)) }); t= t.join("") return(t) @@ -48,24 +39,12 @@ function createOption(opt) { function oneAgg_combineSelects(var_block, agg_stat, df, select_options) { let t = Array(var_block.length); for(var i = 0; i < var_block.length; i += 1){ - t.push(selectRecipeBlock(agg_stat, df, "ALL", select_options)) + t.push(createRecipeBlock(agg_stat, df, "ALL", select_options)) }; t= t.join("") return(t) } -// These are called arrays -const demography_rows = ["AGEGR1", "AGE", "SEX", "ETHNIC", "RACE", "HEIGHTBL", "WEIGHTBL"] -const demography_agg = ["FREQ", "MEAN", "FREQ", "FREQ", "FREQ", "MEAN", "MEAN"] - - -const ae18_rows = ["AOCCFL", "AESEV", "AESER","DTHDT"] -const ae18_agg = ["Y_FREQ", "MAX_FREQ", "Y_FREQ", "NON_MISSING"] - -const soc_pt_rows = ["AOCCFL", "AEBODSYS"] -const soc_pt_agg = ["Y_FREQ", "NESTED_FREQ_DSC"] -const soc_pt_sel = ["NONE", "AEDECOD"] - let bc_obj = null; Shiny.addCustomMessageHandler('adlbc', function(adlbc) { bc_obj = adlbc; @@ -81,91 +60,39 @@ Shiny.addCustomMessageHandler('adlbu', function(adlbu) { ur_obj = adlbu; }) +let recipes_obj = null; +Shiny.addCustomMessageHandler('recipes', function(recipes) { + recipes_obj = recipes; +}) + $(document).on('click', '#RECIPE', function(){ -/* Create custom block recipes to automatically populate when selected */ +// Create custom block recipes to automatically populate when selected $("#RECIPE").bind("change", function(event, ui) { - let publisher = $("#RECIPE").val(); + let publisher = $("#RECIPE").children(":selected").attr("id"); + document.getElementById("droppable_blocks").innerHTML = ""; + document.getElementById("droppable_agg").innerHTML = ""; + + if (Object.keys(recipes_obj).includes(publisher)) { + for(block of recipes_obj[publisher].blocks){ + $("#droppable_blocks").append($(createRecipeBlock(block.variable, block.data))); + $("#droppable_agg").append($(createRecipeBlock(block.statistic, block.data, block.args))); + } + } else { switch(publisher) { - case "Table 3: Accounting of Subjects": - document.getElementById("droppable_blocks").innerHTML = ""; - $("#droppable_blocks").append($(simpleRecipeRowBlock("RANDFL", "ADSL"))); - $("#droppable_blocks").append($(simpleRecipeRowBlock("SAFFL", "ADSL"))); - $("#droppable_blocks").append($(simpleRecipeRowBlock("EOTSTT", "ADSL"))); - $("#droppable_blocks").append($(simpleRecipeRowBlock("EOSSTT", "ADSL"))); - - document.getElementById("droppable_agg").innerHTML = ""; - $("#droppable_agg").append($(simpleRecipeRowBlock("Y_FREQ", "ADAE"))); - $("#droppable_agg").append($(simpleRecipeRowBlock("FREQ", "ADSL"))); - $("#droppable_agg").append($(selectRecipeBlock("NESTED_FREQ_ABC", "ADSL", "DCTREAS"))); - $("#droppable_agg").append($(selectRecipeBlock("NESTED_FREQ_ABC", "ADSL", "DCSREAS"))); - break; - case "Table 5: Demography": - document.getElementById("droppable_agg").innerHTML = ""; - $("#droppable_agg").append($(combineRows(demography_agg, "ADSL"))); - document.getElementById("droppable_blocks").innerHTML = ""; - $("#droppable_blocks").append($(combineRows(demography_rows, "ADSL"))); - break; - case "Table 18: Overall summary of adverse events": - document.getElementById("droppable_agg").innerHTML = ""; - $("#droppable_agg").append($(combineRows(ae18_agg, "ADAE"))); - document.getElementById("droppable_blocks").innerHTML = ""; - $("#droppable_blocks").append($(combineRows(ae18_rows, "ADAE"))); - break; - case "Table 20: Adverse events by system organ class and preferred term sorted by alphabetical order": - document.getElementById("droppable_agg").innerHTML = ""; - $("#droppable_agg").append($(simpleRecipeRowBlock("NON_MISSING", "ADAE"))); - $("#droppable_agg").append($(selectRecipeBlock("NESTED_FREQ_ABC", "ADAE", "AEDECOD"))); - document.getElementById("droppable_blocks").innerHTML = ""; - $("#droppable_blocks").append($(simpleRecipeRowBlock("USUBJID", "ADAE"))); - $("#droppable_blocks").append($(simpleRecipeRowBlock("AEBODSYS", "ADAE"))); - break; - case "Table 19: Adverse events by system organ class and preferred term sorted by decreasing frequency": - case "Table 25: Severe adverse events by system organ class and preferred term": - case "Table 29: Related adverse events by system organ class and preferred term": - case "Table 30: Serious adverse events by system organ class and preferred term": - case "Table 33: Related serious adverse events by system organ class and preferred term": - case "Table 34: Adverse events that led to discontinuation of study treatment by system organ class and preferred term": - case "Table 36: Adverse events that led to withdrawl from study by system organ class and preferred term": - case "Table 38: Adverse events that led to drug interrupted, dose reduced, or dose increased by system organ class and preferred term": - document.getElementById("droppable_agg").innerHTML = ""; - $("#droppable_agg").append($(simpleRecipeRowBlock("NON_MISSING", "ADAE"))); - $("#droppable_agg").append($(selectRecipeBlock("NESTED_FREQ_DSC", "ADAE", "AEDECOD"))); - document.getElementById("droppable_blocks").innerHTML = ""; - $("#droppable_blocks").append($(simpleRecipeRowBlock("USUBJID", "ADAE"))); - $("#droppable_blocks").append($(simpleRecipeRowBlock("AEBODSYS", "ADAE"))); - break; - case "Table 21: Adverse events by system organ class": - document.getElementById("droppable_agg").innerHTML = ""; - $("#droppable_agg").append($(simpleRecipeRowBlock("NON_MISSING", "ADAE"))); - $("#droppable_agg").append($(selectRecipeBlock("NESTED_FREQ_DSC", "ADAE", "NONE"))); - document.getElementById("droppable_blocks").innerHTML = ""; - $("#droppable_blocks").append($(simpleRecipeRowBlock("USUBJID", "ADAE"))); - $("#droppable_blocks").append($(simpleRecipeRowBlock("AEBODSYS", "ADAE"))); - break; - case "Table 23: Adverse events by preferred term": - case "Table 26: Severe adverse events by preferred term": - case "Table 31: Serious adverse events by preferred term": - document.getElementById("droppable_agg").innerHTML = ""; - $("#droppable_agg").append($(simpleRecipeRowBlock("NON_MISSING", "ADAE"))); - $("#droppable_agg").append($(selectRecipeBlock("NESTED_FREQ_DSC", "ADAE", "NONE"))); - document.getElementById("droppable_blocks").innerHTML = ""; - $("#droppable_blocks").append($(simpleRecipeRowBlock("USUBJID", "ADAE"))); - $("#droppable_blocks").append($(simpleRecipeRowBlock("AEDECOD", "ADAE"))); - break; - case "Table 41: Blood Chemistry actual values by visit": + case "tbl41_b": let select_opts = `${bc_obj.weeks.map(createOption).join("")}` document.getElementById("droppable_agg").innerHTML = ""; $("#droppable_agg").append($(oneAgg_combineSelects(bc_obj.params, "MEAN", "ADLB", select_opts))); document.getElementById("droppable_blocks").innerHTML = ""; $("#droppable_blocks").append($(combineRows(bc_obj.params, "ADLB"))); break; - case "Table 41: Hematology actual values by visit": + case "tbl41_h": document.getElementById("droppable_agg").innerHTML = ""; $("#droppable_agg").append($(oneAgg_combineSelects(he_obj.params,"MEAN","ADLB",he_obj.weeks))); document.getElementById("droppable_blocks").innerHTML = ""; $("#droppable_blocks").append($(combineRows(he_obj.params, "ADLB"))); break; - case "Table 41: Urinalysis actual values by visit": + case "tbl41_u": document.getElementById("droppable_agg").innerHTML = ""; $("#droppable_agg").append($(oneAgg_combineSelects(ur_obj.params,"MEAN","ADLB",ur_obj.weeks))); document.getElementById("droppable_blocks").innerHTML = ""; @@ -175,6 +102,7 @@ $("#RECIPE").bind("change", function(event, ui) { document.getElementById("droppable_agg").innerHTML = ""; document.getElementById("droppable_blocks").innerHTML = ""; } + } }); $('select#RECIPE').change(function() { diff --git a/recipes.json b/recipes.json new file mode 100644 index 00000000..22351207 --- /dev/null +++ b/recipes.json @@ -0,0 +1,139 @@ +{ + "stan_3": { + "title": "Table 3: Accounting of Subjects", + "blocks": [{"data":"ADSL", "variable":"RANDFL", "statistic":"Y_FREQ"}, + {"data":"ADSL", "variable":"SAFFL", "statistic":"FREQ"}, + {"data":"ADSL", "variable":"EOTSTT", "statistic":"NESTED_FREQ_ABC", "args":"DCTREAS"}, + {"data":"ADSL", "variable":"EOSSTT", "statistic":"NESTED_FREQ_ABC", "args":"DCSREAS"}] + }, + "stan_5": { + "title": "Table 5: Demography", + "blocks": [{"data":"ADSL", "variable":"AGEGR1", "statistic":"FREQ"}, + {"data":"ADSL", "variable":"AGE", "statistic":"MEAN"}, + {"data":"ADSL", "variable":"SEX", "statistic":"FREQ"}, + {"data":"ADSL", "variable":"ETHNIC", "statistic":"FREQ"}, + {"data":"ADSL", "variable":"RACE", "statistic":"FREQ"}, + {"data":"ADSL", "variable":"HEIGHTBL", "statistic":"MEAN"}, + {"data":"ADSL", "variable":"WEIGHTBL", "statistic":"MEAN"}] + }, + "stan_18": { + "title": "Table 18: Overall summary of adverse events", + "blocks": [{"data":"ADAE", "variable":"AOCCFL", "statistic":"Y_FREQ"}, + {"data":"ADAE", "variable":"AESEV", "statistic":"MAX_FREQ"}, + {"data":"ADAE", "variable":"AESER", "statistic":"Y_FREQ"}, + {"data":"ADAE", "variable":"DTHDT", "statistic":"NON_MISSING"}] + }, + "stan_19": { + "title": "Table 19: Adverse events by system organ class and preferred term sorted by decreasing frequency", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + }, + "stan_20": { + "title": "Table 20: Adverse events by system organ class and preferred term sorted by alphabetical order", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "args":"AEDECOD"}] + }, + "stan_21": { + "title": "Table 21: Adverse events by system organ class", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "args":"NONE"}] + }, + "stan_23": { + "title": "Table 23: Adverse events by preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "args":"NONE"}] + }, + "stan_25": { + "title": "Table 25: Severe adverse events by system organ class and preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + }, + "stan_26": { + "title": "Table 26: Severe adverse events by preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "args":"NONE"}] + }, + "stan_29": { + "title": "Table 29: Related adverse events by system organ class and preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + }, + "stan_30": { + "title": "Table 30: Serious adverse events by system organ class and preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + }, + "stan_31": { + "title": "Table 31: Serious adverse events by preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "args":"NONE"}] + }, + "stan_33": { + "title": "Table 33: Related serious adverse events by system organ class and preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + }, + "stan_34": { + "title": "Table 34: Adverse events that led to discontinuation of study treatment by system organ class and preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + }, + "stan_36": { + "title": "Table 36: Adverse events that led to withdrawl from study by system organ class and preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + }, + "stan_38": { + "title": "Table 38: Adverse events that led to drug interrupted, dose reduced, or dose increased by system organ class and preferred term", + "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + }, + "stan_41_chem": { + "title": "Table 41: Blood Chemistry actual values by visit", + "blocks": [{"data":"ADLB", "variable":"ALT", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"AST", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"ALP", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"BILI", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"GGT", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"BUN", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"CREAT", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"SODIUM", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"K", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"CL", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"BICARB", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"GLUC", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"CA", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"PHOS", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"ALB", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"CHOL", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"MG", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"TRIG", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"URATE", "statistic":"MEAN", "args":"ALL", "req":false}] + }, + "stan_41_hema": { + "title": "Table 41: Hematology actual values by visit", + "blocks": [{"data":"ADLB", "variable":"LYM", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"NEUT", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"MONO", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"EOS", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"BASO", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"RBC", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"HGB", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"HCT", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"PLAT", "statistic":"MEAN", "args":"ALL", "req":false}] + }, + "stan_41_urin": { + "title": "Table 41: Urinalysis actual values by visit", + "blocks": [{"data":"ADLB", "variable":"SPGRAV", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"PH", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"COLOR", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"OCCBLD", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"GLUCU", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"KETONES", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"PROTU", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"MWBCQU", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"MWBCU", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"MRBCQU", "statistic":"MEAN", "args":"ALL", "req":false}, + {"data":"ADLB", "variable":"MRBCU", "statistic":"MEAN", "args":"ALL", "req":false}] + } +} \ No newline at end of file From cc0eb850a564f9e32c71021d5060a9e57ee7ab15 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 22 Feb 2023 15:46:49 -0500 Subject: [PATCH 008/110] Change `args` to `stat_arg` in JSON --- inst/app/www/recipe.js | 4 +- recipes.json | 108 ++++++++++++++++++++--------------------- 2 files changed, 56 insertions(+), 56 deletions(-) diff --git a/inst/app/www/recipe.js b/inst/app/www/recipe.js index f71fef20..4ba1e859 100644 --- a/inst/app/www/recipe.js +++ b/inst/app/www/recipe.js @@ -74,8 +74,8 @@ $("#RECIPE").bind("change", function(event, ui) { if (Object.keys(recipes_obj).includes(publisher)) { for(block of recipes_obj[publisher].blocks){ - $("#droppable_blocks").append($(createRecipeBlock(block.variable, block.data))); - $("#droppable_agg").append($(createRecipeBlock(block.statistic, block.data, block.args))); + $("#droppable_blocks").append($(createRecipeBlock(block.variable, block.data, block.var_arg))); + $("#droppable_agg").append($(createRecipeBlock(block.statistic, block.data, block.stat_arg))); } } else { switch(publisher) { diff --git a/recipes.json b/recipes.json index 22351207..9b84c832 100644 --- a/recipes.json +++ b/recipes.json @@ -3,8 +3,8 @@ "title": "Table 3: Accounting of Subjects", "blocks": [{"data":"ADSL", "variable":"RANDFL", "statistic":"Y_FREQ"}, {"data":"ADSL", "variable":"SAFFL", "statistic":"FREQ"}, - {"data":"ADSL", "variable":"EOTSTT", "statistic":"NESTED_FREQ_ABC", "args":"DCTREAS"}, - {"data":"ADSL", "variable":"EOSSTT", "statistic":"NESTED_FREQ_ABC", "args":"DCSREAS"}] + {"data":"ADSL", "variable":"EOTSTT", "statistic":"NESTED_FREQ_ABC", "stat_arg":"DCTREAS"}, + {"data":"ADSL", "variable":"EOSSTT", "statistic":"NESTED_FREQ_ABC", "stat_arg":"DCSREAS"}] }, "stan_5": { "title": "Table 5: Demography", @@ -26,114 +26,114 @@ "stan_19": { "title": "Table 19: Adverse events by system organ class and preferred term sorted by decreasing frequency", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] }, "stan_20": { "title": "Table 20: Adverse events by system organ class and preferred term sorted by alphabetical order", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "args":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "stat_arg":"AEDECOD"}] }, "stan_21": { "title": "Table 21: Adverse events by system organ class", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "args":"NONE"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "stat_arg":"NONE"}] }, "stan_23": { "title": "Table 23: Adverse events by preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "args":"NONE"}] + {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "stat_arg":"NONE"}] }, "stan_25": { "title": "Table 25: Severe adverse events by system organ class and preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] }, "stan_26": { "title": "Table 26: Severe adverse events by preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "args":"NONE"}] + {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "stat_arg":"NONE"}] }, "stan_29": { "title": "Table 29: Related adverse events by system organ class and preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] }, "stan_30": { "title": "Table 30: Serious adverse events by system organ class and preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] }, "stan_31": { "title": "Table 31: Serious adverse events by preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "args":"NONE"}] + {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "stat_arg":"NONE"}] }, "stan_33": { "title": "Table 33: Related serious adverse events by system organ class and preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] }, "stan_34": { "title": "Table 34: Adverse events that led to discontinuation of study treatment by system organ class and preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] }, "stan_36": { "title": "Table 36: Adverse events that led to withdrawl from study by system organ class and preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] }, "stan_38": { "title": "Table 38: Adverse events that led to drug interrupted, dose reduced, or dose increased by system organ class and preferred term", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "args":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] }, "stan_41_chem": { "title": "Table 41: Blood Chemistry actual values by visit", - "blocks": [{"data":"ADLB", "variable":"ALT", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"AST", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"ALP", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"BILI", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"GGT", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"BUN", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"CREAT", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"SODIUM", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"K", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"CL", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"BICARB", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"GLUC", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"CA", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"PHOS", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"ALB", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"CHOL", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"MG", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"TRIG", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"URATE", "statistic":"MEAN", "args":"ALL", "req":false}] + "blocks": [{"data":"ADLB", "variable":"ALT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"AST", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"ALP", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"BILI", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"GGT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"BUN", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"CREAT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"SODIUM", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"K", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"CL", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"BICARB", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"GLUC", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"CA", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"PHOS", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"ALB", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"CHOL", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"MG", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"TRIG", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"URATE", "statistic":"MEAN", "stat_arg":"ALL", "req":false}] }, "stan_41_hema": { "title": "Table 41: Hematology actual values by visit", - "blocks": [{"data":"ADLB", "variable":"LYM", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"NEUT", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"MONO", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"EOS", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"BASO", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"RBC", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"HGB", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"HCT", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"PLAT", "statistic":"MEAN", "args":"ALL", "req":false}] + "blocks": [{"data":"ADLB", "variable":"LYM", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"NEUT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"MONO", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"EOS", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"BASO", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"RBC", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"HGB", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"HCT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"PLAT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}] }, "stan_41_urin": { "title": "Table 41: Urinalysis actual values by visit", - "blocks": [{"data":"ADLB", "variable":"SPGRAV", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"PH", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"COLOR", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"OCCBLD", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"GLUCU", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"KETONES", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"PROTU", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"MWBCQU", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"MWBCU", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"MRBCQU", "statistic":"MEAN", "args":"ALL", "req":false}, - {"data":"ADLB", "variable":"MRBCU", "statistic":"MEAN", "args":"ALL", "req":false}] + "blocks": [{"data":"ADLB", "variable":"SPGRAV", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"PH", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"COLOR", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"OCCBLD", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"GLUCU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"KETONES", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"PROTU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"MWBCQU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"MWBCU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"MRBCQU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, + {"data":"ADLB", "variable":"MRBCU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}] } } \ No newline at end of file From ff959a23f3bf0cd96ca3ad9b03b2b2d344303183 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 24 Feb 2023 12:51:22 -0500 Subject: [PATCH 009/110] Add S3 methods to parse recipes --- R/mod_tableGen_fct_param_opts.R | 45 +++++++++++++++++ R/mod_tableGen_fct_recipe_incl.R | 38 +++++++++++++++ dev/02_dev.R | 3 ++ recipes.json | 83 +++++++++++++++++--------------- 4 files changed, 129 insertions(+), 40 deletions(-) create mode 100644 R/mod_tableGen_fct_param_opts.R create mode 100644 R/mod_tableGen_fct_recipe_incl.R diff --git a/R/mod_tableGen_fct_param_opts.R b/R/mod_tableGen_fct_param_opts.R new file mode 100644 index 00000000..698a5d1f --- /dev/null +++ b/R/mod_tableGen_fct_param_opts.R @@ -0,0 +1,45 @@ +stat_options <- function(block, datalist, ...) { + UseMethod("stat_options", block) +} + +stat_options.default <- function(block, datalist, ...) { + block$stat_options <- block$stat_arg + + block +} + +stat_options.avisit <- function(block, datalist, ...) { + avisits <- + datalist[[block$data]] %>% + dplyr::filter(stringr::str_detect(toupper(AVISIT), "UNSCHEDULED", negate = TRUE)) %>% + dplyr::distinct(AVISIT, AVISITN) %>% + varN_fctr_reorder() %>% + dplyr::pull(AVISIT) %>% + get_levels() %>% + as.list() + + block$stat_options <- avisits + + block +} + +stat_options.avisit_lab <- function(block, datalist, ...) { + avisits <- + datalist[sapply(datalist, function(x) "PARAMCD" %in% colnames(x)) & substr(names(datalist), 1, 4) == "ADLB"] %>% + purrr::map_dfc(dplyr::select, PARAMCD, AVAL, AVISIT, AVISITN) %>% + dplyr::filter(PARAMCD == block$variable) %>% + dplyr::filter(!is.na(AVAL), + !is.na(AVISIT), + !(AVISIT %in% c(" ", "")), + stringr::str_detect(toupper(AVISIT),"UNSCHEDULED",negate = TRUE) + ) %>% + dplyr::distinct(AVISIT, AVISITN) %>% + varN_fctr_reorder() %>% + dplyr::pull(AVISIT) %>% + get_levels() %>% + as.list() + + block$stat_options <- avisits + + block +} diff --git a/R/mod_tableGen_fct_recipe_incl.R b/R/mod_tableGen_fct_recipe_incl.R new file mode 100644 index 00000000..78365cd0 --- /dev/null +++ b/R/mod_tableGen_fct_recipe_incl.R @@ -0,0 +1,38 @@ +load_recipes <- function(recipe_file) { + recipes <- jsonlite::read_json(recipe_file) + + for (i in seq_along(recipes)) { + class(recipes[[i]]$blocks) <- c(class(recipes[[i]]$blocks), recipes[[i]]$recipe_inclusion) + for (j in seq_along(recipes[[i]]$blocks)) { + class(recipes[[i]]$blocks[[j]]) <- c(class(recipes[[i]]$blocks), recipes[[i]]$blocks[[j]]$stat_options_fn) + } + } + + recipes +} + +recipe_inclusion <- function(blocks, datalist, ...) { + UseMethod("recipe_inclusion", blocks) +} + +recipe_inclusion.default <- function(blocks, datalist, ...) { + data_incl <- purrr::map_lgl(blocks, ~ .x$data %in% names(datalist)) + if (!all(data_incl)) + return(rep(FALSE, length(blocks))) + + param_col_incl <- purrr::map_lgl(blocks, ~ .x$variable %in% datalist[[.x$data]][["PARAMCD"]] || .x$variable %in% names(datalist[[.x$data]])) + if (!all(param_col_incl)) + return(rep(FALSE, length(blocks))) + + param_col_incl +} + +recipe_inclusion.stan_labs <- function(blocks, datalist, ...) { + data_incl <- purrr::map_lgl(blocks, ~ "ADLB" %in% substr(names(datalist), 1, 4)) + if (!all(data_incl)) + return(rep(FALSE, length(blocks))) + + param_incl <- purrr::map_lgl(blocks, ~ .x$variable %in% unlist(purrr::map(datalist["ADLB" == substr(names(datalist), 1, 4)], ~ unique(.x[["PARAMCD"]])), use.names = FALSE)) + + param_incl +} diff --git a/dev/02_dev.R b/dev/02_dev.R index 52d5c638..34c5520d 100644 --- a/dev/02_dev.R +++ b/dev/02_dev.R @@ -128,6 +128,9 @@ golem::add_utils( "helpers" ) # ran # golem::add_fct( "corrm", module = "popExp") #ran # golem::add_fct( "corrm", module = "popExp") #ran +golem::add_fct("recipe_incl", module = "tableGen") +golem::add_fct("param_opts", module = "tableGen") + ## External resources - ran ## Creates .js and .css files at inst/app/www diff --git a/recipes.json b/recipes.json index 9b84c832..5cd50aca 100644 --- a/recipes.json +++ b/recipes.json @@ -21,7 +21,7 @@ "blocks": [{"data":"ADAE", "variable":"AOCCFL", "statistic":"Y_FREQ"}, {"data":"ADAE", "variable":"AESEV", "statistic":"MAX_FREQ"}, {"data":"ADAE", "variable":"AESER", "statistic":"Y_FREQ"}, - {"data":"ADAE", "variable":"DTHDT", "statistic":"NON_MISSING"}] + {"data":"ADSL", "variable":"DTHDT", "statistic":"NON_MISSING"}] }, "stan_19": { "title": "Table 19: Adverse events by system organ class and preferred term sorted by decreasing frequency", @@ -90,50 +90,53 @@ }, "stan_41_chem": { "title": "Table 41: Blood Chemistry actual values by visit", - "blocks": [{"data":"ADLB", "variable":"ALT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"AST", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"ALP", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"BILI", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"GGT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"BUN", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"CREAT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"SODIUM", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"K", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"CL", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"BICARB", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"GLUC", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"CA", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"PHOS", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"ALB", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"CHOL", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"MG", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"TRIG", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"URATE", "statistic":"MEAN", "stat_arg":"ALL", "req":false}] + "recipe_inclusion": "stan_labs", + "blocks": [{"data":"ADLB", "variable":"ALT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"AST", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"ALP", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"BILI", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"GGT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"BUN", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"CREAT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"SODIUM", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"K", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"CL", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"BICARB", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"GLUC", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"CA", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"PHOS", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"ALB", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"CHOL", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"MG", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"TRIG", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"URATE", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}] }, "stan_41_hema": { "title": "Table 41: Hematology actual values by visit", - "blocks": [{"data":"ADLB", "variable":"LYM", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"NEUT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"MONO", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"EOS", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"BASO", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"RBC", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"HGB", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"HCT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"PLAT", "statistic":"MEAN", "stat_arg":"ALL", "req":false}] + "recipe_inclusion": "stan_labs", + "blocks": [{"data":"ADLB", "variable":"LYM", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab_lab"}, + {"data":"ADLB", "variable":"NEUT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"MONO", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"EOS", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"BASO", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"RBC", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"HGB", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"HCT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"PLAT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}] }, "stan_41_urin": { "title": "Table 41: Urinalysis actual values by visit", - "blocks": [{"data":"ADLB", "variable":"SPGRAV", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"PH", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"COLOR", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"OCCBLD", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"GLUCU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"KETONES", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"PROTU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"MWBCQU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"MWBCU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"MRBCQU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}, - {"data":"ADLB", "variable":"MRBCU", "statistic":"MEAN", "stat_arg":"ALL", "req":false}] + "recipe_inclusion": "stan_labs", + "blocks": [{"data":"ADLB", "variable":"SPGRAV", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"PH", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"COLOR", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"OCCBLD", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"GLUCU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"KETONES", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"PROTU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"MWBCQU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"MWBCU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"MRBCQU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"MRBCU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}] } } \ No newline at end of file From 3b242dcf9728cad20318faf419a43694d27556e2 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 24 Feb 2023 12:52:12 -0500 Subject: [PATCH 010/110] Use recipes.json to populate pre-made tables --- R/mod_tableGen.R | 56 ++++++++++++++----------- inst/app/www/recipe.js | 95 ++++-------------------------------------- 2 files changed, 39 insertions(+), 112 deletions(-) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index 6360c8b7..4d668447 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -28,7 +28,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL old <- options() on.exit(options(old)) - recipes <- reactiveVal(jsonlite::read_json("recipes.json")) + recipes <- reactiveVal(load_recipes("recipes.json")) observe({ req(recipes()) @@ -36,7 +36,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL session$sendCustomMessage("recipes", recipes()) }) - observeEvent( input$help, { + observeEvent(input$help, { tg_guide$init()$start() }) @@ -49,32 +49,38 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL }) output$stan_recipe_ui <- renderUI({ - HTML(paste(' - + ', + opts, + # ifelse(!rlang::is_empty(loaded_labs()) & chem_params()$exist,'',''), + # ifelse(!rlang::is_empty(loaded_labs()) & hema_params()$exist,'',''), + # ifelse(!rlang::is_empty(loaded_labs()) & urin_params()$exist,'',''), '')) }) - RECIPE <- reactive( if(rlang::is_empty(input$recipe)) "NONE" else input$recipe) + observeEvent(input$RECIPE, { + if (input$RECIPE != "NONE") { + recipe <- recipes()[purrr::map_lgl(recipes(), ~ .x$title == input$RECIPE)][[1]] + blocks <- + recipe$blocks %>% + `[`(recipe_inclusion(., datafile())) + recipe$blocks <- purrr::map(blocks, ~ stat_options(.x, datalist = datafile())) + } else { + recipe <- list(title = "NONE") + } + session$sendCustomMessage("submit_recipe", recipe) + RECIPE(input$RECIPE) + }) + + RECIPE <- reactiveVal() + # RECIPE <- reactive( if(rlang::is_empty(input$recipe)) "NONE" else input$recipe) observeEvent(RECIPE(), { req(input$table_title) diff --git a/inst/app/www/recipe.js b/inst/app/www/recipe.js index 4ba1e859..cd09718f 100644 --- a/inst/app/www/recipe.js +++ b/inst/app/www/recipe.js @@ -2,7 +2,8 @@ $(document).ready(function(){ /* Function to create list of row blocks. If we need a block with a text String or a dropdown, make a new function here */ -function createRecipeBlock(newid, df, selection, values = '') { +function createRecipeBlock(newid, df, selection, options) { + let values = Array.isArray(options) ? options.map(createOption).join("") : '' return `
` + `` + (selection === undefined ? `` : ` + ')) }) diff --git a/inst/app/www/styles.css b/inst/app/www/styles.css index 8b36b79d..9b57b5f3 100644 --- a/inst/app/www/styles.css +++ b/inst/app/www/styles.css @@ -168,7 +168,7 @@ button:hover { overflow-y: scroll; } -#RECIPE { +.RECIPES.selectize-input { width: 100%; text-align: center; } From 3388b7378684da9c5fd72dd8ce884d367152ff6a Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 27 Feb 2023 10:48:09 -0500 Subject: [PATCH 013/110] Import `jsonlite::read_json()` --- DESCRIPTION | 1 + NAMESPACE | 1 + R/mod_tableGen_fct_recipe_incl.R | 1 + 3 files changed, 3 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 6e958f90..b4578046 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,6 +50,7 @@ Imports: gt, haven, IDEAFilter, + jsonlite, plotly, purrr, rlang, diff --git a/NAMESPACE b/NAMESPACE index 728c434c..cba5b91f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -65,6 +65,7 @@ importFrom(gt,text_transform) importFrom(haven,read_sas) importFrom(haven,zap_formats) importFrom(haven,zap_label) +importFrom(jsonlite,read_json) importFrom(plotly,add_annotations) importFrom(plotly,config) importFrom(plotly,ggplotly) diff --git a/R/mod_tableGen_fct_recipe_incl.R b/R/mod_tableGen_fct_recipe_incl.R index 78365cd0..7515f583 100644 --- a/R/mod_tableGen_fct_recipe_incl.R +++ b/R/mod_tableGen_fct_recipe_incl.R @@ -1,3 +1,4 @@ +#' @importFrom jsonlite read_json load_recipes <- function(recipe_file) { recipes <- jsonlite::read_json(recipe_file) From 34e285a48ea1bcf1f26a7300b7bd2ad63e9765a0 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 27 Feb 2023 16:51:25 -0500 Subject: [PATCH 014/110] Add classes for filters applied to ADSL and ADAE for STAN tables --- R/mod_tableGen.R | 106 ++++--------------- R/mod_tableGen_fct_filter_adae.R | 173 +++++++++++++++++++++++++++++++ R/mod_tableGen_fct_filter_adsl.R | 71 +++++++++++++ R/mod_tableGen_fct_recipe_incl.R | 1 + R/mod_tableGen_ui.R | 2 +- dev/02_dev.R | 3 +- inst/app/www/recipe.js | 2 + 7 files changed, 268 insertions(+), 90 deletions(-) create mode 100644 R/mod_tableGen_fct_filter_adae.R create mode 100644 R/mod_tableGen_fct_filter_adsl.R diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index 0fa2e40f..6c9320b2 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -62,7 +62,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL '')) }) - observeEvent(input$RECIPE, { + recipe <- eventReactive(input$RECIPE, { if (input$RECIPE != "NONE") { recipe <- recipes()[purrr::map_lgl(recipes(), ~ .x$title == input$RECIPE)][[1]] blocks <- @@ -72,19 +72,18 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL } else { recipe <- list(title = "NONE") } - session$sendCustomMessage("submit_recipe", recipe) - RECIPE(input$RECIPE) + recipe }) - RECIPE <- reactiveVal() - # RECIPE <- reactive( if(rlang::is_empty(input$recipe)) "NONE" else input$recipe) - - observeEvent(RECIPE(), { - req(input$table_title) - val <- ifelse(RECIPE() == "NONE", "Table Title", RECIPE()) - updateTextInput(session, "table_title", value = val) + observeEvent(recipe(), { + session$sendCustomMessage("submit_recipe", recipe()) + updateSelectInput(session, "COLUMN", selected = if (is.null(recipe()$group_by)) "NONE" else recipe()$group_by) + updateTextInput(session, "table_title", value = if (recipe()$title == "NONE") "Table Title" else recipe()$title) }) + RECIPE <- reactive( if(rlang::is_empty(input$recipe)) "NONE" else input$recipe) + + # ---------------------------------------------------------------------- # input prep for table manipulation @@ -105,19 +104,14 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL return( all_cols ) }) - output$grp_col_ui <- renderUI({ - sel_grp <- dplyr::case_when( - is.null(RECIPE()) | length(RECIPE()) == 0 ~ "NONE", - !is.null(RECIPE()) & RECIPE() != "NONE" ~ "TRT01P", - TRUE ~ "NONE" - ) - selectInput(session$ns("COLUMN"), "Group Data By:", - choices = c("NONE", categ_vars()), - selected = sel_grp + observe({ + updateSelectInput(session, "COLUMN", + choices = c("NONE", categ_vars()), + selected = "NONE" ) }) - + # ---------------------------------------------------------------------- # convert list of dataframes to a single joined dataframe # containing only BDS and ADSL files @@ -142,17 +136,16 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL # perform any pre-filters on the data, when a STAN table is selected - pre_ADSL <- reactive({ - req(RECIPE()) - prep_adsl(ADSL = datafile()$ADSL,input_recipe = RECIPE()) + pre_ADSL <- eventReactive(input$recipe, { + filter_adsl(recipe(), datafile()$ADSL) }) # clean_ADAE() now happens inside this reactive! # use potentially pre-filtered ADSL when building/ joining w/ ADAE # Then filter ADAE based on STAN table selected. pre_ADAE <- reactive({ - req(RECIPE()) - prep_adae(datafile = datafile(),ADSL = pre_ADSL()$data, input_recipe = RECIPE()) + req(pre_ADSL()) + filter_adae(recipe(), datafile(), pre_ADSL()$data) }) # Create cleaned up versions of raw data @@ -331,69 +324,6 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL session$sendCustomMessage("my_avals", AVALS()) }) - # Verify if certain lab params exist, and if so, which dataset they live in - # in case there are multiple ADLBs- to use later to send data to js side - chem_params <- reactive({ - req(datafile()) - check_params(datafile(), chem) - }) - hema_params <- reactive({ - req(datafile()) - check_params(datafile(), hema) - }) - urin_params <- reactive({ - req(datafile()) - check_params(datafile(), urin) - }) - loaded_labs <- reactive({ - my_loaded_adams()[substr(my_loaded_adams(),1,4) == "ADLB"] - }) - - - # Send to Client (JS) side: - # Hematology - # Blood Chemistry - # Urinalysis - - # Sending vector of specific params (if they exist) for certain labs (if they exist) - observe({ - req(datafile(), chem_params(), hema_params(), urin_params()) # don't req("ADLBC") because then the custom message will never get sent, and hang up the UI - - send_chem <- send_urin <- send_hema <- c("not","used","fake","vector","to","convert","to","js","array") - send_chem_wks <- send_urin_wks <- send_hema_wks <- c("fake_weeky","fake_weeky2") - - if(!(rlang::is_empty(loaded_labs())) & - (chem_params()$exist | hema_params()$exist| urin_params()$exist) - ){ - - - # Blood Chem - if(chem_params()$exist){ # add recipe() = 'tab 41'? - send_chem <- chem_params()$vctr - send_chem_wks <- chem_params()$tp - } - - # Hematology - if(hema_params()$exist){ # add specific recipe() = 'tab 41'? - send_hema <- hema_params()$vctr - send_hema_wks <- hema_params()$tp - } - - # Urinalysis - if(urin_params()$exist){ # add specific recipe() = 'tab 41'? - send_urin <- urin_params()$vctr - send_urin_wks <- urin_params()$tp - } - - } # end of "if labs exist" - - session$sendCustomMessage("adlbc", list(params = as.vector(send_chem), weeks = as.vector(send_chem_wks))) - session$sendCustomMessage("adlbh", list(params = as.vector(send_hema), weeks = as.vector(send_hema_wks))) - session$sendCustomMessage("adlbu", list(params = as.vector(send_urin), weeks = as.vector(send_urin_wks))) - - - }) - # ---------------------------------------------------------------------- # Generate table given the dropped blocks # ---------------------------------------------------------------------- diff --git a/R/mod_tableGen_fct_filter_adae.R b/R/mod_tableGen_fct_filter_adae.R new file mode 100644 index 00000000..06fc3328 --- /dev/null +++ b/R/mod_tableGen_fct_filter_adae.R @@ -0,0 +1,173 @@ +filter_adae <- function(recipe, datalist, ADSL) { + UseMethod("filter_adae", recipe) +} + +filter_adae.default <- function(recipe, datalist, ADSL) { + dat <- clean_ADAE(datafile = datalist, ADSL = ADSL) + msg <- "" + list(data = dat, message = msg) +} + +filter_adae.stan_25 <- + filter_adae.stan_26 <- function(recipe, datalist, ADSL) { + dat <- clean_ADAE(datafile = datalist, ADSL = ADSL) + msg <- "" + + if("AESEV" %in% colnames(dat)){ + dat <- dat %>% filter(AESEV == 'SEVERE') + msg <- "AESEV = 'SEVERE'" + } else { + msg <- "Variable 'AESEV' doesn't exist in ADAE. STAN table not displayed because filter \"AESEV = 'SEVERE'\" cannot be applied!" + stop(msg) + } + + if("TRTEMFL" %in% colnames(dat)){ + dat <- dat %>% filter(TRTEMFL == 'Y') + msg <- paste0(msg, "
TRTEMFL = 'Y'") + } else { + msg <- paste0(msg, "
Variable 'TRTEMFL' doesn't exist in ADAE. STAN table not displayed because filter \"TRTEMFL = 'Y'\" cannot be applied!") + stop(msg) + } + + list(data = dat, message = msg) +} + +filter_adae.stan_29 <- function(recipe, datalist, ADSL) { + dat <- clean_ADAE(datafile = datalist, ADSL = ADSL) + msg <- "" + + if("AREL" %in% colnames(dat)){ + dat <- dat %>% filter(AREL == 'RELATED') + msg <- "AREL = 'RELATED'" + } else { + msg <- "Variable 'AREL' doesn't exist in ADAE. STAN table not displayed because filter \"AREL = 'RELATED'\" cannot be applied!" + stop(msg) + } + + if("TRTEMFL" %in% colnames(dat)){ + dat <- dat %>% filter(TRTEMFL == 'Y') + msg <- paste0(msg, "
TRTEMFL = 'Y'") + } else { + msg <- paste0(msg, "
Variable 'TRTEMFL' doesn't exist in ADAE. STAN table not displayed because filter \"TRTEMFL = 'Y'\" cannot be applied!") + stop(msg) + } + + list(data = dat, message = msg) +} + +filter_adae.stan_30 <- + filter_adae.stan_31 <- function(recipe, datalist, ADSL) { + dat <- clean_ADAE(datafile = datalist, ADSL = ADSL) + msg <- "" + + if("AESER" %in% colnames(dat)){ + dat <- dat %>% filter(AESER == 'Y') + msg <- "AESER = 'Y'" + } else { + msg <- "Variable 'AESER' doesn't exist in ADAE. STAN table not displayed because filter \"AESER = 'Y'\" cannot be applied!" + stop(msg) + } + + if("TRTEMFL" %in% colnames(dat)){ + dat <- dat %>% filter(TRTEMFL == 'Y') + msg <- paste0(msg, "
TRTEMFL = 'Y'") + } else { + msg <- paste0(msg, "
Variable 'TRTEMFL' doesn't exist in ADAE. STAN table not displayed because filter \"TRTEMFL = 'Y'\" cannot be applied!") + stop(msg) + } + + list(data = dat, message = msg) +} + +filter_adae.stan_33 <- function(recipe, datalist, ADSL) { + dat <- clean_ADAE(datafile = datalist, ADSL = ADSL) + msg <- "" + + if("AREL" %in% colnames(dat) & "AESER" %in% colnames(dat)){ + dat <- dat %>% filter(AREL == 'RELATED' & AESER == 'Y') + msg <- "AREL = 'RELATED'
AESER = 'Y'" + } else if("AREL" %in% colnames(dat) & !("AESER" %in% colnames(dat))){ + dat <- dat %>% filter(AREL == 'RELATED') + msg <- "AREL = 'RELATED'
Variable 'AESER' doesn't exist in ADAE. STAN table not displayed because filter \"AESER = 'Y'\" cannot be applied!" + stop("Variable 'AESER' doesn't exist in ADAE. STAN table not displayed because filter \"AESER = 'Y'\" cannot be applied!") + } else if(!("AREL" %in% colnames(dat)) & "AESER" %in% colnames(dat)){ + dat <- dat %>% filter(AESER == 'Y') + msg <- "Variable 'AREL' doesn't exist in ADAE. STAN table not displayed because filter \"AREL = 'RELATED'\" cannot be applied!
AESER = 'Y'" + stop("Variable 'AREL' doesn't exist in ADAE. STAN table not displayed because filter \"AREL = 'RELATED'\" cannot be applied!") + } else{ + msg <- "Variables 'AREL' & 'AESER' do not exist in ADAE. STAN table not displayed because filters \"AREL = 'RELATED'\" and \"AESER = 'Y'\" cannot be applied!" + stop(msg) + } + + if("TRTEMFL" %in% colnames(dat)){ + dat <- dat %>% filter(TRTEMFL == 'Y') + msg <- paste0(msg, "
TRTEMFL = 'Y'") + } else { + msg <- paste0(msg, "
Variable 'TRTEMFL' doesn't exist in ADAE. STAN table not displayed because filter \"TRTEMFL = 'Y'\" cannot be applied!") + stop(msg) + } + + list(data = dat, message = msg) +} + +filter_adae.stan_34 <- function(recipe, datalist, ADSL) { + dat <- clean_ADAE(datafile = datalist, ADSL = ADSL) + msg <- "" + + if("AEACN" %in% colnames(dat)){ + dat <- dat %>% filter(AEACN == 'DRUG WITHDRAWN') + msg <- "AEACN = 'DRUG WITHDRAWN'" + } else{ + msg <- "Variable 'AEACN' doesn't exist in ADAE. STAN table not displayed because filter \"AEACN = 'DRUG WITHDRAWN'\" cannot be applied!" + stop(msg) + } + + list(data = dat, message = msg) +} + +filter_adae.stan_36 <- function(recipe, datalist, ADSL) { + dat <- clean_ADAE(datafile = datalist, ADSL = ADSL) + msg <- "" + + if("AEACNOTH" %in% colnames(dat)){ + dat <- dat %>% + filter(stringr::str_detect(tolower(AEACNOTH),"withdrawal") & + stringr::str_detect(tolower(AEACNOTH),"study")) + msg <- "AEACNOTH Contains 'withdrawal' and 'study'" + } else{ + msg <- "Variable 'AEACNOTH' doesn't exist in ADAE. STAN table not displayed because filter \"AEACNOTH Contains 'withdrawal' and 'study'\" cannot be applied!" + stop(msg) + } + + list(data = dat, message = msg) +} + +filter_adae.stan_38 <- function(recipe, datalist, ADSL) { + dat <- clean_ADAE(datafile = datalist, ADSL = ADSL) + msg <- "" + + if("AEACN" %in% colnames(dat)){ + dat <- dat %>% filter(AEACN %in% c('DRUG INTERRUPTED', 'DRUG REDUCED', 'DOSE REDUCED', 'DRUG INCREASED', 'DOSE INCREASED')) + msg <- "AEACN IN ('DRUG INTERRUPTED', 'DOSE REDUCED', 'DOSE INCREASED')" + } else{ + msg <- "Variable 'AEACN' doesn't exist in ADAE. STAN table not displayed because filter \"AEACN IN ('DRUG INTERRUPTED', 'DOSE REDUCED', 'DOSE INCREASED')\" cannot be applied!" + stop(msg) + } + + list(data = dat, message = msg) +} + +filter_adae.stan_39 <- function(recipe, datalist, ADSL) { + dat <- clean_ADAE(datafile = datalist, ADSL = ADSL) + msg <- "" + + if("TRTEMFL" %in% colnames(dat)){ + dat <- dat %>% filter(TRTEMFL == 'Y') + msg <- "TRTEMFL = 'Y'" + }else { + msg <- "Variable 'TRTEMFL' doesn't exist in ADAE. STAN table not displayed because filter \"TRTEMFL = 'Y'\" cannot be applied!" + stop(msg) + } + + list(data = dat, message = msg) +} diff --git a/R/mod_tableGen_fct_filter_adsl.R b/R/mod_tableGen_fct_filter_adsl.R new file mode 100644 index 00000000..5cfec90e --- /dev/null +++ b/R/mod_tableGen_fct_filter_adsl.R @@ -0,0 +1,71 @@ +filter_adsl <- function(recipe, ADSL) { + UseMethod("filter_adsl", recipe) +} + +filter_adsl.default <- function(recipe, ADSL) { + dat <- ADSL + msg <- "" + list(data = dat, message = msg) +} + +filter_adsl.stan_3 <- function(recipe, ADSL) { + dat <- ADSL + msg <- "" + if("FASFL" %in% colnames(dat)){ + dat <- dat %>% filter(FASFL == 'Y') + msg <- "Population Set: FASFL = 'Y'" + } else { + if("ITTFL" %in% colnames(dat)){ + dat <- dat %>% filter(ITTFL == 'Y') + msg <- "Population Set: ITTFL = 'Y'" + } else { + msg <- "Variable 'FASFL' or 'ITTFL' doesn't exist in ADSL. STAN table not displayed because filter \"FASFL == 'Y'\" or \"ITTFL == 'Y'\"cannot be applied!" + stop(msg) + } + } + list(data = dat, message = msg) +} + +filter_adsl.stan_18 <- + filter_adsl.stan_19 <- + filter_adsl.stan_20 <- + filter_adsl.stan_21 <- + filter_adsl.stan_22 <- + filter_adsl.stan_23 <- + filter_adsl.stan_24 <- + filter_adsl.stan_25 <- + filter_adsl.stan_26 <- + filter_adsl.stan_27 <- + filter_adsl.stan_28 <- + filter_adsl.stan_29 <- + filter_adsl.stan_30 <- + filter_adsl.stan_31 <- + filter_adsl.stan_32 <- + filter_adsl.stan_33 <- + filter_adsl.stan_34 <- + filter_adsl.stan_35 <- + filter_adsl.stan_36 <- + filter_adsl.stan_37 <- + filter_adsl.stan_38 <- + filter_adsl.stan_39 <- + filter_adsl.stan_41 <- + filter_adsl.stan_42 <- + filter_adsl.stan_43 <- + filter_adsl.stan_44 <- + filter_adsl.stan_45 <- + filter_adsl.stan_46 <- + filter_adsl.stan_47 <- + filter_adsl.stan_51 <- + filter_adsl.stan_52 <- + filter_adsl.stan_53 <- function(recipe, ADSL) { + dat <- ADSL + msg <- "" + if("SAFFL" %in% colnames(dat)) { + dat <- dat %>% filter(SAFFL == 'Y') + msg <- "Population Set: SAFFL = 'Y'" + } else { + msg <- "Variable 'SAFFL' doesn't exist in ADSL. STAN table not displayed because filter \"SAFFL == 'Y'\" cannot be applied!" + stop(msg) + } + list(data = dat, message = msg) +} \ No newline at end of file diff --git a/R/mod_tableGen_fct_recipe_incl.R b/R/mod_tableGen_fct_recipe_incl.R index 7515f583..dc179dac 100644 --- a/R/mod_tableGen_fct_recipe_incl.R +++ b/R/mod_tableGen_fct_recipe_incl.R @@ -3,6 +3,7 @@ load_recipes <- function(recipe_file) { recipes <- jsonlite::read_json(recipe_file) for (i in seq_along(recipes)) { + class(recipes[[i]]) <- c(class(recipes[[i]]), names(recipes)[i]) class(recipes[[i]]$blocks) <- c(class(recipes[[i]]$blocks), recipes[[i]]$recipe_inclusion) for (j in seq_along(recipes[[i]]$blocks)) { class(recipes[[i]]$blocks[[j]]) <- c(class(recipes[[i]]$blocks), recipes[[i]]$blocks[[j]]$stat_options_fn) diff --git a/R/mod_tableGen_ui.R b/R/mod_tableGen_ui.R index 23424111..ffd13a97 100644 --- a/R/mod_tableGen_ui.R +++ b/R/mod_tableGen_ui.R @@ -40,7 +40,7 @@ mod_tableGen_ui <- function(id){ fluidRow(column(width = 12, div( id = "COLUMN-wrapper", - uiOutput(ns("grp_col_ui")) + selectInput(ns("COLUMN"), "Group Data By:", choices = "NONE", selected = "NONE") ), shinyUI(bootstrapPage( HTML('
}} From 14bb3ce458eae80e80e5969299a08c36d53b9602 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 30 Mar 2023 14:37:05 -0400 Subject: [PATCH 038/110] Add AVISIT function --- R/mod_tableGen_fct_methods.R | 40 ++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/R/mod_tableGen_fct_methods.R b/R/mod_tableGen_fct_methods.R index ac65e791..e29cf375 100644 --- a/R/mod_tableGen_fct_methods.R +++ b/R/mod_tableGen_fct_methods.R @@ -215,3 +215,43 @@ convertTGOutput <- function(aggs, blocks) { }) } } + +create_avisit <- function(datalist, bds_data) { + # prepare the AVISIT dropdown of the statistics blocks + # by converting them to a factor in the order of AVISITN + # this allows our dropdown to be in chronological order + avisit_words <- + if(any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))){ + purrr::map(bds_data, function(x) x %>% dplyr::select(AVISIT)) %>% + dplyr::bind_rows() %>% + dplyr::distinct(AVISIT) %>% + dplyr::pull() + } else { + NULL + } + + avisit_fctr <- + if(any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))){ + purrr::map(bds_data, function(x) x %>% dplyr::select(AVISITN)) %>% + dplyr::bind_rows() %>% + dplyr::distinct(AVISITN) %>% + dplyr::pull() + } else { + 1:2 + } + + if (is.null(avisit_words())) { + avisit_words <- c("fake_weeky","dummy_weeky") + } else { + awd <- tidyr::tibble(AVISIT = avisit_words, AVISITN = avisit_fctr) + avisit_words <- + awd %>% + dplyr::mutate(AVISIT = factor(AVISIT, + levels = awd[order(awd$AVISITN), "AVISIT"][[1]] %>% unique() )) %>% + dplyr::pull(AVISIT) %>% + unique() %>% + # Arrange by factor level (AVISITN) + sort() + } + avisit_words[avisit_words != ""] +} From 479aa4c433ddaf5a830e3f347dd4e08f03454fe3 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 30 Mar 2023 14:52:34 -0400 Subject: [PATCH 039/110] Implement `create_avisit()` --- R/blockData.R | 31 ++------------------ R/mod_tableGen.R | 55 ++---------------------------------- R/mod_tableGen_fct_methods.R | 26 +++++------------ 3 files changed, 11 insertions(+), 101 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 26745188..96b09c5b 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -62,38 +62,11 @@ table_blocks <- self$all_rows <- new_list - avisit_words <- - if(any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))){ - purrr::map(BDS, function(x) x %>% dplyr::select(AVISIT)) %>% - dplyr::bind_rows() %>% - dplyr::distinct(AVISIT) %>% - dplyr::pull() - } else { - NULL - } - - avisit_fctr <- - if(any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))){ - purrr::map(BDS, function(x) x %>% dplyr::select(AVISITN)) %>% - dplyr::bind_rows() %>% - dplyr::distinct(AVISITN) %>% - dplyr::pull() - } else { - 1:2 - } - private$my_weeks <- - if (is.null(avisit_words)) { + if (!any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))) { NULL } else { - awd <- tidyr::tibble(AVISIT = avisit_words, AVISITN = avisit_fctr) - avisit_words <- - awd %>% - dplyr::mutate(AVISIT = factor(AVISIT, - levels = awd[order(awd$AVISITN), "AVISIT"][[1]] %>% unique() )) %>% - dplyr::pull(AVISIT) %>% - unique() - avisit_words[avisit_words != ""] %>% + create_avisit(datalist, BDS) %>% as.vector() } diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index 57fe9dde..780b3064 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -198,62 +198,11 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL # prepare the AVISIT dropdown of the statistics blocks # by converting them to a factor in the order of AVISITN # this allows our dropdown to be in chronological order - avisit_words <- reactive({ - req(datafile()) - - if(any(purrr::map_lgl(datafile(), ~"AVISIT" %in% colnames(.x)))){ - purrr::map(BDS(), function(x) x %>% dplyr::select(AVISIT)) %>% - dplyr::bind_rows() %>% - dplyr::distinct(AVISIT) %>% - dplyr::pull() - } else { - NULL #c("fake_weeky","dummy_weeky") # DON'T use this comment part. - # It's handled in AVISIT() - } - - }) - - avisit_fctr <- reactive({ - req(datafile()) - req(any(purrr::map_lgl(datafile(), ~"AVISIT" %in% colnames(.x)))) - - if(any(purrr::map_lgl(datafile(), ~"AVISIT" %in% colnames(.x)))){ - purrr::map(BDS(), function(x) x %>% dplyr::select(AVISITN)) %>% - dplyr::bind_rows() %>% - dplyr::distinct(AVISITN) %>% - dplyr::pull() - } else { - 1:2 - } - - }) - AVISIT <- reactive({ req(datafile()) + req(any(purrr::map_lgl(datafile(), ~"AVISIT" %in% colnames(.x)))) - if (is.null(avisit_words())) { - avisit_words <- c("fake_weeky","dummy_weeky") - } else { - # for testing - # nums <- c(2,4,6,8,12,16,20,24,26) - # avisit_words <- function() c("", "Baseline",paste("Week", nums), "End of Treatment") - # avisit_fctr <- function()c(NA, 0, nums, 99) - # rm(nums, avisit_words, avisit_fctr) - - awd <- tidyr::tibble(AVISIT = avisit_words(), AVISITN = avisit_fctr()) - avisit_words <- - # tidyr::tibble(AVISIT = avisit_words(), AVISITN = avisit_fctr()) %>% - # dplyr::mutate(AVISIT = as.factor(AVISIT)) %>% - # dplyr::mutate(AVISIT = forcats::fct_reorder(AVISIT, AVISITN)) %>% - awd %>% - dplyr::mutate(AVISIT = factor(AVISIT, - levels = awd[order(awd$AVISITN), "AVISIT"][[1]] %>% unique() )) %>% - dplyr::pull(AVISIT) %>% - unique() %>% - # Arrange by factor level (AVISITN) - sort() - } - avisit_words[avisit_words != ""] + create_avisit(datafile(), BDS()) }) diff --git a/R/mod_tableGen_fct_methods.R b/R/mod_tableGen_fct_methods.R index e29cf375..1de52481 100644 --- a/R/mod_tableGen_fct_methods.R +++ b/R/mod_tableGen_fct_methods.R @@ -217,32 +217,21 @@ convertTGOutput <- function(aggs, blocks) { } create_avisit <- function(datalist, bds_data) { - # prepare the AVISIT dropdown of the statistics blocks - # by converting them to a factor in the order of AVISITN - # this allows our dropdown to be in chronological order - avisit_words <- - if(any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))){ + if (!any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))) + stop("The column AVISIT must be present in the data list") + + avisit_words <- purrr::map(bds_data, function(x) x %>% dplyr::select(AVISIT)) %>% dplyr::bind_rows() %>% dplyr::distinct(AVISIT) %>% dplyr::pull() - } else { - NULL - } - + avisit_fctr <- - if(any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))){ purrr::map(bds_data, function(x) x %>% dplyr::select(AVISITN)) %>% dplyr::bind_rows() %>% dplyr::distinct(AVISITN) %>% dplyr::pull() - } else { - 1:2 - } - - if (is.null(avisit_words())) { - avisit_words <- c("fake_weeky","dummy_weeky") - } else { + awd <- tidyr::tibble(AVISIT = avisit_words, AVISITN = avisit_fctr) avisit_words <- awd %>% @@ -250,8 +239,7 @@ create_avisit <- function(datalist, bds_data) { levels = awd[order(awd$AVISITN), "AVISIT"][[1]] %>% unique() )) %>% dplyr::pull(AVISIT) %>% unique() %>% - # Arrange by factor level (AVISITN) sort() - } + avisit_words[avisit_words != ""] } From 243212846632224476c57e04be462b09688b4398 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 30 Mar 2023 14:58:58 -0400 Subject: [PATCH 040/110] Implement `create_all_cols()` --- R/blockData.R | 11 +---------- R/mod_tableGen.R | 15 ++------------- R/mod_tableGen_fct_methods.R | 14 ++++++++++++++ 3 files changed, 17 insertions(+), 23 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 96b09c5b..d42b703a 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -71,16 +71,7 @@ table_blocks <- } private$all_cols <- - if("ADAE" %in% names(datalist)){ - unique(c( - colnames(datalist$ADSL)[sapply(datalist$ADSL, class) %in% c('character', 'factor')], - colnames(datalist$ADAE)[sapply(datalist$ADAE, class) %in% c('character', 'factor')] - )) - } else { # just adsl cols - unique(c( - colnames(datalist$ADSL)[sapply(datalist$ADSL, class) %in% c('character', 'factor')] - )) - } + create_all_cols(datalist) private$my_avals <- if (!any(purrr::map_lgl(datalist, ~ "ATPT" %in% colnames(.x)))) { diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index 780b3064..f9f01c7c 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -95,17 +95,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL categ_vars <- reactive({ req(datafile()) # this also doesn't need to depend on pre-filters, so grabbing root df cols - if("ADAE" %in% names(datafile())){ - all_cols <- unique(c( - colnames(datafile()$ADSL)[sapply(datafile()$ADSL, class) %in% c('character', 'factor')], - colnames(datafile()$ADAE)[sapply(datafile()$ADAE, class) %in% c('character', 'factor')] - )) - } else { # just adsl cols - all_cols <- unique(c( - colnames(datafile()$ADSL)[sapply(datafile()$ADSL, class) %in% c('character', 'factor')] - )) - } - return( all_cols ) + create_all_cols(datafile()) }) observe({ @@ -217,8 +207,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL # just character of factor vars from the ADSL or ADAE observe({ req(categ_vars()) - all_cols <- categ_vars() - session$sendCustomMessage("all_cols", all_cols) + session$sendCustomMessage("all_cols", categ_vars()) }) AVALS <- reactive({ diff --git a/R/mod_tableGen_fct_methods.R b/R/mod_tableGen_fct_methods.R index 1de52481..da9a8822 100644 --- a/R/mod_tableGen_fct_methods.R +++ b/R/mod_tableGen_fct_methods.R @@ -243,3 +243,17 @@ create_avisit <- function(datalist, bds_data) { avisit_words[avisit_words != ""] } + +create_all_cols <- function(datalist) { + if("ADAE" %in% names(datalist)){ + all_cols <- unique(c( + colnames(datalist$ADSL)[sapply(datalist$ADSL, class) %in% c('character', 'factor')], + colnames(datalist$ADAE)[sapply(datalist$ADAE, class) %in% c('character', 'factor')] + )) + } else { + all_cols <- unique(c( + colnames(datalist$ADSL)[sapply(datalist$ADSL, class) %in% c('character', 'factor')] + )) + } + all_cols +} From 564b3be454a24f76857dcc5917aec310bb096871 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 30 Mar 2023 15:05:56 -0400 Subject: [PATCH 041/110] Implement `create_avals()` --- R/blockData.R | 27 +-------------------------- R/mod_tableGen.R | 28 +--------------------------- R/mod_tableGen_fct_methods.R | 35 ++++++++++++++++++++++++++++++++++- 3 files changed, 36 insertions(+), 54 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index d42b703a..c220bc55 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -77,32 +77,7 @@ table_blocks <- if (!any(purrr::map_lgl(datalist, ~ "ATPT" %in% colnames(.x)))) { list() } else { - atpt_datasets <- purrr::map_lgl(datalist, ~ "ATPT" %in% colnames(.x)) - - avals <- - purrr::map(datalist[atpt_datasets], ~ .x %>% - dplyr::select(PARAMCD, dplyr::any_of(c("ATPT"))) %>% - dplyr::filter(dplyr::if_any(-PARAMCD, ~ !is.na(.x) & .x != "")) %>% - dplyr::pull(PARAMCD) %>% - get_levels() - ) - - purrr::imap(avals, ~ purrr::map(.x, function(i, j =.y) { - datalist[[j]] %>% - dplyr::filter(PARAMCD == i) %>% - dplyr::select(dplyr::any_of(c("ATPT", "ATPTN"))) %>% - varN_fctr_reorder() %>% - dplyr::select(dplyr::any_of(c("ATPT"))) %>% - purrr::map(~ .x %>% - addNA(ifany = TRUE) %>% - purrr::possibly(relevel, otherwise = .)(NA_character_) %>% - get_levels() %>% - tidyr::replace_na("N/A") %>% - {if (length(.) > 1) c("ALL", .) else .} %>% - as.list()) - }) %>% - purrr::set_names(.x) - ) + create_avals(datalist) } }, diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index f9f01c7c..c398b57e 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -214,33 +214,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL req(datafile()) req(purrr::map_lgl(datafile(), ~ "ATPT" %in% colnames(.x))) - atpt_datasets <- purrr::map_lgl(datafile(), ~ "ATPT" %in% colnames(.x)) - - avals <- - purrr::map(datafile()[atpt_datasets], ~ .x %>% - dplyr::select(PARAMCD, dplyr::any_of(c("ATPT"))) %>% - dplyr::filter(dplyr::if_any(-PARAMCD, ~ !is.na(.x) & .x != "")) %>% - dplyr::pull(PARAMCD) %>% - get_levels() - ) - - ## TODO: Make this less confusing. I pity the soul who has to edit this. - purrr::imap(avals, ~ purrr::map(.x, function(i, j =.y) { - datafile()[[j]] %>% - dplyr::filter(PARAMCD == i) %>% - dplyr::select(dplyr::any_of(c("ATPT", "ATPTN"))) %>% - varN_fctr_reorder() %>% - dplyr::select(dplyr::any_of(c("ATPT"))) %>% - purrr::map(~ .x %>% - addNA(ifany = TRUE) %>% - purrr::possibly(relevel, otherwise = .)(NA_character_) %>% - get_levels() %>% - tidyr::replace_na("N/A") %>% - {if (length(.) > 1) c("ALL", .) else .} %>% - as.list()) - }) %>% - purrr::set_names(.x) - ) + create_avals(datafile()) }) observe({ diff --git a/R/mod_tableGen_fct_methods.R b/R/mod_tableGen_fct_methods.R index da9a8822..8f5dddcd 100644 --- a/R/mod_tableGen_fct_methods.R +++ b/R/mod_tableGen_fct_methods.R @@ -218,7 +218,7 @@ convertTGOutput <- function(aggs, blocks) { create_avisit <- function(datalist, bds_data) { if (!any(purrr::map_lgl(datalist, ~"AVISIT" %in% colnames(.x)))) - stop("The column AVISIT must be present in the data list") + stop("The field AVISIT must be present in the data list") avisit_words <- purrr::map(bds_data, function(x) x %>% dplyr::select(AVISIT)) %>% @@ -257,3 +257,36 @@ create_all_cols <- function(datalist) { } all_cols } + +create_avals <- function(datalist) { + if (!any(purrr::map_lgl(datalist, ~ "ATPT" %in% colnames(.x)))) + stop("The field ATPT must be present in the data list") + + atpt_datasets <- purrr::map_lgl(datalist, ~ "ATPT" %in% colnames(.x)) + + avals <- + purrr::map(datalist[atpt_datasets], ~ .x %>% + dplyr::select(PARAMCD, dplyr::any_of(c("ATPT"))) %>% + dplyr::filter(dplyr::if_any(-PARAMCD, ~ !is.na(.x) & .x != "")) %>% + dplyr::pull(PARAMCD) %>% + get_levels() + ) + + ## TODO: Make this less confusing. I pity the soul who has to edit this. + purrr::imap(avals, ~ purrr::map(.x, function(i, j =.y) { + datalist[[j]] %>% + dplyr::filter(PARAMCD == i) %>% + dplyr::select(dplyr::any_of(c("ATPT", "ATPTN"))) %>% + varN_fctr_reorder() %>% + dplyr::select(dplyr::any_of(c("ATPT"))) %>% + purrr::map(~ .x %>% + addNA(ifany = TRUE) %>% + purrr::possibly(relevel, otherwise = .)(NA_character_) %>% + get_levels() %>% + tidyr::replace_na("N/A") %>% + {if (length(.) > 1) c("ALL", .) else .} %>% + as.list()) + }) %>% + purrr::set_names(.x) + ) +} From 8a4ae388d9505c68795500a69e1e0e960bd5d9d2 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 30 Mar 2023 15:25:24 -0400 Subject: [PATCH 042/110] Fix issue with example for `addBlock()` --- R/blockData.R | 2 +- man/addBlock.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index c220bc55..a0d05fc7 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -348,7 +348,7 @@ createBlockdata <- function(datalist) { #' bd #' } #' -#' addBlock(bd, "DIABP", "MEAN", "ALL") +#' addBlock(bd, "DIABP", "MEAN", "ALL", "ALL") #' bd addBlock <- function(bd, variable, stat, dropdown, tpnt, df) { bd$add_block(variable = variable, stat = stat, dropdown = dropdown, tpnt = tpnt, df = df) diff --git a/man/addBlock.Rd b/man/addBlock.Rd index 4fde6c76..9ded602d 100644 --- a/man/addBlock.Rd +++ b/man/addBlock.Rd @@ -36,6 +36,6 @@ if (interactive()) { bd } -addBlock(bd, "DIABP", "MEAN", "ALL") +addBlock(bd, "DIABP", "MEAN", "ALL", "ALL") bd } From 11e4984113455749bde21eae4a3e542d16e44c9e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 30 Mar 2023 16:43:53 -0400 Subject: [PATCH 043/110] Create options group if block options are an object --- inst/app/www/recipe.js | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/inst/app/www/recipe.js b/inst/app/www/recipe.js index c31b319e..b07e8158 100644 --- a/inst/app/www/recipe.js +++ b/inst/app/www/recipe.js @@ -3,7 +3,20 @@ $(document).ready(function(){ /* Function to create list of row blocks. If we need a block with a text String or a dropdown, make a new function here */ function createRecipeBlock(newid, df, selection, options) { - let values = Array.isArray(options) ? options.map(createOption).join("") : '' + let values = '' + if (Array.isArray(options)) { + values = options.map(createOption).join("") + } else if (typeof options === "object") { + for (i in options) { + values = [''] + values.push(""); + values.push($.map(options[i], createOption).join("")); + values.push(""); + } + } else { + values = '' + } + //Array.isArray(options) ? options.map(createOption).join("") : '' return `
` + `` + (selection === undefined ? `` : `` + From edc3373728611efe496b83c930a2fc066a6d69f9 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 30 Mar 2023 16:51:19 -0400 Subject: [PATCH 047/110] Little reorganization of js and css files --- dev/run_dev.R | 2 +- inst/app/www/{ => css}/styles.css | 0 inst/app/www/{ => css}/timevis.css | 0 inst/app/www/{ => css}/timevis.sass | 0 inst/app/www/{ => css}/yeti.css | 0 inst/app/www/{ => js}/accordian.js | 0 inst/app/www/{ => js}/recipe.js | 0 inst/app/www/{ => js}/script.js | 0 inst/app/www/{ => js}/sync_divs.js | 0 9 files changed, 1 insertion(+), 1 deletion(-) rename inst/app/www/{ => css}/styles.css (100%) rename inst/app/www/{ => css}/timevis.css (100%) rename inst/app/www/{ => css}/timevis.sass (100%) rename inst/app/www/{ => css}/yeti.css (100%) rename inst/app/www/{ => js}/accordian.js (100%) rename inst/app/www/{ => js}/recipe.js (100%) rename inst/app/www/{ => js}/script.js (100%) rename inst/app/www/{ => js}/sync_divs.js (100%) diff --git a/dev/run_dev.R b/dev/run_dev.R index c8767797..39c9f290 100644 --- a/dev/run_dev.R +++ b/dev/run_dev.R @@ -1,5 +1,5 @@ # Sass code compilation -sass::sass(input = sass::sass_file("inst/app/www/timevis.sass"), output = "inst/app/www/timevis.css", cache = NULL) +sass::sass(input = sass::sass_file("inst/app/www/css/timevis.sass"), output = "inst/app/www/css/timevis.css", cache = NULL) # Set options here options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mode diff --git a/inst/app/www/styles.css b/inst/app/www/css/styles.css similarity index 100% rename from inst/app/www/styles.css rename to inst/app/www/css/styles.css diff --git a/inst/app/www/timevis.css b/inst/app/www/css/timevis.css similarity index 100% rename from inst/app/www/timevis.css rename to inst/app/www/css/timevis.css diff --git a/inst/app/www/timevis.sass b/inst/app/www/css/timevis.sass similarity index 100% rename from inst/app/www/timevis.sass rename to inst/app/www/css/timevis.sass diff --git a/inst/app/www/yeti.css b/inst/app/www/css/yeti.css similarity index 100% rename from inst/app/www/yeti.css rename to inst/app/www/css/yeti.css diff --git a/inst/app/www/accordian.js b/inst/app/www/js/accordian.js similarity index 100% rename from inst/app/www/accordian.js rename to inst/app/www/js/accordian.js diff --git a/inst/app/www/recipe.js b/inst/app/www/js/recipe.js similarity index 100% rename from inst/app/www/recipe.js rename to inst/app/www/js/recipe.js diff --git a/inst/app/www/script.js b/inst/app/www/js/script.js similarity index 100% rename from inst/app/www/script.js rename to inst/app/www/js/script.js diff --git a/inst/app/www/sync_divs.js b/inst/app/www/js/sync_divs.js similarity index 100% rename from inst/app/www/sync_divs.js rename to inst/app/www/js/sync_divs.js From 3993e42f9c70e8c4c47708d24d44658d4d1bd18f Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 08:10:30 -0400 Subject: [PATCH 048/110] Update NEWS --- DESCRIPTION | 2 +- NEWS.md | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index ec0289b5..cf7eeb0d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: tidyCDISC Title: Quick Table Generation & Exploratory Analyses on ADaM-Ish Datasets -Version: 0.2.1.9001 +Version: 0.2.1.9002 Authors@R: c( person("Aaron", "Clark", , "clark.aaronchris@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-0123-0970")), diff --git a/NEWS.md b/NEWS.md index 481ce955..c0204f57 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ * Moved "recipe" for standard table creation from JavaScript to JSON file (#167) * Improved code determining which standard tables to provide as options based on data uploaded (#167) * Fixed bug causing standard tables to run twice when grouping selected (#167) +* Added var option functionality to "recipe" creation # tidyCDISC 0.2.1 (CRAN Release) From e511c3471df222e312a597f04bf452bbd66093e0 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 09:42:33 -0400 Subject: [PATCH 049/110] Add tests for blockData --- tests/testthat/test-blockData.R | 117 ++++++++++++++++++++++++++++++++ 1 file changed, 117 insertions(+) create mode 100644 tests/testthat/test-blockData.R diff --git a/tests/testthat/test-blockData.R b/tests/testthat/test-blockData.R new file mode 100644 index 00000000..b1715afc --- /dev/null +++ b/tests/testthat/test-blockData.R @@ -0,0 +1,117 @@ +table_blocks_tester <- R6::R6Class( + inherit = table_blocks, + public = list( + test_stats = function(expected) { + expect_equal(private$stats, expected) + }, + test_my_weeks = function(expected) { + expect_equal(private$my_weeks, expected) + }, + test_all_cols = function(expected) { + expect_equal(sort(private$all_cols), sort(expected)) + }, + test_my_avals = function(expected) { + expect_equal(private$my_avals, expected) + }, + test_block_drop = function(expected) { + expect_equal(private$block_drop, expected) + }, + test_agg_drop = function(expected) { + expect_equal(private$agg_drop, expected) + } + ) +) + +test_that("table_blocks is working", { + datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs) + + test_bd <- table_blocks_tester$new(datalist) + + # Check initialization values + expect_equal(nrow(test_bd$blocks), 0) + + stats <- c("ANOVA", "CHG", "MEAN", "FREQ", "Y_FREQ", "MAX_FREQ", "NON_MISSING", "NESTED_FREQ_DSC", "NESTED_FREQ_ABC") + test_bd$test_stats(stats) + + weeks <- c("Baseline", "Week 2", "Week 4", "Week 6", "Week 8", "Week 12", "Week 16", "Week 20", "Week 24", "Week 26", "End of Treatment") + test_bd$test_my_weeks(weeks) + + all_cols <- c("STUDYID", "USUBJID", "SUBJID", "SITEID", "SITEGR1", "ARM", "TRT01P", "TRT01A", "AGEGR1", "AGEU", "RACE", "SEX", "ETHNIC", "SAFFL", "ITTFL", "EFFFL", "COMP8FL", "COMP16FL", "COMP24FL", "DISCONFL", "DSRAEFL", "DTHFL", "BMIBLGR1", "DURDSGR1", "RFSTDTC", "RFENDTC", "DCDECOD", "EOSSTT", "DCSREAS", "FASFL", "RANDFL", "EOTSTT", "DCTREAS") + test_bd$test_all_cols(all_cols) + + avals <- list(ADVS = list(DIABP = list(ATPT = list("ALL", "AFTER LYING DOWN FOR 5 MINUTES", "AFTER STANDING FOR 1 MINUTE", "AFTER STANDING FOR 3 MINUTES")), + PULSE = list(ATPT = list("ALL", "AFTER LYING DOWN FOR 5 MINUTES", "AFTER STANDING FOR 1 MINUTE", "AFTER STANDING FOR 3 MINUTES")), + SYSBP = list(ATPT = list("ALL", "AFTER LYING DOWN FOR 5 MINUTES", "AFTER STANDING FOR 1 MINUTE", "AFTER STANDING FOR 3 MINUTES")))) + test_bd$test_my_avals(avals) + + test_bd$test_block_drop(list()) + + test_bd$test_agg_drop(list()) + + # Check addition of a block + test_bd$add_block("DIABP", "MEAN", "ALL", "ALL") + + expect_equal(nrow(test_bd$blocks), 33) + + expected_blocks <- list(txt = "DIABP", df = "ADVS", grp = "ATPT", val = "ALL", lst = c("AFTER LYING DOWN FOR 5 MINUTES", "AFTER STANDING FOR 1 MINUTE", "AFTER STANDING FOR 3 MINUTES")) + expected_aggs <- list(txt = "MEAN", val = "ALL", lst = weeks) + expected_drops <- process_droppables(list(list(expected_aggs)), list(list(expected_blocks))) + test_bd$test_block_drop(expected_drops$blocks) + test_bd$test_agg_drop(expected_drops$aggs) + + # Check removal of lines + test_bd$remove_block(-(1:3)) + + expect_equal(nrow(test_bd$blocks), 3) + + expected_blocks <- list(txt = "DIABP", df = "ADVS", grp = "ATPT", val = "ALL", lst = c("AFTER LYING DOWN FOR 5 MINUTES", "AFTER STANDING FOR 1 MINUTE", "AFTER STANDING FOR 3 MINUTES")) + expected_aggs <- list(txt = "MEAN", val = "ALL", lst = weeks[1]) + expected_drops <- process_droppables(list(list(expected_aggs)), list(list(expected_blocks))) + test_bd$test_block_drop(expected_drops$blocks) + test_bd$test_agg_drop(expected_drops$aggs) + +}) + +test_that("table_block wrappers work", { + datalist <- list(ADSL = tidyCDISC::adsl) + + bd <- createBlockdata(datalist) + + expect_equal(nrow(bd$blocks), 0) + + bd |> + addBlock("RANDFL", "Y_FREQ") |> + addBlock("EOSSTT", "NESTED_FREQ_ABC", "DCSREAS") + + block_table <- + structure(list(agg = c("Y_FREQ", "NESTED_FREQ_ABC"), + block = c("RANDFL", "EOSSTT"), + dataset = c("ADSL", "ADSL"), + dropdown = c(NA, "DCSREAS"), + filter = c(NA_character_, NA_character_), + S3 = list(structure("RANDFL", class = c("character", "ADSL")), + structure("EOSSTT", class = c("character", "ADSL"))), + gt_group = structure(c("Y_FREQ of RANDFL", "NESTED_FREQ_ABC of EOSSTT and DCSREAS"), + class = c("glue", "character")), + label = c("N/A", "N/A"), + label_source = c("N/A", "N/A")), + row.names = c(NA, -2L), + class = c("tbl_df", "tbl", "data.frame")) + expect_equal(bd$blocks, block_table) + + removeBlock(bd, 1) + + block_table <- + structure(list(agg = "NESTED_FREQ_ABC", + block = "EOSSTT", + dataset = "ADSL", + dropdown = "DCSREAS", + filter = NA_character_, + S3 = list(structure("EOSSTT", class = c("character", "ADSL"))), + gt_group = structure("NESTED_FREQ_ABC of EOSSTT and DCSREAS", class = c("glue", "character")), + label = "N/A", + label_source = "N/A"), + row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")) + expect_equal(bd$blocks, block_table) + +}) \ No newline at end of file From 794ab2c698d4afca3444e2beb10707ba8f878687 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 10:24:17 -0400 Subject: [PATCH 050/110] Import R6 --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index ec0289b5..4fa7e5fe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -53,6 +53,7 @@ Imports: jsonlite, plotly, purrr, + R6, rlang, rmarkdown, shiny, From 923c1d52f23aacbf6032f3b674b96391fd669334 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 10:24:59 -0400 Subject: [PATCH 051/110] Add blockData function references to pkgdown site --- R/blockData.R | 6 ++- _pkgdown.yml | 3 ++ man/addBlock.Rd | 3 +- man/createBlockdata.Rd | 1 + man/removeBlock.Rd | 1 + man/table_blocks.Rd | 118 ----------------------------------------- 6 files changed, 12 insertions(+), 120 deletions(-) delete mode 100644 man/table_blocks.Rd diff --git a/R/blockData.R b/R/blockData.R index a0d05fc7..292fd089 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -1,4 +1,5 @@ #' import R6 +#' @noRd table_blocks <- R6::R6Class("table_blocks", list( @@ -313,6 +314,7 @@ table_blocks <- #' @return A block data object #' #' @export +#' @keywords table_blocks #' #' @examples #' @@ -336,6 +338,7 @@ createBlockdata <- function(datalist) { #' @return The \code{bd} block data object with additional block #' #' @export +#' @keywords table_blocks #' #' @examples #' @@ -343,7 +346,7 @@ createBlockdata <- function(datalist) { #' ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) #' bd <- createBlockdata(datalist) #' -#' if (interactive()) { +#' \dontrun { #' addBlock(bd) #' bd #' } @@ -362,6 +365,7 @@ addBlock <- function(bd, variable, stat, dropdown, tpnt, df) { #' @return The \code{bd} block data object with additional block #' #' @export +#' @keywords table_blocks removeBlock <- function(bd, x) { bd$remove_block(x = x) } diff --git a/_pkgdown.yml b/_pkgdown.yml index 3f05bcb2..f8a47d8d 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -44,6 +44,9 @@ reference: # desc: User friendly utility functions built for comparing app output with SAS produced outputs # contents: # - has_keyword("tabGen_compare") +- title: Block data functions + contents: + - has_keyword("table_blocks") - title: General helper functions contents: - has_keyword("helpers") diff --git a/man/addBlock.Rd b/man/addBlock.Rd index 9ded602d..2993c064 100644 --- a/man/addBlock.Rd +++ b/man/addBlock.Rd @@ -31,7 +31,7 @@ datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) bd <- createBlockdata(datalist) -if (interactive()) { +\dontrun { addBlock(bd) bd } @@ -39,3 +39,4 @@ if (interactive()) { addBlock(bd, "DIABP", "MEAN", "ALL", "ALL") bd } +\keyword{table_blocks} diff --git a/man/createBlockdata.Rd b/man/createBlockdata.Rd index 6dc8efa7..eedb9a59 100644 --- a/man/createBlockdata.Rd +++ b/man/createBlockdata.Rd @@ -22,3 +22,4 @@ datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, bd <- createBlockdata(datalist) bd } +\keyword{table_blocks} diff --git a/man/removeBlock.Rd b/man/removeBlock.Rd index 5c1b8337..811f2f1b 100644 --- a/man/removeBlock.Rd +++ b/man/removeBlock.Rd @@ -17,3 +17,4 @@ The \code{bd} block data object with additional block \description{ Remove Block(s) from Block Data Object } +\keyword{table_blocks} diff --git a/man/table_blocks.Rd b/man/table_blocks.Rd deleted file mode 100644 index 89073cc9..00000000 --- a/man/table_blocks.Rd +++ /dev/null @@ -1,118 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/blockData.R -\name{table_blocks} -\alias{table_blocks} -\title{import R6} -\description{ -import R6 - -import R6 -} -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{datalist}}{A list of ADaM-ish datasets used to generate the table} - -\item{\code{all_rows}}{A list of parameters/fields from the datalist with descriptions} - -\item{\code{blocks}}{A data frame containing the block data} -} -\if{html}{\out{
}} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-table_blocks-new}{\code{table_blocks$new()}} -\item \href{#method-table_blocks-print}{\code{table_blocks$print()}} -\item \href{#method-table_blocks-add_block}{\code{table_blocks$add_block()}} -\item \href{#method-table_blocks-remove_block}{\code{table_blocks$remove_block()}} -\item \href{#method-table_blocks-clone}{\code{table_blocks$clone()}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-table_blocks-new}{}}} -\subsection{Method \code{new()}}{ -Create a new block data object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{table_blocks$new(datalist)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{datalist}}{A list of ADaM-ish datasets used to generate the table} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-table_blocks-print}{}}} -\subsection{Method \code{print()}}{ -Print the data frame containing the blocks -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{table_blocks$print()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-table_blocks-add_block}{}}} -\subsection{Method \code{add_block()}}{ -Add block to the block data object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{table_blocks$add_block(variable, stat, dropdown, tpnt, df)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{variable}}{The parameter or field the statistic is based on} - -\item{\code{stat}}{The statistic to be calculated} - -\item{\code{dropdown}}{A subgroup on which the statistic is calculated (usually an AVISIT)} - -\item{\code{tpnt}}{A time point on which the calculation is filtered} - -\item{\code{df}}{The dataset the parameter or field is from} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-table_blocks-remove_block}{}}} -\subsection{Method \code{remove_block()}}{ -Remove block from the block data object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{table_blocks$remove_block(x)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{x}}{vector specifying elements to remove from block data object} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-table_blocks-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{table_blocks$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} From 157f111ad3e03581ec542af0e5732be41a244697 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 10:50:41 -0400 Subject: [PATCH 052/110] Update WORDLIST --- inst/WORDLIST | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/inst/WORDLIST b/inst/WORDLIST index 7679131e..96ef441d 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -23,6 +23,7 @@ CDISC CMD CSR Conf +DIABP DIY DT Downloader @@ -55,20 +56,20 @@ VARN VARN's YYYY adae +addBlock adlbc adsl adtte advs automagically +bd bdat bonafide boxPlot callModule checkGroup checkboxInput -cloneable codebase -datalist dev df draggable From 3809aa7bfb50fa0edcc0a775cffe64f707e394c6 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 13:03:52 -0400 Subject: [PATCH 053/110] Fix issues with spelling test --- R/blockData.R | 2 +- man/addBlock.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 292fd089..1484df19 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -346,7 +346,7 @@ createBlockdata <- function(datalist) { #' ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) #' bd <- createBlockdata(datalist) #' -#' \dontrun { +#' \dontrun{ #' addBlock(bd) #' bd #' } diff --git a/man/addBlock.Rd b/man/addBlock.Rd index 2993c064..fd4a85dc 100644 --- a/man/addBlock.Rd +++ b/man/addBlock.Rd @@ -31,7 +31,7 @@ datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) bd <- createBlockdata(datalist) -\dontrun { +\dontrun{ addBlock(bd) bd } From d37699793124547417335f95fcf2bf143810062e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 13:27:24 -0400 Subject: [PATCH 054/110] Import R6 --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 69b32878..c3bdb788 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -17,6 +17,7 @@ export(run_app) export(std_footnote) export(tg_gt) export(varN_fctr_reorder) +import(R6) import(dplyr) import(shiny) importFrom(GGally,ggsurv) From 535a29cafdd1c581ee4fd08812046f107e05974a Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 13:34:19 -0400 Subject: [PATCH 055/110] Add set title --- NAMESPACE | 1 + R/blockData.R | 41 +++++++++++++++++++++++++++++++++++++---- man/createBlockdata.Rd | 4 +++- man/setTitle.Rd | 20 ++++++++++++++++++++ 4 files changed, 61 insertions(+), 5 deletions(-) create mode 100644 man/setTitle.Rd diff --git a/NAMESPACE b/NAMESPACE index c3bdb788..ae527ffd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(prep_bds) export(pretty_IDs) export(removeBlock) export(run_app) +export(setTitle) export(std_footnote) export(tg_gt) export(varN_fctr_reorder) diff --git a/R/blockData.R b/R/blockData.R index 1484df19..bfd25e9d 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -1,4 +1,4 @@ -#' import R6 +#' @import R6 #' @noRd table_blocks <- R6::R6Class("table_blocks", @@ -18,12 +18,21 @@ table_blocks <- label = character(), label_source = character() ), + #' @field title A string used for table title + title = character(), #' @description #' Create a new block data object #' @param datalist A list of ADaM-ish datasets used to generate the table - initialize = function(datalist) { + #' @param title The title for the table + initialize = function(datalist, title) { self$datalist <- datalist + private$tbl_key <- paste("tbl", round(runif(1)*100000000), sep = "_") + if (missing(title) || length(title) != 1 || !is.character(title)) + title <- private$tbl_key + + self$title <- title + init <- sapply(datalist, function(x) "PARAMCD" %in% colnames(x) & !("CNSR" %in% colnames(x))) BDS <- datalist[init] @@ -89,6 +98,15 @@ table_blocks <- invisible(self) }, #' @description + #' Set the title for the table + #' @param title The title for the table + set_title = function(title) { + if (!group_by %in% private$all_cols) + stop("Invalid input. Title must be a string.") + + self$title <- title + }, + #' @description #' Add block to the block data object #' @param variable The parameter or field the statistic is based on #' @param stat The statistic to be calculated @@ -286,6 +304,7 @@ table_blocks <- } ), list( + tbl_key = character(), stats = c("ANOVA", "CHG", "MEAN", "FREQ", "Y_FREQ", "MAX_FREQ", "NON_MISSING", "NESTED_FREQ_DSC", "NESTED_FREQ_ABC"), my_weeks = NULL, all_cols = NULL, @@ -310,6 +329,7 @@ table_blocks <- #' Create Block Data Object #' #' @param datalist A list of ADaM-ish datasets used to generate the table +#' @param title The title for the table #' #' @return A block data object #' @@ -322,8 +342,21 @@ table_blocks <- #' ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) #' bd <- createBlockdata(datalist) #' bd -createBlockdata <- function(datalist) { - table_blocks$new(datalist = datalist) +createBlockdata <- function(datalist, title) { + table_blocks$new(datalist = datalist, title = title) +} + +#' Set the title for the table object +#' +#' @param bd A block data object +#' @param title The title for the table +#' +#' @return The \code{bd} block data object with supplied title +#' +#' @export +#' @keywords table_blocks +setTitle <- function(bd, title) { + bd$set_title(title = title) } #' Add Block to Block Data Object diff --git a/man/createBlockdata.Rd b/man/createBlockdata.Rd index eedb9a59..5e8df007 100644 --- a/man/createBlockdata.Rd +++ b/man/createBlockdata.Rd @@ -4,10 +4,12 @@ \alias{createBlockdata} \title{Create Block Data Object} \usage{ -createBlockdata(datalist) +createBlockdata(datalist, title) } \arguments{ \item{datalist}{A list of ADaM-ish datasets used to generate the table} + +\item{title}{The title for the table} } \value{ A block data object diff --git a/man/setTitle.Rd b/man/setTitle.Rd new file mode 100644 index 00000000..4e75bec7 --- /dev/null +++ b/man/setTitle.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/blockData.R +\name{setTitle} +\alias{setTitle} +\title{Set the title for the table object} +\usage{ +setTitle(bd, title) +} +\arguments{ +\item{bd}{A block data object} + +\item{title}{The title for the table} +} +\value{ +The \code{bd} block data object with supplied title +} +\description{ +Set the title for the table object +} +\keyword{table_blocks} From 1eb77cc7a1dfae97cfa138430c12b23044a6cb17 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 13:34:38 -0400 Subject: [PATCH 056/110] Add set group --- NAMESPACE | 1 + R/blockData.R | 29 +++++++++++++++++++++++++++++ man/setGroup.Rd | 20 ++++++++++++++++++++ 3 files changed, 50 insertions(+) create mode 100644 man/setGroup.Rd diff --git a/NAMESPACE b/NAMESPACE index ae527ffd..a0c10196 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(prep_bds) export(pretty_IDs) export(removeBlock) export(run_app) +export(setGroup) export(setTitle) export(std_footnote) export(tg_gt) diff --git a/R/blockData.R b/R/blockData.R index bfd25e9d..04d3ecf2 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -20,6 +20,8 @@ table_blocks <- ), #' @field title A string used for table title title = character(), + #' @field group_by A string indicating the field to use for grouping the table + group_by = NULL, #' @description #' Create a new block data object #' @param datalist A list of ADaM-ish datasets used to generate the table @@ -107,6 +109,15 @@ table_blocks <- self$title <- title }, #' @description + #' Set the group by field + #' @param group_by A field to group the table by + set_groupby = function(group_by) { + if (length(title) != 1 || !is.character(title)) + stop("Invalid input. Must be a column from a data set in the data list.") + + self$group_by <- group_by + }, + #' @description #' Add block to the block data object #' @param variable The parameter or field the statistic is based on #' @param stat The statistic to be calculated @@ -301,6 +312,11 @@ table_blocks <- private$create_TG(private$agg_drop, private$block_drop) self + }, + #' @description + #' Export the table metadata as a JSON for 'recipe' inclusion + json_export = function() { + } ), list( @@ -359,6 +375,19 @@ setTitle <- function(bd, title) { bd$set_title(title = title) } +#' Set the title for the table object +#' +#' @param bd A block data object +#' @param group_by A field to group the table by +#' +#' @return The \code{bd} block data object with updated group by field +#' +#' @export +#' @keywords table_blocks +setGroup <- function(bd, group_by) { + bd$set_groupby(group_by = group_by) +} + #' Add Block to Block Data Object #' #' @param bd A block data object diff --git a/man/setGroup.Rd b/man/setGroup.Rd new file mode 100644 index 00000000..2a668826 --- /dev/null +++ b/man/setGroup.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/blockData.R +\name{setGroup} +\alias{setGroup} +\title{Set the title for the table object} +\usage{ +setGroup(bd, group_by) +} +\arguments{ +\item{bd}{A block data object} + +\item{group_by}{A field to group the table by} +} +\value{ +The \code{bd} block data object with updated group by field +} +\description{ +Set the title for the table object +} +\keyword{table_blocks} From 35c61259133b08e81ebd61c5f3074df36f5cc984 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 14:38:49 -0400 Subject: [PATCH 057/110] Add JSON export functionality --- NAMESPACE | 3 +++ R/blockData.R | 31 ++++++++++++++++++++++++++++++- man/writeJSON.Rd | 17 +++++++++++++++++ 3 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 man/writeJSON.Rd diff --git a/NAMESPACE b/NAMESPACE index a0c10196..cd4a111a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,6 +19,7 @@ export(setTitle) export(std_footnote) export(tg_gt) export(varN_fctr_reorder) +export(writeJSON) import(R6) import(dplyr) import(shiny) @@ -72,6 +73,8 @@ importFrom(haven,read_sas) importFrom(haven,zap_formats) importFrom(haven,zap_label) importFrom(jsonlite,read_json) +importFrom(jsonlite,toJSON) +importFrom(jsonlite,write_json) importFrom(plotly,add_annotations) importFrom(plotly,config) importFrom(plotly,ggplotly) diff --git a/R/blockData.R b/R/blockData.R index 04d3ecf2..48080838 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -315,8 +315,26 @@ table_blocks <- }, #' @description #' Export the table metadata as a JSON for 'recipe' inclusion - json_export = function() { + #' @param file File or connection to write to + #' @importFrom jsonlite toJSON write_json + json_export = function(file) { + block_lst <- + purrr::map2(private$agg_drop, private$block_drop, + function(agg, block) { + out_lst <- list() + out_lst$data <- block$df + out_lst$variable <- block$txt + out_lst$var_arg <- block$val + out_lst$statistic <- agg$txt + out_lst$stat_arg <- agg$val + out_lst + }) + out_lst <- list() + out_lst[[private$tbl_key]] <- list(title = self$title) + out_lst[[1]]$group_by <- self$group_by + out_lst[[1]]$blocks <- block_lst + jsonlite::write_json(path = file, out_lst, auto_unbox = TRUE, pretty = TRUE) } ), list( @@ -431,3 +449,14 @@ addBlock <- function(bd, variable, stat, dropdown, tpnt, df) { removeBlock <- function(bd, x) { bd$remove_block(x = x) } + +#' Write block data object to a JSON file +#' +#' @param bd A block data object +#' @param file File or connection to write to +#' +#' @export +#' @keywords table_blocks +writeJSON <- function(bd, file) { + bd$json_export(file = file) +} diff --git a/man/writeJSON.Rd b/man/writeJSON.Rd new file mode 100644 index 00000000..1a4162e5 --- /dev/null +++ b/man/writeJSON.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/blockData.R +\name{writeJSON} +\alias{writeJSON} +\title{Write block data object to a JSON file} +\usage{ +writeJSON(bd, file) +} +\arguments{ +\item{bd}{A block data object} + +\item{file}{File or connection to write to} +} +\description{ +Write block data object to a JSON file +} +\keyword{table_blocks} From 19989fff65d5c227d2a43c2ab8c73afc149e5f8e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 15:58:58 -0400 Subject: [PATCH 058/110] Allow selection of options in recipes --- inst/app/www/js/recipe.js | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/inst/app/www/js/recipe.js b/inst/app/www/js/recipe.js index 8939422b..b0dbbced 100644 --- a/inst/app/www/js/recipe.js +++ b/inst/app/www/js/recipe.js @@ -3,24 +3,23 @@ $(document).ready(function(){ /* Function to create list of row blocks. If we need a block with a text String or a dropdown, make a new function here */ function createRecipeBlock(newid, df, selection, options) { - let values = '' + let values = [''] if (Array.isArray(options)) { - values = options.map(createOption).join("") + values = options.map(function(x) {return createOption(x, selection)}) } else if (typeof options === "object") { for (i in options) { values = [''] values.push(""); - values.push($.map(options[i], createOption).join("")); + values.push($.map(options[i], function(x) {return createOption(x, selection)}).join("")); values.push(""); } - } else { - values = '' } + return `
` + `` + (selection === undefined ? `` : ``) + + (values.join('').search("`) + + `${values.join("")}`) + `` + `
` } @@ -29,8 +28,8 @@ function createRecipeBlock(newid, df, selection, options) { * Create dropdown menu from the array of AVISIT values * @param {avisit} the text and value of the option */ -function createOption(opt) { - return `` +function createOption(opt, selection) { + return selection === undefined || selection != opt ? `` : `` } Shiny.addCustomMessageHandler('submit_recipe', function(recipe) { From 6d6aaab6c623c4c28b62a9751ee672d4c898416c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 15:59:38 -0400 Subject: [PATCH 059/110] Make normal script.js behave similarly --- inst/app/www/js/script.js | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/inst/app/www/js/script.js b/inst/app/www/js/script.js index 9c9d8881..7a9ff7e3 100644 --- a/inst/app/www/js/script.js +++ b/inst/app/www/js/script.js @@ -31,6 +31,7 @@ $( document ).on('shiny:connected', function() { function setUpShiny(id, outputID, obj) { var obj = { numbers: [] } var str = ""; + var txt; var df; var grp; var val; var lst; $('#' + id).each(function() { txt = $(this).text() df = $(this).attr("class").split(" ")[1] @@ -132,7 +133,7 @@ selectChange("droppable_blocks", 'droppable_blocks label', 'tableGen_ui_1-block_ let weeks_array = null -let week_opts = '' +let week_opts = [''] /** * Function that brings in vectors from shiny and uses * them to create the appropriate style block for the agg chosen @@ -141,17 +142,16 @@ let week_opts = '' Shiny.addCustomMessageHandler('my_weeks', function(df) { // the dataframe column is imported as an array weeks_array = Object.values(df) - week_opts = `${weeks_array.map(createOption).join("")}` - //console.log("weeks_array[0]:", weeks_array[0]) + week_opts = weeks_array.map(createOption) }); let col_array = null -let col_opts = '' +let col_opts = [''] Shiny.addCustomMessageHandler('all_cols', function(cols) { // the dataframe column is imported as an array col_array = Object.values(cols) - col_opts = `${col_array.map(createOption).join("")}` + col_opts = col_array.map(createOption) }); /** @@ -206,7 +206,7 @@ $(function() {
` From 4b3a5aef39fafa4f47ab082782267a23f9538f6b Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 16:37:26 -0400 Subject: [PATCH 060/110] Clean up block data function returns --- R/blockData.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 48080838..5c298fac 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -107,6 +107,7 @@ table_blocks <- stop("Invalid input. Title must be a string.") self$title <- title + self }, #' @description #' Set the group by field @@ -115,7 +116,8 @@ table_blocks <- if (length(title) != 1 || !is.character(title)) stop("Invalid input. Must be a column from a data set in the data list.") - self$group_by <- group_by + self$group_by <- group_by + self }, #' @description #' Add block to the block data object @@ -390,7 +392,7 @@ createBlockdata <- function(datalist, title) { #' @export #' @keywords table_blocks setTitle <- function(bd, title) { - bd$set_title(title = title) + invisible(bd$set_title(title = title)) } #' Set the title for the table object @@ -403,7 +405,7 @@ setTitle <- function(bd, title) { #' @export #' @keywords table_blocks setGroup <- function(bd, group_by) { - bd$set_groupby(group_by = group_by) + invisible(bd$set_groupby(group_by = group_by)) } #' Add Block to Block Data Object @@ -434,7 +436,7 @@ setGroup <- function(bd, group_by) { #' addBlock(bd, "DIABP", "MEAN", "ALL", "ALL") #' bd addBlock <- function(bd, variable, stat, dropdown, tpnt, df) { - bd$add_block(variable = variable, stat = stat, dropdown = dropdown, tpnt = tpnt, df = df) + invisible(bd$add_block(variable = variable, stat = stat, dropdown = dropdown, tpnt = tpnt, df = df)) } #' Remove Block(s) from Block Data Object @@ -447,7 +449,7 @@ addBlock <- function(bd, variable, stat, dropdown, tpnt, df) { #' @export #' @keywords table_blocks removeBlock <- function(bd, x) { - bd$remove_block(x = x) + invisible(bd$remove_block(x = x)) } #' Write block data object to a JSON file From 269e9f749ca058db0ed52db37276f180e59d55fe Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 31 Mar 2023 16:45:36 -0400 Subject: [PATCH 061/110] Return option group for ATPT --- R/blockData.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/blockData.R b/R/blockData.R index 5c298fac..f25a5875 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -327,6 +327,7 @@ table_blocks <- out_lst$data <- block$df out_lst$variable <- block$txt out_lst$var_arg <- block$val + out_lst$var_options <- if (!is.null(block$val)) list(ATPT = as.list(block$val)) out_lst$statistic <- agg$txt out_lst$stat_arg <- agg$val out_lst From 2b7bad26bb7d17b7bcab372c001526a561114861 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 18 Apr 2023 13:28:55 -0400 Subject: [PATCH 062/110] Replace `_arg` with `_selection` --- R/mod_tableGen_fct_param_opts.R | 4 +- inst/app/www/js/recipe.js | 4 +- inst/recipes.json | 110 ++++++++++++++++---------------- vignettes/dev04_RECIPES.Rmd | 4 +- 4 files changed, 61 insertions(+), 61 deletions(-) diff --git a/R/mod_tableGen_fct_param_opts.R b/R/mod_tableGen_fct_param_opts.R index bfc69730..3bcb8227 100644 --- a/R/mod_tableGen_fct_param_opts.R +++ b/R/mod_tableGen_fct_param_opts.R @@ -4,7 +4,7 @@ stat_options <- function(block, datalist, ...) { stat_options.default <- function(block, datalist, ...) { if (is.null(block$stat_options)) - block$stat_options <- block$stat_arg + block$stat_options <- block$stat_selection block } @@ -52,7 +52,7 @@ var_options <- function(block, datalist, ...) { var_options.default <- function(block, datalist, ...) { if (is.null(block$var_options)) - block$var_options <- block$var_arg + block$var_options <- block$var_selection block } diff --git a/inst/app/www/js/recipe.js b/inst/app/www/js/recipe.js index b0dbbced..5acefc5b 100644 --- a/inst/app/www/js/recipe.js +++ b/inst/app/www/js/recipe.js @@ -38,8 +38,8 @@ Shiny.addCustomMessageHandler('submit_recipe', function(recipe) { if (Object.keys(recipe).includes("blocks")) { for(block of recipe.blocks){ - $("#droppable_blocks").append($(createRecipeBlock(block.variable, block.data, block.var_arg, block.var_options))); - $("#droppable_agg").append($(createRecipeBlock(block.statistic, block.data, block.stat_arg, block.stat_options))); + $("#droppable_blocks").append($(createRecipeBlock(block.variable, block.data, block.var_selection, block.var_options))); + $("#droppable_agg").append($(createRecipeBlock(block.statistic, block.data, block.stat_selection, block.stat_options))); } } diff --git a/inst/recipes.json b/inst/recipes.json index 11ee5876..04cf24f6 100644 --- a/inst/recipes.json +++ b/inst/recipes.json @@ -4,8 +4,8 @@ "group_by": "TRT01P", "blocks": [{"data":"ADSL", "variable":"RANDFL", "statistic":"Y_FREQ"}, {"data":"ADSL", "variable":"SAFFL", "statistic":"FREQ"}, - {"data":"ADSL", "variable":"EOTSTT", "statistic":"NESTED_FREQ_ABC", "stat_arg":"DCTREAS"}, - {"data":"ADSL", "variable":"EOSSTT", "statistic":"NESTED_FREQ_ABC", "stat_arg":"DCSREAS"}] + {"data":"ADSL", "variable":"EOTSTT", "statistic":"NESTED_FREQ_ABC", "stat_selection":"DCTREAS"}, + {"data":"ADSL", "variable":"EOSSTT", "statistic":"NESTED_FREQ_ABC", "stat_selection":"DCSREAS"}] }, "stan_5": { "title": "Table 5: Demography", @@ -30,132 +30,132 @@ "title": "Table 19: Adverse events by system organ class and preferred term sorted by decreasing frequency", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_selection":"AEDECOD"}] }, "stan_20": { "title": "Table 20: Adverse events by system organ class and preferred term sorted by alphabetical order", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "stat_arg":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "stat_selection":"AEDECOD"}] }, "stan_21": { "title": "Table 21: Adverse events by system organ class", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "stat_arg":"NONE"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_ABC", "stat_selection":"NONE"}] }, "stan_23": { "title": "Table 23: Adverse events by preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "stat_arg":"NONE"}] + {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "stat_selection":"NONE"}] }, "stan_25": { "title": "Table 25: Severe adverse events by system organ class and preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_selection":"AEDECOD"}] }, "stan_26": { "title": "Table 26: Severe adverse events by preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "stat_arg":"NONE"}] + {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "stat_selection":"NONE"}] }, "stan_29": { "title": "Table 29: Related adverse events by system organ class and preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_selection":"AEDECOD"}] }, "stan_30": { "title": "Table 30: Serious adverse events by system organ class and preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_selection":"AEDECOD"}] }, "stan_31": { "title": "Table 31: Serious adverse events by preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "stat_arg":"NONE"}] + {"data":"ADAE", "variable":"AEDECOD", "statistic":"NESTED_FREQ_ABC", "stat_selection":"NONE"}] }, "stan_33": { "title": "Table 33: Related serious adverse events by system organ class and preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_selection":"AEDECOD"}] }, "stan_34": { "title": "Table 34: Adverse events that led to discontinuation of study treatment by system organ class and preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_selection":"AEDECOD"}] }, "stan_36": { "title": "Table 36: Adverse events that led to withdrawl from study by system organ class and preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_selection":"AEDECOD"}] }, "stan_38": { "title": "Table 38: Adverse events that led to drug interrupted, dose reduced, or dose increased by system organ class and preferred term", "group_by": "TRT01P", "blocks": [{"data":"ADAE", "variable":"USUBJID", "statistic":"NON_MISSING"}, - {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_arg":"AEDECOD"}] + {"data":"ADAE", "variable":"AEBODSYS", "statistic":"NESTED_FREQ_DSC", "stat_selection":"AEDECOD"}] }, "stan_41_chem": { "title": "Table 41: Blood Chemistry actual values by visit", "group_by": "TRT01P", "recipe_inclusion": "stan_labs", - "blocks": [{"data":"ADLB", "variable":"ALT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"AST", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"ALP", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"BILI", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"GGT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"BUN", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"CREAT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"SODIUM", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"K", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"CL", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"BICARB", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"GLUC", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"CA", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"PHOS", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"ALB", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"CHOL", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"MG", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"TRIG", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"URATE", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}] + "blocks": [{"data":"ADLB", "variable":"ALT", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"AST", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"ALP", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"BILI", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"GGT", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"BUN", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"CREAT", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"SODIUM", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"K", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"CL", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"BICARB", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"GLUC", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"CA", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"PHOS", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"ALB", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"CHOL", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"MG", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"TRIG", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"URATE", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}] }, "stan_41_hema": { "title": "Table 41: Hematology actual values by visit", "group_by": "TRT01P", "recipe_inclusion": "stan_labs", - "blocks": [{"data":"ADLB", "variable":"LYM", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab_lab"}, - {"data":"ADLB", "variable":"NEUT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"MONO", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"EOS", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"BASO", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"RBC", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"HGB", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"HCT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"PLAT", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}] + "blocks": [{"data":"ADLB", "variable":"LYM", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab_lab"}, + {"data":"ADLB", "variable":"NEUT", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"MONO", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"EOS", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"BASO", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"RBC", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"HGB", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"HCT", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"PLAT", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}] }, "stan_41_urin": { "title": "Table 41: Urinalysis actual values by visit", "group_by": "TRT01P", "recipe_inclusion": "stan_labs", - "blocks": [{"data":"ADLB", "variable":"SPGRAV", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"PH", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"COLOR", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"OCCBLD", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"GLUCU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn":"avisit_lab"}, - {"data":"ADLB", "variable":"KETONES", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, - {"data":"ADLB", "variable":"PROTU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, - {"data":"ADLB", "variable":"MWBCQU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, - {"data":"ADLB", "variable":"MWBCU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, - {"data":"ADLB", "variable":"MRBCQU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}, - {"data":"ADLB", "variable":"MRBCU", "statistic":"MEAN", "stat_arg":"ALL", "stat_options_fn": "avisit_lab"}] + "blocks": [{"data":"ADLB", "variable":"SPGRAV", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"PH", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"COLOR", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"OCCBLD", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"GLUCU", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn":"avisit_lab"}, + {"data":"ADLB", "variable":"KETONES", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"PROTU", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"MWBCQU", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"MWBCU", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"MRBCQU", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn": "avisit_lab"}, + {"data":"ADLB", "variable":"MRBCU", "statistic":"MEAN", "stat_selection":"ALL", "stat_options_fn": "avisit_lab"}] } -} \ No newline at end of file +} diff --git a/vignettes/dev04_RECIPES.Rmd b/vignettes/dev04_RECIPES.Rmd index b8bf2fb4..228291d7 100644 --- a/vignettes/dev04_RECIPES.Rmd +++ b/vignettes/dev04_RECIPES.Rmd @@ -46,7 +46,7 @@ The `blocks` object is actually an array of `block` objects. The setup may feel * The `variable` element denotes the field or parameter from the `data` data set to analyze with a statistical computation. * The `statistic` element denotes which statistical procedure to perform on said field/parameter. -A few other elements can also be present within a `block` object, such as: `stat_arg`, `stat_options`, and `stat_options_fn`. A `stat_arg` element is only required when the `statistic` element requires it. As seen in the example above, the "NESTED_FREQ_ABC" `statistic` needs to know a secondary variable by which to produce its "nested" output. Besides those mentioned, no other elements are used in the `recipes.json` file or within the application's code base, but active development will be changing this soon. +A few other elements can also be present within a `block` object, such as: `stat_selection`, `stat_options`, and `stat_options_fn`. A `stat_selection` element is only required when the `statistic` element requires it. As seen in the example above, the "NESTED_FREQ_ABC" `statistic` needs to know a secondary variable by which to produce its "nested" output. Besides those mentioned, no other elements are used in the `recipes.json` file or within the application's code base, but active development will be changing this soon. ## Parsing `recipes.json` @@ -138,4 +138,4 @@ stat_options.avisit <- function(block, datalist, ...) { # In the JSON file {..."stat_options":["BASELINE", "WEEK 2", "WEEK 4"]...} ``` -Similarly, the element `stat_arg` is used to determine the input for a statistic with a drop down. Paired with `stat_options_fn`, these two elements together can allow the user to create multiple generated blocks with only one `block` object. For example, the standard lab tables have `stat_arg = "ALL"` and `stat_options_fn = avisit_lab`. This will generate a block for each week. \ No newline at end of file +Similarly, the element `stat_selection` is used to determine the input for a statistic with a drop down. Paired with `stat_options_fn`, these two elements together can allow the user to create multiple generated blocks with only one `block` object. For example, the standard lab tables have `stat_selection = "ALL"` and `stat_options_fn = avisit_lab`. This will generate a block for each week. From 7d62c4ccf806d52903aa3ce55b111d7d8adb9e47 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 18 Apr 2023 14:36:19 -0400 Subject: [PATCH 063/110] Simplistic checks on drop down selections for recipes --- R/mod_tableGen.R | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index aa8b2e3d..626da7f6 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -71,6 +71,20 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL recipe$blocks <- blocks %>% purrr::map(~ stat_options(.x, datalist = datafile())) %>% purrr::map(~ var_options(.x, datalist = datafile())) + var_check <- recipe$blocks %>% + purrr::map(~ .x$var_selection %in% c("ALL", .x$var_options)) %>% + purrr::compact() %>% + unlist() + stat_check <- recipe$blocks %>% + purrr::map(~ .x$stat_selection %in% c("ALL", .x$stat_options)) %>% + purrr::compact() %>% + unlist() + if (!is.null(var_check) && !all(var_check)) { + showNotification(h4("Variable drop down selection not contained in options."), type = "error") + } + if (!is.null(stat_check) && !all(stat_check)) { + showNotification(h4("Statistic drop down selection not contained in options."), type = "error") + } } else { recipe <- list(title = "NONE") } From 093b8e013ce6bfa36898e4a25b87c22472e57751 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 18 Apr 2023 15:05:46 -0400 Subject: [PATCH 064/110] Update RECIPE vignette --- vignettes/dev04_RECIPES.Rmd | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/vignettes/dev04_RECIPES.Rmd b/vignettes/dev04_RECIPES.Rmd index 228291d7..52604510 100644 --- a/vignettes/dev04_RECIPES.Rmd +++ b/vignettes/dev04_RECIPES.Rmd @@ -46,7 +46,7 @@ The `blocks` object is actually an array of `block` objects. The setup may feel * The `variable` element denotes the field or parameter from the `data` data set to analyze with a statistical computation. * The `statistic` element denotes which statistical procedure to perform on said field/parameter. -A few other elements can also be present within a `block` object, such as: `stat_selection`, `stat_options`, and `stat_options_fn`. A `stat_selection` element is only required when the `statistic` element requires it. As seen in the example above, the "NESTED_FREQ_ABC" `statistic` needs to know a secondary variable by which to produce its "nested" output. Besides those mentioned, no other elements are used in the `recipes.json` file or within the application's code base, but active development will be changing this soon. +A few other elements can also be present within a `block` object, such as: `var_selction`, `var_options`, `var_options_fn` and their statistic counterparts `stat_selection`, `stat_options`, and `stat_options_fn`. A `var_selection` element can be used in conjunction with `var_options` to create a subgroup filter for the variable. A `stat_selection` element is only required when the `statistic` element requires it. As seen in the example above, the "NESTED_FREQ_ABC" `statistic` needs to know a secondary variable by which to produce its "nested" output. Besides those mentioned, no other elements are used in the `recipes.json` file or within the application's code base, but active development will be changing this soon. ## Parsing `recipes.json` @@ -113,7 +113,7 @@ recipe_inclusion.stan_labs <- function(blocks, datalist, ...) { ### The `block` object -Currently only one potential class is being assigned to the `block` object and it is the value of element `stat_options_fn`. If you recall, when the `MEAN` statistic is selected in the app, a dropdown list is displayed containing different `AVISIT` values. Thus, if the user wants a block to output multiple weeks, they can provide a class for `stat_options_fn`. For example, with a value of `opt_01` you would create the function `stat_options.opt_01()`. The user could also opt to hard code these values using the element `stat_options`. +Up to two classes can be assigned to the `block` object via the elements `var_options_fn` and `stat_options_fn`. If you recall, when the `MEAN` statistic is selected in the app, a dropdown list is displayed containing different `AVISIT` values. Thus, if the user wants a block to output multiple weeks, they can provide a class for `stat_options_fn`. For example, with a value of `opt_01` you would create the function `stat_options.opt_01()`. The user could also opt to hard code these values using the element `stat_options`. ```{r, eval=FALSE} # Example for `avisit` class @@ -139,3 +139,23 @@ stat_options.avisit <- function(block, datalist, ...) { ``` Similarly, the element `stat_selection` is used to determine the input for a statistic with a drop down. Paired with `stat_options_fn`, these two elements together can allow the user to create multiple generated blocks with only one `block` object. For example, the standard lab tables have `stat_selection = "ALL"` and `stat_options_fn = avisit_lab`. This will generate a block for each week. + +The `var_selection` and `var_options` combination is processed in a slightly different way. The application tries to create a filter. In order to accomplish this, the field must also be included as a group. For instance, one could have the following variable options: `"var_options": {"ATPT": ["AFTER LYING DOWN FOR 5 MINUTES", "AFTER STANDING FOR 1 MINUTE", "AFTER STANDING FOR 3 MINUTES"]`. The variable selection of `"var_selection":"AFTER STANDING FOR 3 MINUTES"` would result in creating the filter `ATPT == "AFTER STANDING FOR 3 MINUTES"`. There are two exceptions: (1) `"var_selection":"ALL"` will make multiple blocks, one for each options and (2) `"var_selection":"N/A"` will create the filter `is.na(ATPT)` if "N/A" was included as one of the options. Note that if using `var_options_fn`, a named list must be output. + +```{r, eval=FALSE} +# Example for `atpt` class +var_options.atpt <- function(block, datalist, ...) { + atpts <- + datalist[[block$data]] %>% + dplyr::filter(PARAMCD == block$variable) %>% + dplyr::distinct(ATPT, ATPTN) %>% + varN_fctr_reorder() %>% + dplyr::pull(ATPT) %>% + get_levels() %>% + {list(ATPT = as.list(.))} + + block$var_options <- atpts + + block +} +``` From 8f75bea5062baba90fbad20a2a79ea3705ab6f81 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 18 Apr 2023 16:49:56 -0400 Subject: [PATCH 065/110] Hard code demo recipe JSON --- vignettes/dev04_RECIPES.Rmd | 11 +++++++++-- vignettes/figures/recipes/table_object.png | Bin 27647 -> 0 bytes 2 files changed, 9 insertions(+), 2 deletions(-) delete mode 100644 vignettes/figures/recipes/table_object.png diff --git a/vignettes/dev04_RECIPES.Rmd b/vignettes/dev04_RECIPES.Rmd index 52604510..0769715c 100644 --- a/vignettes/dev04_RECIPES.Rmd +++ b/vignettes/dev04_RECIPES.Rmd @@ -26,8 +26,15 @@ This tutorial will walk you through the structural components of the `recipes.js Within the `recipes.json` file you'll find a list of table objects. Below is the standard table #3 object. -```{r, out.width="100%", fig.align='center', out.extra = 'style="border:1px solid; padding:5px;"', echo=FALSE} -knitr::include_graphics("figures/recipes/table_object.png") +```{r, eval=FALSE} +"stan_3": { + "title": "Table 3: Accounting of Subjects", + "group_by": "TRT01P", + "blocks": [{"data":"ADSL", "variable":"RANDFL", "statistic":"Y_FREQ"}, + {"data":"ADSL", "variable":"SAFFL", "statistic":"FREQ"}, + {"data":"ADSL", "variable":"EOTSTT", "statistic":"NESTED_FREQ_ABC", "stat_selection":"DCTREAS"}, + {"data":"ADSL", "variable":"EOSSTT", "statistic":"NESTED_FREQ_ABC", "stat_selection":"DCSREAS"}] +} ``` The **naming** of the table object ("stan_3") is important! When pulling this data into the application, S3 objects are heavily utilized. In this example, the table object will be given the class `stan_3`. The application will then use this information to correctly process the data for the creation of the table. diff --git a/vignettes/figures/recipes/table_object.png b/vignettes/figures/recipes/table_object.png deleted file mode 100644 index 71045018b72c97ef84ea08494b76dbc1625a1a47..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 27647 zcmY&=1yq|$v@Q$5VrQVQ65ejQ==rMII88W$_-ondgBa#2s978vHP%;+6hv$XToa8ejG>bq@ zZ<8@GoWqLS&fIyCm;XtjJSCwgFg8ba$?J*iQgmx09xa)vcG|#l>I5p8Yf$B(CI2f7 z#QE)`V#d3N5yqZFn%H#OgSw=LfFnRWrwL86 zi_GFs{9ll%zJ)M z_V}~HaVuqAwi#a#BRvT|qJ{op%l`=VVRNMp=c=eF80EQOgcQGPc02j;5Fai=`(fc` zrT9gNf1si7X>><&Kyp+1>dZCg6#Sn;)G(}y0VlmTDR(SND_~bQFu&@J+9-^5 zFKGqnE{Gs^fsn4*cwQ_mQ5GOL4t!T8_lZMbrvE0 z#6d_Xp@?pc-<&--BI~Akd+b^xF{VyN-hayJS-->C>e|38E6C~(y7N$wW0ArxeB7iAMp4p9Eyn`=?XxlUir@u%mp$rZTn&C)w@40M^?$2^VUMjL$)Jpda#b zH~chAbaG1l&-YvB(0;N;;cyX(yL_C}3XBwdM78lV&1+ItQA0++-x6(N=wg&izkso-F2vO35W}kCQ!tW$!TH_7Cc=uSD*s>1$Q%n`CNXO2TJ2gr($V_2eRE7jiah&?qpZ_GMT{rgjN8EX|3+{|Qqy5qoh_{7Dsl4$1 zUkx7-|9K)q`k(ybjp|n8@;~cjCEO|ha~av=z;keRmiN9DeAYQ^NFBS$hspp<5D;2D zojcZHSdiYCw8p2hFH{@;FxL3WNKd(hDc}gc=ZHHY5AL&>$wrL;y(QqUQrj22KO^=o!4TuJe}#_~q(?CJ8VFxY0)*O2 z_dtp*$d(QWR*m$p$1;~7n z|9Cg+0JqVC^!^_6Sq+YNoLG44JBaPI$UsIX!>w1+nc4U^iU(k-X z@CvD4+DuXWmV5)k7aD-}DyHzQaYi@o$0J~D#7Osgi4#WoB2GgY?@c`h0?q$why1U0 zidupd*@C2?bkNmmzv3*lbNw1}!Za@mKGL%0`$cx=AP6Ir)#b-`ufMbb3im1@GX>OzS*X zj)Uk$zHAh{XoN}$2Q%P(#-u-=*hrE|?`jOb1?gIwWYNLCndyq<)C357&L+? z6D`0Rmm6I&G4o^l1(ZPS7slu+dZ6^~{E;l!auh@5NAd>=4@Z-S=~*2DpG!XoLjhrH z9k}^-`N)KVOwpiF!YaXLR1Q(Zb%73cTt{eR`91vlRgU|4KA-c4yKAt$yu#5T_S#Q$ z+ntWCN0kQ1^{i?CRbk2RnyR72zVNR!XtP5+jyMAU#m2q&1YyMVWM5GT&WOId?IZW}7!2nB^o2(@5U}NQ z_1hb+p|F5iLK0nSHz zTmZrlKc0~@f7OSR;Kx6y=>xx8eYuFya6jLiyDHzTPcv&C=@KYKQ3QZ= zCvJ{@puyySCQKwC=~)mSf-2Qkz?72pZD?Xp8dX=mykkDa7=sjM>|{ zZpX>wXQ_>m-<5;?+FZ3|*s}feSHUX_{c0fKae;sWv|wZcrn=hE%S+a@j>s7d>%8gk zyb?8PvJScb-;f_9LxL)yQl#s4#QBoz`#hmO{H$oqK?bwhR)5B+-ZSz^WoeLx$M*Up z3HM!3MRyeeeV{Vt=@X{4ds0OOBzAC2Z^U4uI0pIKxig*+2whc(_;r)6)#B+z`rd(C z)Q%wFms0~Ue8ReY<-|#id0`+YgeYA}Lax*UZ7Ub?qGx;p=2ttuQto&mg5#(OnRH560PH+4>~98UoFH;V+D zpdHCgkUDCti*rNYOlMf{j;)Z8cY}SdX0**Whu6Pl%eSh#Z1hjcY2?W8Pb_*B?Bu3N z@P57;6k}GRkL5F-jKv@VUhJ?xURP!&+$lAEKH2yuM3z8t8svuO z^b@%Nu~2BPxqV}mO;<dyOUeO2-cPR@s55U*8Q?{$G!~} z%z#U29y;E>Tsxz2hAj5uroQn)^N&S>4~ClsT*-PBe8ts2VAUn##0^ zk3#pn>7k+IXQuxHP}l8313sUfLBI3%fo&;Mh1T-ESu>lZa(IjpPKfo;W;hxz90zwW z9(5|q(ZoVQ)db6vkE?h=HA6e1E7t9hWSf|y@mkExD=Dd7z+0CHI(Vj6UoP5KBYk>( zG!NfHiJq83D7y)^IA=XLMFgGaXQS4ctoy@Y3*d1|+h57Ik)F%d1l;LG2on+A4>>Y$ zkISRCyq_+OyTJk05V$mvukm;kbxKmbl}>IIB!?f9yYpGU`^TTYcg+KYyzsL0A-<3O- z_AE>xN3VRn##X+5j?3xSp93s37Sn6urZ2i&^-qEu{Ye;Pb+biVf@k? zMJ?t%Cm0YgYWz|r=1u-1e8TU_8hTpEY1mOv73z1BFYFrmFr$OjVa#MOiknIfv~R?2^F!2d@A=4hCK7ZLs*&fE`-|nzUZC zlh28?_ETD%U#iJ2ydJM34To^@Z3cbwYh&7XiMzvmP#Og#=X|PS13&n7~}_{c7M# zYF#eA_64JfOa0?@1$Va6aAAEpf@=ws)|wBmBuqALAox$$&a9Jrg05C*`U9l|=+1O9 zx9c|3o2_q5>2kmLQ}E$fkB}eRkP?CM7UtNg#Vp~b@^dBVYCJE($-`!~q_ZAb-qls1 z>P**pb2jE?mQ}hp^JQnKDr$E&hTornT2*QFx4;M zU@Wt@70W;Uuz*c?d(6Mi@x=1u4e=#1`FN5I=hcygE5G0C0=MZ+E>g@|SB7Y%D5A$% z@30l4`~j%`W}S^M*JvQ&T}!=v5O0U5SNwXN#VrYcJaA3)@GB9CsJ9`hU|xJdlW?-- zq{-kTmiOYM$|^3vM>62)nb)6&he9YcF^hoHd-c-h6P_sGvh?__#O^6M-U;6hur8&f z$>8=mErXcI_(C)>;MJ?H{JJl|hz%PhT1GB{niC~^P1<#|iu2EI)$}TWX02hVQ_{ni zS3Au^uCvLOt|j1BA({Z^PqdTYRe{}0&SsZX_Gkqi6GPPFm{4|SSiSktH;`8a1rv71 z6@}?SgS6MvjZ>S$-u#n))ZYVW)8XK;m`u{#*)_FCM8LVs{%(mjWHKiLzvztM)sH9U zt)OY2&l>lxpQQLg%R{7Kd4m|g&hD1>w$@SqE9!Sz*`k~ky136J>Y4`PrV_}7Lo6K| zn(dY|6J)s0$|X<G>QhtS<#f8fZ8-G=U}!`@ckib`w*CD2CRmhSE-d_|`Z z)A6}8>lM2oIfiRzsyFQ$_|12gK`E$hGzjI1Ye#7#8_1%0kG|TH4=yypZ1T=?-}H9 zU!R^~P4_vSqJ~jSb}|LiBZ0oY4y!R`@`PC#V2=8JcPp6XQTcJfcL@)(f2ThmK(sC%^vb z{*Pg|cSCbys6I827$U(~qCR0fzo)$1RcYwQs}8aybiI+2Xhpty6Eq4(A!>3%zR%FZ zN&w3HQ^DAlX!wCAud4C@-&fa;Jgn^bd#Q zfE8zG<^_&@4cP@=`r!&a{K4K|T8xhnzC&Aj$odI>*@mg}c4D0rsmG3OgT{*te|oUe z%j5tnd*8tB<*ieFRCH*w_ync(f!!6t1%dRa>hK{z5#;%gT>F6j0yQyxC|@)K9>J+2 zeam$HB8QsbO~seenwo>&9yj}CEZJ8)nmgvaf2}@;^=5YHsS9`ZchH=?q4`q5;xs=D zf9c>d@U`HKum+dmsGt%g7fj}``vN2eEqjiP@_X^X2;%o%rECbVsZ+c%dP@Bs!9Uei zV3$0DPDn4`X$&tj@qw{g*U-!k7>ZsQBXkf)=rbOyLcg=YnF#hwBOcrKbVH#E^;poO z=9XT&#Wy7oBNHs5*fJLMz^_S*Uw#Tb<`Vz2n_vNlV+ar2SlM5`VXFm_9Y8dvS4CpA zHaWj^`iNcbV34$V6xoFvO7VLio$2U?=1;dWB%kZha*5|c(Ib$f5|e!g;>ii=`=1V( z4eJNvhV#g&)z*3h_DZngY9Q4Ng0()YEZCPHJh^`CUKoLulyvw})`fGQY4QCqH4-aM zi_HI5aX|qCInQ8GwldV`WBvc|>oPNMB}CKiE=9U1n%C*;A`TGZr7vcuUw%815&-VA zWMd8@RLc``GjWfHlf=al`?GuKwYj*983z^x5~`%}HCbTbF)km3Aw!7OIqN5Tt5|~O zubhQlOL)%MH}Le?6!f{N!K3l->B@> zNJCWpGbP!_lZlSx7b6?3Z(|`crE~H#_W0qt$sjlC^dIG7i7@oMhLO zl7Cr7*cVLOtQzv;W4(i#3OJKxF4-;Wr55zgbvOpP?gyJxiw9H)j??zCw3eyPk8USX z$l!S?pJN^$6b_yj+4|UUyzH;$X7U)+GB&1y;bmfNvs7Ws?qP|(v1hHT0N%Ug9E5*T zOOfLor{QjS^c_8X$0wPnPy}dhDa>aS+_Va|J{xvgioj!mvrQ=%6=NhSnkKre!D5x! z%Fa&f(rOzmF}$L)&^6|>y!qvXY$SlBhE_hDDIjRf(;7-njfw#p9LA$)Dk#^pj2Z_( zZVKt1tm&ict+*g!5dwdXtm*w&v&tk_l?|)gXilve?oZ95xSmy_?}IToRQV$##`Fz= z8b;C&24Bu*7&T0YSsY-wOv+GjoI^aMyuEUK2mXch)damEWJrPeKHI(Me6RR~I&T2U z5?6;e#Zwq11j&5Aww)?`6kWa}6h8W!18|oGuqAVc=uY(}Am81A1e8^9cgg7S)hJbdSA9vF)3nlSTJjz!cf$oi^p^xkl-TjD5tyTf3<=r zikYi10+eHFd+iB-_m!kt0YiiuauNIBbsE$`bf_-v^8{UcrE#!PW(=WGy0)ztH;DAA?DaU1Jr-5?oR)c2_x5tZP^Ddk-!*KxOni14XhY6 zkNbyWt?NeKh%Q1QoL_kaXUXn#F<^sQYsmBRX{h4p(3pPJ=$~!8j7<0ytC%UZ7uep`I`K8G}Kt%2c~w$bzS9K?TjGGWJTK}-Swc2O>Z zLXR6U+;}Swop+?sJJY`W3Cz>5-lb=~30{|m{KnFpu@CH?nGo+cpj1T*+ReiF7=6|# zfv)b~Dnc#(+wM0?@A6yN;E{TF>{u$}_EXgVX|WOh-)e(*gYbVr{_3pU8{)-QG?)Qs z{TIr8b{)hJt9%K^QpyS>1eUoMdX+Kd;Bw+xbQoZd_Cs9(csDq@4)dGO;i!YtQ+2&T zRsgoH6ej!EkA*Nf^XZ$3pkEibxN~AtV7muTErM0HZ_fy-MSScgtrT?k1P(p-U29w-YOK1R~K8lUidj zI>5I|yQk`(^^Yo7M`@B{c>*M{p)Ogor(lpM_0RsC4sxBaEU#UUI>9fZg>rmAqTqvy z8vQjNnAx_i`74Y)x3-t4!hx`syu;d$iOL(g-2oInNFk{d>;Wk}uMmn2Ogncebv3o` zzuMm2K)|f>;T`(bhZr>?Q~-?0-sK4x_WpuJN_S=>3AdQvcjEda~t1_P7Cz*WR=b-_47y*OGSPq0L=Pm{ZTZL~0X`gf;MaEOS&tVTsuYit8v{5EFgZE)x{R5Vd;h@#pG_?v zwC`L%LJObHPwrddwN^2p?&eZfU0*9+EtB$il-NjDY2443#P$XRvO)3N6ThMf|Cm($ z(F4ej?A%9d1CcEju7?Okr^MZvX=Ov-49@-$){KPx1aSdie1w3WyTTPdjjR-YhcS1V zTWxGZOCQk=x|>B+b9O!l8)F%adZcEy-ECLv9W=JVGDmOH`Nx#+Tn!a-yO9g10}XkZ zbjVM2d~kE%qix7WW{yAxzvoct)JgQop0~G;qf5d`@I@4#=r-;fXFTj%JEHlV!hB%FV2&iXpkUZ$dsvSgRG>OM6<_e}2+__pgnP4aU?fvYrb)>_fIleI z34MKR76qp5CR4i98|w)iz}_@f5-0=&SIa^+3?C8Qu(-%i#a@0qk*O0w{#O-`P!x_Ddn6M@l` zZ1Pfy;4knB8V6`1%sh_k^ERN z*%w?-?3^2SFF!8^<`EymFRejTgd%+EUV0zZzCXKiyPhrQ|Mb2Xe#Na%6H`1V z6-~0Uy0!Obu|LNq(hf$5O1B*`7lp4;CUe9WjLf=x!oXEuB*%qF{>R3xUL|&>P)}Ef z&y#wTo@qZB1GHBs$E1%$zh(?Kq4du$C|{wU)7W=@IbZ`gXULVvGIwxh%)f37w*~8( z=6Bt1Sz9_pXOJ2;DXxV*qzQ z2GXml5Y!upPwmg9GDu8$=@Y`5fG$)u3b%GKSO!;Cc4q^7@BL{Vbfs?}t%$6hqJL#F z;PW)EET2Rw<3t0Zer1-`PA!>alMQ01@(9&>rhHwEdJYX>lM;;2CC*F#vjTK?d;Q7w z)(JSXeVI$CIeDBLzd8{$N&F~yCtP>s3>T2an?zPX_eVH@s!w=cn7V=!vZk0)X&*b) zI@z=Xl2d$-3t`?t}S}D9{v&@&%S*R=Fl{d zDl#5JQfS0Y+?dyBcadcv%0zZhkVnv4cm6=6r{J*rJZ-^Zp8`AMHYkCA3oCy-z@=;J z^c~?dvksBOigyIxJ7(23-!CQZuY+k_XfXkg7YZni>Mi!#(bb@wS2dMggk-}Y5NQM$ z{o`)d%(x$JnDDQc0NwJfy%J0tIwayM7Ar6bGQu)UMY!>0>B4CBo3=pQ?Q{OSE7rjG zufBS1jXb$ejc$;Tjvb_I5bXweGhDkRraM(=kXhI24>YJ|01o8~lW7zI(nX*M-?`CH zfanuC8%e04A0lUfzDl@2An16};;boeRS_AM30_rJF=yM~mFhLH`34HK7=I!ZdKDIo zMiCeZf7?M~JJHw1-qW3ktmTLM0RVdhME-K zes#W4rcKS>OX*P{*FlAdQh%==rO~iF;K-pO`%V((S!8qyvSl-@)Q5W=^_aT4fY2wESoZZy&!0woQ37Hp3bVzq6g}PE_g1_zm(vAixj<5_I<(KDR8J z4=AArE^soE=ql z{$)8m5$Hi2O_4tnzuefd0g>N;`TC*|YG!%otPZTu0leF*dy9u4_54Cu6Km73HaGJ9 zRO5vTQ4HZL!b4@LMD<)L?=?qAr%Qw9BZczJVo&EGMI|_mp}z{d$m*StH^UxXh^zDJ zY;%kMSY=Ny#o+pUYo|kFP9_5CZRcav_;p9?i&e4Ml(4Z{Nmt0i^M_$?X{Tl;H;ZQl zk=8iP!}wVh?TD;J9Y^3ZVARHTXR>=P3|`*J^zJy8Hl{=U0{ml$j<~c2Pe*5E%hoi+ z>j|xX75Hf!(p2$G!2Pruy;-3NydTka^PQ<-y0UYm$Y0|LNbv+G?+V?d6OoNq^FqEk zP(Z!WAxQLm>=hI_> z4kh3rOKMra=5-l3pHsr2s%Zm18-{$KHzXS=FqB<+R|jb^AjHs{tBXN{|QVMgC?f2hnc3XEHTYI zz1n<+F6JkTtU0j3$DNC#^M#+?w--)K#mHz-yMmlXs5u)@IKG-~rMm)s_4}E?>-cWf zdoXB36e=k$WXM-W6vZ#kMozuSAD7+rc&+m;ZFAsE^c6K5gpt8jQ~geV46C&wKwVe6 zS-D1)_v%sDLp9Sk0!`19p36Z_oge^t0h%U**O%#}S!$-@Y+2vk!k0L61?Qs$&o1g3 zLwwyrP9`~Fp20HE@Yjoc%e*oL_YfUkySHzh%eUUKp)6zGWb{crBk<9R2-K-xNQSTv ztKmE=Uq_aDE;&`wRo~DCqF{30-ofJZXu;99VlJv6Q$Yf7)ouKAYyZeJipv!NkAvvA zI@5=5->}{v1x%n_lSK&0EWzXLuZW&7Qqm!KKUIu6?jyCmb3U^Dr$ea}lQ z(mKA9mjNskUfVRdeV@L1SK7VQaX`0D2M%q&3=ikae9h_uFzFlY@skH-eGAIR2Cug7v9}dz50KJ9v4)iR$7T0 z??Tz+F*w_^kSgM4=!u)KYA|5Vd6IC8>L(;3bSd^&WlDf^g3n}wyNRZJG9;$owGyIh z62QrkX%x2vlt_fDcknj2Il!JRaKT8;=Ct<=P(irqnXA6Ge?T7i_-H|8YQ(xZBH`mSL^1YzU(Yk%Rj=lm4o{mI(=}X3??kJbv37ua!w=EI5kjoPSL!&g<`W25nok8jtz}9q*q^eT8}doI zkO?Uh`GF{Qj(9}~03Vj^7qJ2WntoD$eyh`FX>FZY53b45q}sfY4bZI8WX$r#U%s^O za(;b1q-K7PUNJ7J`mI;umV!6k1fUpV?c?iPzWmRg%=A{h9oxRV?a3F9MQYk{Y|{m+ z1Bp0@t)A!96afG&)J%58JCCq$19=l?yE%6|iARQ~whFH{Rs5END|WeMC6kE+?Bs#J zqw%p`dbB%%Ah?N%4{v%MsDFUTHJkzVxmcUn&Kz8<171^$ND`<&VO%H>WMkr{1ijLR zp27yt$gzKg&9iKAzKKUczWH*%$qo->P@L7!$KCrRkpr#cB~ioV&N@CDo84n&t?qrL zEAEf}s5lQv0~n}SKplu|ZAcgJ8BQ6a4lt-_zZ-PiTEEg8E3?9g$RNcjR(3GU&q21h zD%dHwD15wcYgUdK`OC$%qkg&{7!ow}@6i<(Z@-uOa$$o^Bn`)n{K$p=NnwShv<6;X z`;zo$LaY21Z`ZzWJqD88XiqmO_(PL|da_acMB`>8O#yXFE3%}SItV>4I33~r-6=Fy zsv&yDE(KR$`FETmBLJaYU|SPO@*sEB=INfbs-clGXh36R6pg**-h8ID_));exI@Ot zjbjm0FC7qrey^svNJCML%e1(E1xerJ{9TiUZoFR>oQ-&2&C z%?pU^#yJsO#g3a9n+H#Bx!k(&bh+%PpZ(p<)9id$wj-ti790_I{vzI()T&Gwf-u1B$w{O+Jhh6pdTzB9@r>B=BoQR)qox59aaU(ix z7If$3sj24GQi7kBZ!O3*B?!gqHdnUldiXJ|Xu%wD2jj!(mZPf5=ML=%)?5r6mw`bA z;;P*WfLc5bj*EWAGun`Rp}$H#tpU?VkzXeapif2CwGRcryx1fn5B*Pci_<>N?1tm# zjYn#!>GbG1qn0a0(+)~(yLw4qlKx)h~<8hpP@)N zeQRO<+XX6GLAxf_{;#Q(%M)aFLKGaU z9yTVEZW8vph334o7++cEW1+PMt(S(pwr4n{s!d3~ob-vuFL1-obceR{h$r)_mpeWi zn?dCEnbYOT%?h|~dv#zMh5xN#6ZTy}uOCV~y7*z(=~Y*Mxb4=237$#N2!E3cFwi-A zqc#Ak{k!j*9v($Hw4vb~gjxfWYyEOs6V#V=0A#xd6Wx;=mCJVMZi_Xe?JNG;qoLYx zs)MzAHOGfpkH0AGF}{P*U_w?VwDDQ^Zdmr-2X0$uEcPruy1V)Yoj*h$fT*lpb#1T$=~DDmA6;2#^(>^6e(4GQp!h1J zX_J3A7XRddOWx_5MYiVNuc+GEzM_N0=HZ%R|MY`~_sp?b2X3eHi*E|gd4D0srS5f= z;(1b0wa2Z01#e=8f{9@K2fg{+*ceU={fq$jRv8{~F>YMQi{+ESpS8f0xP=S31AOaa zG$r~)M>0L_48x%n*4kN44<{e6ZBhnBA9Hcd6 zKiS|!S`@dowr=h01m`rtBl5oVN8U0PFui!%Mm|dR8)@HD*xq=25UG)RS|`nG-=S+> z`o6MuV=sUiRu)V1CheR>_HGw9BD`4ajKKQ9K#D7g|E|6}H`GAn&_G8GP|;kDUnvgV zJQos6unCbUt;%y32{X@I9b~#VO9&x;FWdfMk1WFSm?@gU`Oi4nEJBM=5c^S;@h)R6 z>KkVRS*sc*)^&7@-z2zF2Q%=bdm)tW0z1V#2y;saUH|3B0oFsqmML-u7{P6O1vYTq z`Vv_~V_#ccv{CzO{J>l@px5>@Ya!OHg_R}kUX*EIxmBXT{_7fDB7|37TADQr3 z;`NHG1KW$=AATt`a52yh-{_4nX9R{v)vLaJ;A6-x8M6#i$EW)^PQ)=R&r!~ZgRW)y zcr4@5Sl81+H?;X)YC5)z!5M&^xJXDl6C9Bk3# z_Z(N#Xrai7S2noXKi&@CTq?+}oUpjB)U_T%qq;y1@Nq|!y^;K0Q%IrCTB1zLB!tzm zZB{$d(myhR8#u*6QcKd5EqEAiY-1|scgF7C1^n>}#%FnR%$lDcAY-JkDNnP~QM~uG zEt~#t5v85j3G4Dc#C@V;uoFt%Y2m|!FBypE#N7N8OP>#EkeHn_c(^ISYhaP{M4@}^ z-IxQ_F;hgmL%W)}J=%vbV_Wz%)|EFGKE64rFe-F1@=ZyN7wQR%sMLz)eJCUF+yO8^ zfsgJM+sq`4qi@Xwm5e#uMS7@cF1dwzem@2`ufBr{-RN;;;K%%I`@Xjz9cRDJ#2!gl z@#|OosL=5GEl6k-Ff{TwS>NyOr2c+ovKvNjcYBSB-Cmy#?aA3ubm~+owffG?9DOj< z`HwK)ZEk)kO!@A%xphNDOq@#kI}V@K>b!|NBV;Q;$RoW&Nii3>JFp5OXMXJwTwA45 z1C4?xvw0`tw{^cW}cu}{jCkmK`@@U_Q5k+mA`OUOs`&bixv&+3<(a& zlZ=Je5fFEzCpDZ+X{mU|cq20p9L|^KRbR_bqTB;%>FJ^6tx6-qr>rRJm&sxsH(tx) z^Sl{H7&#U)Xi&3~Y~^o$k0@$xov2tt}))~2KKPrEbf1ff~`Y#C3qNkqrqYY0Z7pVCw~U*u2eDxCR(sDb4Tu_2WoF# z34vOwLZ)vN4Oxj0O*{T9tI0rp%!85R~{3n8_dE&G#&n&Cftc z`V&}{L_@X5;Oqtse@P7Ivw?VU?38CIKw{+XM@Jto;>fZRjlq4Tt(!fPJGpU?@--28 z(?@UI$f#Xpkp%*UI^I19jVf2rso@g}%qwQ-`u_}u;}LT9iE!<-`bR2tZLQspVv=2) z+aYC>Q&oR`ySR5xDOQ^7<~!q_%Na&W%CSqMt50S6LdnrSZt8%QPETapuG$tmuQiUw z#{S}>gdg5+cO6AVo%LOBl|fO3oI544rg;wbMQ02CXrzZbyV-Zj8iYz#GIqRL3^a6or6Ep zFYJJ@(<2BEO{mQctd(2`y|nFUCyQifVW6fY+Z{&y6Vj^xKn2R*gze>#_%S(8JV zN(^7cgASmP$rpknl7kDVkdIWi+@;mq%kRwK++SADh5i(__)1@*Lf;JH;16JuB6hdw z{8c;n)-NG%^{bOg3LMApU=fk>lhx%%n9FyB2X z#a^r=e$~igy8kb7ya4w;yf6Wzucl38oh!_xcF(g04()Q!@s1UFBJVS|TnCnrUVQ{Q z4coEvymyECkz>1X+%jcp_iQux-6=nh+b;R^s^$8bQ*{`=5D}0_9y1}A@yr+-n}y4+ z^D|Zi7DEu4_}esotQu?-%}=$$8K*R6@osFg=K6oTzl+zCO@d6BBmPX3sxjWLwlEv8 zlg17_I_6}ITOkWDAj{z4v2x?kNas?-xnf;n4Jq>o3<}(%pajCEp4dV@bC|43>DZ&a zl|}Z#DjMO#$LVUsPbbiq%X=GSI zBO!xIRb0+&{bx+$l7h-_j#Y}V+lN13H|OcayMqTyKA;G znCP{P^&2=~v~6A*<(-}e60(rosEp@4-#74)SAH&M+H|8drR{_U2J zZCrwtzEenZb;x&$zaMLIHYsledN0ffxt>6Y@d{CV19CJ4 z*TZyo9kpCriwD8v`f0SdS?xBo-R}%dSYfuXW><9Ug9BbP>{sfu!ts@RW{RG2;OX#% z8n6e}Qi^h%Zd}Jvb2CLhADuln@VSbhTqGE-Ja4-FB3-ISd2da09(GJ#2TMN@S28%8 z{wsPFP&-@oEd6GM!(k50@z!SqweYx><;H?bT_^#XcqC112U_KguQm zI(s+>dl)Sw!$IZ8Y(1%bfDBqlFRJ*xe-9)e8hu}TyCa?4VxOjB#TTJfn1N$^N5+%b z5LzTXpy3W(HSD&+WHc8EDhe6dx|HEP6H|0$B`S8Iwaj<2F;E= zwk{D-wy0;|CmhkwAYB7i&X%IE>z&Tg0IPjm_1Pc`rr1?x$kUW$rLc1|Y@0y0e`Bx| zG%1KM+v@Ff*x)~cTu`m?AjJ4aTSh`w(-Rr4tN_2=!0JGz4F#gh+z4O~Sui#mBB+V_%BW@5MBL0fuomCnIOaeFj{8hQnrNsoewur6{w2H`oZd(vYEYF2xb6xU2QMZ#OQ`&y zl3AfyddAvwGe>h15xE;sb`)pe{`J&vz>Eo1=xA7WJF(oiVD>JeJZbbuS66qBfFLP7 zRqC@Nmh7?=)L1TOj{0VmHP0j(@$QNwXjU*jUwN`&?2-Df59o{8*z}{8*-9S&2 zmXm~Z{d3)IkKj9JcGYsZ+5Tc>(LI^39K}r?I!(5D_j?6Bm@PdG-{z}B#~P$%YKg{} zTE{pivX$;0C5}; zZO}cKVe;7M^>a!781~=`UX&yi7&8McD07l`Ue)Mn!xc{f9oclTn@Gx71PXi@*Z>+z z&&Ro%FI|6RA3wAczG}IP2q}#RB@z~X=?BF}u9RV^JNkWJ7FS9?@ptaSI4j=7d<$x5 z=3^=oCXKz2JIstL`%$;qe~b^>DXF-d)dq|zgkq|Tuf=251louag5W$K4U-?|@I*tW z3wFW{ROj&1>kdj{*ZdC2sJnk_5b@dw)i^E%sn;=epxexfLN2n>NA20UEH9bqpu9uJ zRL^Zn@z{i(*e_bqOb$A;9#>yuhZYAe%hwrNKl~HKCG--*Ej;>aiN2qNp6;F2fXA|7 zPkf`RoxBN?q0IkS5Y9w<^z6x$EX!LkO4^{>)bmzzcy*}M%O@CM7SbetWQ|-F{T7&id>P?Ix}1x;~MJKzhBnZvi3Igapb+Z zyNHrA2n!?YXzM(r;7O3_rNpp`LMYjRqUds>9pSKpYh#CAzT`p;7h@d_n-4iT>&pfK z(hj2;%>nmOI$66zz`XWfzwg!Zup^7A66G_Fw{btJw7CUh0BdxI%Bc6oj+MVp&i8r! zfvnE+rpT;7mx)FuJ(l?Y&;J5&lPZ;&9%oNJ9;|D(PCS#Y28fEO#2fyg!+44$=^x}2 z_@GF*Y~MCl@`>8UZjTHp@)LEU3@vu#r=LV#h!X#esS~X~D^dQP{ddB05AOeet5GGF zT8CG?))BBZrqoj}8*EVV#ov<_BGu#3z_!`(5sZ6vot?RJUUCrqNFz9)-lBjV z4>Sw%^O@a%=&lAhNUdlG-x=vFoJT6di3(B52yWCH{O0HxTn?rv)-@CbU!077fiQwJ z3b{dDq<8W!a+TtP4;0ZcMkm%oFX@{>rP7+JKRlmAQA$sR(yXiuj2`Y$vWSOep-2Lz zm=fyH1SYK8ewH#gUn`Ch$7ivy3n3Xa2Iw};L%0X4!#ELf_)IV2W1}TN6AnxF-TGu}hQ`P9^3S_k?bJ?xIRG9X zxm~tC3H+SFr;|kcy-Mn7|6BB^iph8Y@#1p_P{3ShVkeYJh9H8K^Fb99N`w{{Naf>!>Kd?f=s)At+rc4I zkN~;7u*5-XATroxuaI zq0ZLmFWdTaH11w;1J`{Nf_)|DyYV!%5RmXmU~nOutnu&Rxb2tko`S2Q$r>;D9V9>` z=fV!Zfx%mN0=H{t2NDSRQyS)?_t>6TI!Tuj9O56ChwfL0g?XnVc=p$D63yhO2_`W& zc5RB;WtLV<7W@>sk{@~hoIYBBEfOfSY_0Zc;Q0Hnj);(Jp)n+J=9kH`5kEZVHzu|Q z?Z=~;7zVYvPe1?6MZxclJ16J?KKwzcPo%d_2bXR3NfBrOa|na@~g>*+xg` z$vu?QRW(zR4$~Q*a%u;h<{70OuW7|5CIQADnI&X2SzMi!gga-v%kyVx_CcTa?>i_g zkDf@Qd->xNGK)sL&D0=NQL*=a=gSf}bSER@OM|}5LBEm^B?IB8;PQW5g02a~tkn6) zb{X1n4+bvJbeGUfkCq-ABSKUv2zF-nm|lz+lwedM&mmjC2J4?ccn0r3p7E4<_u5J| zu<51j++_E!J+f;gzIzfwwY1>%55I@;{KqF+op*4)Q^c-gg2EJLf6Ti|ikm+22Snth z;?5uso491z#n1V^=3$%APs8O^b#h%DV>dRqIn}Z0@oULGFGU?5H_JR%Sts&&lHA_s z?abva=uKbhP-k>mla4E7JwTt0%O6-DnkmrrXbfLHGcj({DP9S%lSP{v;hfZi*Mz@V zUHrlc>v>Jwhcm<{7maLQJp7|7<7T@=D#Z+uBr8@*W;%%h^cw>^`JPfD!S|LF{~!nhZYPPgHP`4 zad#2jyc)H8Je-omlK8WIbI*Lg!F*>$7j~&d0z{C;M_^+l#@$mwP5aNTYy@PSe@JA^ z!>SvN^j8hK6R+rkh(FyK*2zdjQsg>@NCs)a&nPnvo0Y)Ehd}l1dl$l1scv#&-%moI z8yedMFJh|Cvzgc3nLjrEo+ge=?d`V;&NPPU$pEs3d=;TwKQHAZx6gv|@>gItBupb3 zVqoj_IzIJ%fI+IogWv#nEY6FwvJy{f_F!s#07=qyy`#nvg<*3Vq*(@{h4M2(oZd;H zc7};bYr=lJOn(X$$Im>Nww1hM1kr9avtDmMuPDiQRgzS9uTH#0*)XKM4HGE=^6eQJ z-&pMJ$JR=$T6YUa<;cwyww2>anXK*-w`)bIRlQZ2MA^`cwI>M5Ok(nn?=!LPp_p$Mg5??-J@MC3Aa}9NUtx+0~8k z=1?-w^~js=FU(w)_0)fvAj%ygbHae$su8| z1U+{z3f^E^m!Y1G?=deJ$Cm zH3P0OwSt!KLIv`Xc&m4Bls4}NWn-_Nw>qYSQW5t7i3a!lC|4zr<|%4SqyC;gTddZI zXR!`sXj6@jOO(@*9grqXY|?I_CM}suGs(7i7_=+rDv;B4Ngx}iXZX?X!m^tT8=ds# z;w0kZ4Z#a`(d2oHngYnILe`Slf^Sgee2Fn~Vul3}PzI{3{w|zGhDOp@P;=WI1j-LjWiI6;Za%2*D8fDQP|yfu;=qpw&+Q`OOzumSpDP- zPe;M3mp1V3kLuTEp`ty~=ui@0Nq>p#HFURkV1?BQECcokXCgG;vXnQxrPXq=!tEk| z0YJT0`z)B=OF&lF3t_3rY`i`D8&;Z>)itq0rgn>dZO~}EC@iPR;#9_^N;#eZ?5npS z8z&hjCDKfL-MlicDT+tX{WNhv?9a=OVfnAH-#ntq!89SRv3%!DCVh2^x5FA&#Uf@4 z2>31JzSJJdpSYCl&kksr0%jT>{01h--Fe&_TH?)3B9HpF>G3TMtv9E|cr zyTiQ1hrUrGtQ#j}L>tH0Av*5&ufml|7jtRJx~$yyElVw>g1xa8k`-bDecx-dc! zkRBV~1gpVWi!DRn0(>jyw>k;kzGeDGm{^L1zEv|2Fdo?X$@d5r6yL1KD{8>La9^F| z3QKoG1!z}16{mNW9wiEMjZ3N!K^VAPlhAoRZ%3i%+Ee?pzc&9ki+fk0)rfe=EjR%c z1zx0EH|@-YS|}p(80WSRf|RopT58;j?pg=Z3z(c z(w~ehFLaUGon?qim{e63rR}|PR^d!Ir$3HRon>qi>LEMyEru-L@S>&Cz zU-At=Aj#L&dNhsNR#&ehDu(37v{qdCm4kl{0Yu)U*_Ac(xLK*U70?5MJ7X@CP{M^k z=-T8QyLq!A*!ZYhMGd~JPAuNmMzM6pewr(O;5W**m`GDN%w1eF6)tE!#W>iu0u24OVQMHRoFA{-P0O=B(8Cc7(XA>|d^oXs}+zHv-nlGm8vdL6VzdIt7xLH@sMD8dxwoF|>O|`Gw+k^? zyuU?%*Y7R1$CVO$KR2~-w3yz5xwvU@PCtGF{$8&7NiRsj=ArtrVVSeV**8Qkk2=zHkj?3L@wj6|UG5FmpF_mQQPH1Q`g;BtG{@duAP`lv%JM^>;PRSvrq%XkXkSgmI2X#KC8+Jj3`$X|KpM#b zw&|rS*Rmd~NteybQ5f{`dA;!rLW!yh3RD;z%F1uGPIg*BsAse{9MFVJ=ari3Fn49L}(h{Eh_Y%ZMi)SW?*W z0ctu`5Ou;Q2TTunz=}W(+||cT|rvh?=BHZAJ3qa3CtR=P#QF5m>RQ zqOsHvGiw5+{u_yKkA~}qxM1=)EmuaG@{DpA#lxzx+I*6vnTrcVdr=d`DxHM zMdTkkq}?!*rR&`#G3~quRbJkt5Sc}VDZs8{sl}d6R8%{sfkGt6q)>|wdU=gsd@sHC zv;T8wg>wIW<o(gqFrMCGy#=Kh~sAKUwgN7l3UHP8j9uugS- ziE|SDr@!e|yT-u%F|_BuHXn=IOyX^Li5)J+Sk=C`MrsSUSq>Waq5grThYB`<#th5~ zuRnoKjrwxB!cOc7bB$587}-x3gqwZ<6-{U2&@cJfM(GDC$!=bqf$Is~=WCPoJqK&= zGe@`5ept%-17*K3HC-&JR&)N4WlKpfQ(xsi&4l8#7ARx}9tkV?UOwY%{T$NokK(dc z9P*`4xol@aamM?CruoxIk{KzrfOm5hnNz-k6f4Wq z99~o`#X$AW(nn1^6`x&meQEfmr4}4f-RyDpsGm!=HU}hq|15iZ3OVEEsPxc<&R1@g zB#KZwwqwm;Pn(?29OcVh7##N1AsUtxtK_j2yJeG zCS@dTS%lb)tIc93r{FZ?B0JRpu_vzgX;J4|4g`03FMsdDrKoZS0XKKg^lBY~{{m3W z?+jPl*GpK~zxABwzvlUg^^kGD5)7{DTR{R4cT?6t#QQgLz~ZFx@orD7ndo_N7w-)< z?yK!CN0`(?@RO~;@0NR}+7Fit32S#L_K~DGA04|MM>(n7)B0;pub)H3aND5de?~oZ zOb#tfRncEf?t!x*v}_zk}LxtQtC7gb&!@1U9kJbH$=o!o5!U#_s3$HD^q(Z zV6|OY?x$yC#f4Frxb)J2{;xI{Vn`B6I~pc>W#|VkEYdv$J983q72J6U?Cx`7-UQHn zWxE8ESKJn97q@KeP)uG)BniA4D0R4=a;iM(ZhGd6{X$=E&wR!8IEVF;qn3=)yS?1@ zMEp(;ZZ6){TZbqxyEe#a(2>3yxe(d@@6~SloJURog&E{kW63<>XMXe#e*W z?8iOVm7_-Rj1z=Or24JLHbnV zU2tOqNY(t_*U#Q_Tgqy|qQej2g&JI~F28pWQoYV|bIsV_>boV^b>CoqCwc?Binc}k zCG@`b(&ddg`{RwJX<%a!D*7ott_0}rG?oi3@%A&+4p~GtBOz%cW5rXV&nPuVr zo)LeRXMcmTf4Zys18u;?Ms&4c7usP3ey^k!_-!7aZy2b8T91S-$HKIw(1MG>4JGoa z!Eq09JVVxeYH8I@NO+|%2Jh-LucerAGwdV%H`(%+=rO`KGH+AFVu4Af8!^j;N9<%6 zKK`}7n8R+C1i1Eqee!8f#q~uVao2|9&6GZc4dL>SiT`-Ym4C<8OPIg+^B#_`Js5x- zg`;B|V36^FsCVaRsemqx^? zs=%}Fg`T3pRj|JqIBwnB5|Zs)KhDr!(9+#$z3Mm{3ndl?l6>$CSc@e=923Kua7Y=< zUS#3M!ej<65Hb05#e2VIqt(F7S$>gIoGY}WKmBe#5#dRgWMHQu!@9m=IFb`!x3TL$ z{PzN0c&2N5_jBInNcIV^a%`hGQ%i6b@&)@ycDoZjxzlBjV)MtR&D!Uw`qK3)&B%aC z*O+PK7&l3$-kui1A#r{le3bceSP*Dc2$!BCD`w2^WWA>yj8EkXP$k>%6s}ncJl4v zuB|n6ayC9sFp8t_b=uXB=hiz?Xe%H!h>5`p1#2b*rNdB#4ttjmfLVJssulK;uwGX7 z*8%;n<{DdcFBON_%`$73#WjyYVTs5=-*g3n$Gm!H>n=WWkL)4zV8}Q2MlfL}bbWTD z{=TuOl^=&Otc?p%32`2dERF#arZk6Wvp7)Afy6td4czwwMr83~`CtiAvfD>1OZQ^( zTXfUZ@^yuyuPlkKS`BAD)C>YF;Yam@CD~J#=W3TUYlEGW=G5QcT%U1xu01>dNNn)B zCXwo8$fJ`>GS{NYZ4vd>PBCJz$xv^{&u1$NIvCz~&n0u23bQE+XDH%>z6tMgf_axG zqxU$pb@d}B7ZQ3BnP?t~z8PL0>hP^${Z;Sg{)+C3)0QtVNH+{*XjP3CG$ObOCVt{W z?#@V(Q(OzDkXK^&yAGL|;w&HLxU=s)1@?Zz@IE0M4h~Iu*0T9zR+KF!wDYX5mBGE8 zv^sNL`+;rfVY9uj^^Mz@ldnw*-OpxKS$(2}kr>FXQZ`>>&r8yAU3W0<;H_9v(=+jI z;xs9E(D(42oBtsuR(n>pCaTVk*j-=gjkZHSh z?gh_`PMJ#ttr&b;5wrGg7^HcU_^uhk6*3{!{L0}tfnzNC^~?dOr$aWiwt5inDdIa5_+$1%svuq{(SUm)^BwZTJej@i;2;1?#f1WQ4!drX^VX6?Isje9rcP zV=+xClJg3geQ=hd7aDY?5Qr~7wK6qA7WBUNw6X`zy1!iGI9Pau+<`Fb6`3aqAlrkrsVRp_N;tX93nbUSJ#! z5BqlXX-oCq0>cW4-%Ny$6}tOnuy8B&l9!R+6+6~>idU5Z%ZCBfkJJ0}?<@xxlR*TD zUAXeZ4JUUf5OHjK?*=@-9Ya;k>SQ=nz}G@FXothiW;A1Gpeok>e*dR>^r6e!MA{?8 zU@ICiCHS1H%aKYFYZ%ON(@n7C>S-7E!y@Z;9gDqpr{;b@8x2q|(a7OA?ps$SO`{bj$Crq1I7xK*#-(y$s)HKL1GnX-Kg%uw8p9}kNuK29 z%p>*aAAq1#etp?9tSruT{atBe`D+)b}!Us`KE_?U(BjRnsI zpZc|ms%%2`q9N%Z+t!8#7 z-svZ((8B%Iqa?ECjWJ6q|yc{sUQmtBxP1E1CK3FwHdP_;pwO{fXYsOex!Bg}aba(~8X zzmc(@`>+N>3k-2O==sf1|IE)`gM`D2%dcE+;u0clTn_Git-Roi%lz9!{XE!k{aZDJ zE)RNk8=zXChjaXiG#L4iyhc^HIkzM{#G|+%HH0e<+PEBG1HiFx&XUG}kr>cilX{;y zeIc!ysY#ejJK})I^_~He1B*)!@c8!WS5&}uhrmPx{5|pf{Kny~d~^-|WLq)c54ZPY z$M|PfLszSQ=tUPduzx2zx_sP=i(-f!nn1p^IHz4$fG?b&m8c}$fg~UxD%R?z!MfCi z%g81jmOmRKUUPpa#vmb|?NKz){FIjwJ$6G_cg)fO5N`{!H`^CUeLQFd-E*^H#7G}QCT@Nh^t7~^2*WZ_}k}P725T=9oRZ* z&@%C#f%Cv63y~SY{;X%5&6unHS{chyVV!zwXe|_{${&2uB1;?Mz51T{Q2ffO#u~O) zPRWlQem?oZ@JCrwo)i##BMRVQ8S`8UYK#0E>a1wry!*VOjWgj=k=2h@1MMs5oj;W? z|2e;{?dw#Y-?uf@BJXP#)N>Iw+U$YvVnXoMK2gN)qDJq;&#CRK=XfLH1ZL=(YV}#D zj@+JVg?1GLLy4Krv}86w9_r|N4VEInU;m8ovZv>m^<*b@ctF8_!rF!Gt{QO+y?+#T zKQB7)*b0BFR2o2#XkaorTGcmP|I+M9$qT&==GXQLYv#AK!u!7=%u`)@!V4M3aBx@#<7S6H^d*j9&CLa=;qk(Whv5{3kWX8~Zo}H#v^^~Q4pK_f0ic3M7+AK1 zYDHE5g*DmTSNw|N=C5t8TAl2rJ?2BJTD5UQu^fB_!?3i76hz zGa9$E3lvzM9gzU4G&W+|BOU6#_&!ib!u>*Nf3!x9npWel>9UO1QFNRwu-02A@c=5K zqctZ0l+wGEeuy`Gb4q?sUZcbQdDV>=AJ zGqGrHU>=x#ZDNyL?i?|JCD}6<|^Uk77T%4n92fzUzQSLLx2W}h=~(`hhOP4Mp?udV__;u$yf1N$Mm4|_4!+EQ@UVol!u3?*7nOR^5>#)#C)MgQM%2u~X* z$&Q_M$ft$bmB478>nF1qx1NM7Z3RwAQ%~!5?H*+ag$HNAN<11BIH4n*QMHMRgh!xH;QbEBvX=xKa=CXg6 ztcYBq3o-!9JTt6Z{`E85t5{^rrSO&z(osr<~<@Y`HUw73JYf|cF<7kdf2)Iqz z(pJ~T$9HRCSE60+EcA2#$gutSuwGevwpj!*_ZT3xm_0Rhh`i`p^0=UheAtgPkL!3d zdtwLmtMk*9K~Nl!sMt)gB!fWzcs)EuSd`zze9_jXPH&|il;3CTMPlcj0B~|uV>pqt z5h@cRkvf-=UzVV?=7Jx)=1kvYp`$-iu)R!@cSDX5Hmq6V4yStxx@gsIk(+51{$0OD z<;ek+{QMSjsZ`>EGDN+c2N{>N#&w&uuGcFz;?Hmcs~6hsO9t zv*&$pNoU{qY&~5l`%6|O{=OyLg5vuL{{regm+CqT6HGdU-{PC=C#(?wuXu)I)~GLC zb#kYkcA1>}iR5j=b!a*FG+a)OEMo3DG})Q1DYafh+muMupMY_tRz0qhh&HM@=0`oL zDdnnB{aROUwxZk2Czq3tZ?0&S@_F74ZMtqb*m32T=-s;MKhzW5Eh2U!@(<%z!1w8% zQ_@@!&@nXAuzRS7srKY55+jndlAeJSXu=_wZCYDDxFitz&3t7+$PKh-?t%8*^ShfJ zBq4S!!L2Hy4XrO>{gH_h@(p~+w1^0w4={5z&&g-0v1&~qeH}ILI;)F>-{I`NWpOFB zb}At`4rFa4Fl3(w?{cVENBvQ2Mibi*o9GK4W*_DKJ)gQgz^cDRJL*kwBoSWmbb;O z@3Jk7>;46`&3X}hlW(b{NQ-90ElyUNlm{MWg2T)|KBNokzh4msRD5A**32nA2_Bpb zN#4f{4>-tb00Q@W&O?kAk$K4)%`9SxKXL?*nB_bUHKCx}sm%}5BENDZ5>&ApWV*kL z%Hra-rsn0Xjf^pY&pG|WMFS&Fpe?Rj`sQ4*>pkZMf?a$UGg(kFmb2P?7D|Rca-&g& zs;>?=eE{7dLwn48!^&#^tZRmY$|^V__Ij^M&d&2@#KBYYd>{u_uVJyR1V%;Phf6zl zu4*Y_(fD1GzcQxg8L1^6)PaMUVb<&Sx99YdApso1moiwRPsT${YN$ExWcvb=#<$s9 zFOm^oRgCS{vZvxQf~8g7eIU?eT=RHY-nY(|g_f2&(4ycM>{?C!p@mbzXf?uD$InkW zU$Q;8N(>mP9)7`;B~Yo_%?v-W|LJ;W*ClZ>aaIH1;vnbylGbAMgK9*#@$Z>h!9EG?kb5586)EaRvxTWv&IEf_AGsM>U3W_;)#B!l6=rGa~A5HO_}X zlhK(ZTvd~NB}|1E@qxwt-THQ_v$ zvr#qC6EW}SgiQ{AZK%$+I_ATHZyPxNg_Q?7pN%*lq(LXAKT6_^q0kl2ILQAi@q8n6 zAyWN6El;ffLC#)|SUS00Z+I9`&>q9(}t@&w2CTA1S-7!XeY2 zybXsEj+NKpbAV~a|42#Sc(To&(-I7lDt>vm9rT|LRWF4 Date: Tue, 18 Apr 2023 16:51:45 -0400 Subject: [PATCH 066/110] Fix spelling error --- vignettes/dev04_RECIPES.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/dev04_RECIPES.Rmd b/vignettes/dev04_RECIPES.Rmd index 0769715c..39405934 100644 --- a/vignettes/dev04_RECIPES.Rmd +++ b/vignettes/dev04_RECIPES.Rmd @@ -53,7 +53,7 @@ The `blocks` object is actually an array of `block` objects. The setup may feel * The `variable` element denotes the field or parameter from the `data` data set to analyze with a statistical computation. * The `statistic` element denotes which statistical procedure to perform on said field/parameter. -A few other elements can also be present within a `block` object, such as: `var_selction`, `var_options`, `var_options_fn` and their statistic counterparts `stat_selection`, `stat_options`, and `stat_options_fn`. A `var_selection` element can be used in conjunction with `var_options` to create a subgroup filter for the variable. A `stat_selection` element is only required when the `statistic` element requires it. As seen in the example above, the "NESTED_FREQ_ABC" `statistic` needs to know a secondary variable by which to produce its "nested" output. Besides those mentioned, no other elements are used in the `recipes.json` file or within the application's code base, but active development will be changing this soon. +A few other elements can also be present within a `block` object, such as: `var_selection`, `var_options`, `var_options_fn` and their statistic counterparts `stat_selection`, `stat_options`, and `stat_options_fn`. A `var_selection` element can be used in conjunction with `var_options` to create a subgroup filter for the variable. A `stat_selection` element is only required when the `statistic` element requires it. As seen in the example above, the "NESTED_FREQ_ABC" `statistic` needs to know a secondary variable by which to produce its "nested" output. Besides those mentioned, no other elements are used in the `recipes.json` file or within the application's code base, but active development will be changing this soon. ## Parsing `recipes.json` From 3f07115ae41479648caa99f47b27a6a9236261ae Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 18 Apr 2023 16:54:45 -0400 Subject: [PATCH 067/110] Fix variable recipe check --- R/mod_tableGen.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index 626da7f6..090cb1bf 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -72,7 +72,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL purrr::map(~ stat_options(.x, datalist = datafile())) %>% purrr::map(~ var_options(.x, datalist = datafile())) var_check <- recipe$blocks %>% - purrr::map(~ .x$var_selection %in% c("ALL", .x$var_options)) %>% + purrr::map(~ .x$var_selection %in% c("ALL", unlist(.x$var_options, use.names = FALSE))) %>% purrr::compact() %>% unlist() stat_check <- recipe$blocks %>% From e0476a9bb8b940c3da3b9df036d85869cfe3519e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 19 Apr 2023 08:58:22 -0400 Subject: [PATCH 068/110] Add example for ATPT --- vignettes/dev04_RECIPES.Rmd | 47 ++++++++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) diff --git a/vignettes/dev04_RECIPES.Rmd b/vignettes/dev04_RECIPES.Rmd index 39405934..93158db9 100644 --- a/vignettes/dev04_RECIPES.Rmd +++ b/vignettes/dev04_RECIPES.Rmd @@ -149,6 +149,28 @@ Similarly, the element `stat_selection` is used to determine the input for a sta The `var_selection` and `var_options` combination is processed in a slightly different way. The application tries to create a filter. In order to accomplish this, the field must also be included as a group. For instance, one could have the following variable options: `"var_options": {"ATPT": ["AFTER LYING DOWN FOR 5 MINUTES", "AFTER STANDING FOR 1 MINUTE", "AFTER STANDING FOR 3 MINUTES"]`. The variable selection of `"var_selection":"AFTER STANDING FOR 3 MINUTES"` would result in creating the filter `ATPT == "AFTER STANDING FOR 3 MINUTES"`. There are two exceptions: (1) `"var_selection":"ALL"` will make multiple blocks, one for each options and (2) `"var_selection":"N/A"` will create the filter `is.na(ATPT)` if "N/A" was included as one of the options. Note that if using `var_options_fn`, a named list must be output. +## `ATPT` Example + +### The JSON file + +This JSON object when included in `recipes.json` will create a table for mean Diastolic Blood Pressure at all Time Points and all Visits: +```{r, eval=FALSE} +"tbl_1": { + "title": "Custom Table 1: Diastolic Blood Pressure by Visit", + "blocks": [{ + "data":"ADVS", + "variable":"DIABP", + "var_options_fn":"atpt", + "var_selection":"ALL", + "statistic":"MEAN", + "stat_options_fn":"avisit", + "stat_selection":"ALL"}] +} +``` + +### The S3 Methods + +Here are the functions to create the variable options and the statistic options (note that these functions are already included in the package): ```{r, eval=FALSE} # Example for `atpt` class var_options.atpt <- function(block, datalist, ...) { @@ -159,10 +181,33 @@ var_options.atpt <- function(block, datalist, ...) { varN_fctr_reorder() %>% dplyr::pull(ATPT) %>% get_levels() %>% - {list(ATPT = as.list(.))} + {list(ATPT = as.list(.))} # Note that this is a named list block$var_options <- atpts block } + +# Example for `avist` class +stat_options.avisit <- function(block, datalist, ...) { + avisits <- + datalist[[block$data]] %>% + dplyr::filter(stringr::str_detect(toupper(AVISIT), "UNSCHEDULED", negate = TRUE), + AVISIT != "") %>% + dplyr::distinct(AVISIT, AVISITN) %>% + varN_fctr_reorder() %>% + dplyr::pull(AVISIT) %>% + get_levels() %>% + as.list() + + block$stat_options <- avisits + + block +} ``` + +### The Table Output + +```{r, echo=FALSE} +htmltools::includeHTML("figures/recipes/ATPT_tbl.html") +``` \ No newline at end of file From 384908d93b228e3b2b52d82db1ad7a158d737744 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 19 Apr 2023 09:07:29 -0400 Subject: [PATCH 069/110] Include `{htmltools}` in Suggests --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index cf7eeb0d..592b5526 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -65,6 +65,7 @@ Imports: timevis, tippy (== 0.1.0) Suggests: + htmltools, knitr, spelling, testthat From 7d18651e5ec120b351c8894907be685fd3d14ed6 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 19 Apr 2023 09:25:34 -0400 Subject: [PATCH 070/110] Another attempt --- DESCRIPTION | 1 - vignettes/dev04_RECIPES.Rmd | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 592b5526..cf7eeb0d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -65,7 +65,6 @@ Imports: timevis, tippy (== 0.1.0) Suggests: - htmltools, knitr, spelling, testthat diff --git a/vignettes/dev04_RECIPES.Rmd b/vignettes/dev04_RECIPES.Rmd index 93158db9..189806e4 100644 --- a/vignettes/dev04_RECIPES.Rmd +++ b/vignettes/dev04_RECIPES.Rmd @@ -209,5 +209,5 @@ stat_options.avisit <- function(block, datalist, ...) { ### The Table Output ```{r, echo=FALSE} -htmltools::includeHTML("figures/recipes/ATPT_tbl.html") +knitr::asis_output(htmltools::includeHTML("figures/recipes/ATPT_tbl.html")) ``` \ No newline at end of file From 9eeb06f3d423736980d5198a18c559897e3e8606 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 19 Apr 2023 09:42:12 -0400 Subject: [PATCH 071/110] Fix issue with doing processing all ATPT values --- R/mod_tableGen.R | 2 +- R/mod_tableGen_fct_param_opts.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index 090cb1bf..633a77a4 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -72,7 +72,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL purrr::map(~ stat_options(.x, datalist = datafile())) %>% purrr::map(~ var_options(.x, datalist = datafile())) var_check <- recipe$blocks %>% - purrr::map(~ .x$var_selection %in% c("ALL", unlist(.x$var_options, use.names = FALSE))) %>% + purrr::map(~ .x$var_selection %in% unlist(.x$var_options, use.names = FALSE)) %>% purrr::compact() %>% unlist() stat_check <- recipe$blocks %>% diff --git a/R/mod_tableGen_fct_param_opts.R b/R/mod_tableGen_fct_param_opts.R index 3bcb8227..cb3ef1a2 100644 --- a/R/mod_tableGen_fct_param_opts.R +++ b/R/mod_tableGen_fct_param_opts.R @@ -65,7 +65,7 @@ var_options.atpt <- function(block, datalist, ...) { varN_fctr_reorder() %>% dplyr::pull(ATPT) %>% get_levels() %>% - {list(ATPT = as.list(.))} + {list(ATPT = as.list(c("ALL", .)))} block$var_options <- atpts From dff022862ea5032ad00128d8ecbde5ab84fa3e2f Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 19 Apr 2023 09:57:45 -0400 Subject: [PATCH 072/110] Add the HTML file... --- vignettes/dev04_RECIPES.Rmd | 3 +- vignettes/figures/recipes/.gitignore | 1 + vignettes/figures/recipes/ATPT_tbl.html | 952 ++++++++++++++++++++++++ 3 files changed, 954 insertions(+), 2 deletions(-) create mode 100644 vignettes/figures/recipes/.gitignore create mode 100644 vignettes/figures/recipes/ATPT_tbl.html diff --git a/vignettes/dev04_RECIPES.Rmd b/vignettes/dev04_RECIPES.Rmd index 189806e4..3287b6a9 100644 --- a/vignettes/dev04_RECIPES.Rmd +++ b/vignettes/dev04_RECIPES.Rmd @@ -207,7 +207,6 @@ stat_options.avisit <- function(block, datalist, ...) { ``` ### The Table Output - ```{r, echo=FALSE} -knitr::asis_output(htmltools::includeHTML("figures/recipes/ATPT_tbl.html")) +htmltools::includeHTML("figures/recipes/ATPT_tbl.html") ``` \ No newline at end of file diff --git a/vignettes/figures/recipes/.gitignore b/vignettes/figures/recipes/.gitignore new file mode 100644 index 00000000..7e0caf8f --- /dev/null +++ b/vignettes/figures/recipes/.gitignore @@ -0,0 +1 @@ +!*.html diff --git a/vignettes/figures/recipes/ATPT_tbl.html b/vignettes/figures/recipes/ATPT_tbl.html new file mode 100644 index 00000000..4f404bb4 --- /dev/null +++ b/vignettes/figures/recipes/ATPT_tbl.html @@ -0,0 +1,952 @@ + + + + + + + + + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Custom Table 1: Diastolic Blood Pressure by Visit
Filters Applied:

Total
N=254
Descriptive Statistics of DIABP at Baseline/ AFTER LYING DOWN FOR 5 MINUTES
n253
Mean (SD)76.4 (10.22)
Median76.0
Q1 | Q370.0 | 84.0
Min | Max40 | 100
Descriptive Statistics of DIABP at Baseline/ AFTER STANDING FOR 1 MINUTE
n253
Mean (SD)77.4 (10.51)
Median78.0
Q1 | Q370.0 | 84.0
Min | Max51 | 108
Descriptive Statistics of DIABP at Baseline/ AFTER STANDING FOR 3 MINUTES
n253
Mean (SD)77.9 (10.74)
Median78.0
Q1 | Q370.0 | 84.0
Min | Max46 | 110
Descriptive Statistics of DIABP at Week 2/ AFTER LYING DOWN FOR 5 MINUTES
n250
Mean (SD)75.1 (9.75)
Median74.0
Q1 | Q370.0 | 82.0
Min | Max45 | 100
Descriptive Statistics of DIABP at Week 2/ AFTER STANDING FOR 1 MINUTE
n249
Mean (SD)75.8 (10.85)
Median75.0
Q1 | Q370.0 | 82.0
Min | Max43 | 112
Descriptive Statistics of DIABP at Week 2/ AFTER STANDING FOR 3 MINUTES
n248
Mean (SD)76.1 (10.56)
Median76.0
Q1 | Q370.0 | 82.0
Min | Max45 | 118
Descriptive Statistics of DIABP at Week 4/ AFTER LYING DOWN FOR 5 MINUTES
n227
Mean (SD)75.5 (9.72)
Median76.0
Q1 | Q370.0 | 82.0
Min | Max41 | 100
Descriptive Statistics of DIABP at Week 4/ AFTER STANDING FOR 1 MINUTE
n227
Mean (SD)76.0 (10.60)
Median78.0
Q1 | Q370.0 | 82.0
Min | Max39 | 98
Descriptive Statistics of DIABP at Week 4/ AFTER STANDING FOR 3 MINUTES
n227
Mean (SD)76.6 (10.37)
Median76.0
Q1 | Q370.0 | 84.0
Min | Max46 | 102
Descriptive Statistics of DIABP at Week 6/ AFTER LYING DOWN FOR 5 MINUTES
n208
Mean (SD)74.5 (10.27)
Median76.0
Q1 | Q369.0 | 80.0
Min | Max48 | 100
Descriptive Statistics of DIABP at Week 6/ AFTER STANDING FOR 1 MINUTE
n209
Mean (SD)74.9 (9.82)
Median75.0
Q1 | Q370.0 | 80.0
Min | Max49 | 110
Descriptive Statistics of DIABP at Week 6/ AFTER STANDING FOR 3 MINUTES
n209
Mean (SD)75.2 (9.27)
Median76.0
Q1 | Q370.0 | 80.0
Min | Max49 | 100
Descriptive Statistics of DIABP at Week 8/ AFTER LYING DOWN FOR 5 MINUTES
n189
Mean (SD)75.5 (9.10)
Median76.0
Q1 | Q370.0 | 80.0
Min | Max49 | 98
Descriptive Statistics of DIABP at Week 8/ AFTER STANDING FOR 1 MINUTE
n189
Mean (SD)76.1 (10.44)
Median76.0
Q1 | Q370.0 | 84.0
Min | Max50 | 101
Descriptive Statistics of DIABP at Week 8/ AFTER STANDING FOR 3 MINUTES
n189
Mean (SD)76.2 (9.86)
Median78.0
Q1 | Q370.0 | 82.0
Min | Max56 | 101
Descriptive Statistics of DIABP at Week 12/ AFTER LYING DOWN FOR 5 MINUTES
n171
Mean (SD)73.9 (10.05)
Median74.0
Q1 | Q368.0 | 80.0
Min | Max50 | 100
Descriptive Statistics of DIABP at Week 12/ AFTER STANDING FOR 1 MINUTE
n171
Mean (SD)74.7 (10.56)
Median74.0
Q1 | Q368.0 | 82.0
Min | Max49 | 100
Descriptive Statistics of DIABP at Week 12/ AFTER STANDING FOR 3 MINUTES
n171
Mean (SD)75.9 (10.60)
Median76.0
Q1 | Q368.0 | 84.0
Min | Max50 | 104
Descriptive Statistics of DIABP at Week 16/ AFTER LYING DOWN FOR 5 MINUTES
n147
Mean (SD)74.5 (10.03)
Median75.0
Q1 | Q368.0 | 82.0
Min | Max50 | 98
Descriptive Statistics of DIABP at Week 16/ AFTER STANDING FOR 1 MINUTE
n147
Mean (SD)75.7 (10.49)
Median76.0
Q1 | Q370.0 | 82.0
Min | Max49 | 98
Descriptive Statistics of DIABP at Week 16/ AFTER STANDING FOR 3 MINUTES
n147
Mean (SD)75.9 (10.51)
Median76.0
Q1 | Q370.0 | 84.0
Min | Max49 | 98
Descriptive Statistics of DIABP at Week 20/ AFTER LYING DOWN FOR 5 MINUTES
n128
Mean (SD)73.0 (9.55)
Median72.0
Q1 | Q368.0 | 80.0
Min | Max54 | 100
Descriptive Statistics of DIABP at Week 20/ AFTER STANDING FOR 1 MINUTE
n128
Mean (SD)73.4 (11.00)
Median72.0
Q1 | Q366.0 | 80.0
Min | Max48 | 100
Descriptive Statistics of DIABP at Week 20/ AFTER STANDING FOR 3 MINUTES
n128
Mean (SD)74.4 (10.35)
Median74.0
Q1 | Q368.0 | 80.0
Min | Max49 | 98
Descriptive Statistics of DIABP at Week 24/ AFTER LYING DOWN FOR 5 MINUTES
n116
Mean (SD)73.9 (10.33)
Median75.0
Q1 | Q368.0 | 80.0
Min | Max44 | 109
Descriptive Statistics of DIABP at Week 24/ AFTER STANDING FOR 1 MINUTE
n116
Mean (SD)74.9 (11.79)
Median76.0
Q1 | Q365.0 | 80.0
Min | Max45 | 117
Descriptive Statistics of DIABP at Week 24/ AFTER STANDING FOR 3 MINUTES
n116
Mean (SD)75.2 (10.87)
Median75.0
Q1 | Q368.0 | 82.0
Min | Max50 | 110
Descriptive Statistics of DIABP at Week 26/ AFTER LYING DOWN FOR 5 MINUTES
n111
Mean (SD)72.5 (9.76)
Median71.0
Q1 | Q367.0 | 80.0
Min | Max46 | 93
Descriptive Statistics of DIABP at Week 26/ AFTER STANDING FOR 1 MINUTE
n111
Mean (SD)74.0 (11.44)
Median74.0
Q1 | Q368.0 | 80.0
Min | Max39 | 98
Descriptive Statistics of DIABP at Week 26/ AFTER STANDING FOR 3 MINUTES
n111
Mean (SD)73.2 (10.60)
Median72.0
Q1 | Q366.0 | 80.0
Min | Max49 | 98
Descriptive Statistics of DIABP at End of Treatment/ AFTER LYING DOWN FOR 5 MINUTES
n227
Mean (SD)73.7 (9.47)
Median72.0
Q1 | Q368.0 | 80.0
Min | Max46 | 100
Descriptive Statistics of DIABP at End of Treatment/ AFTER STANDING FOR 1 MINUTE
n227
Mean (SD)74.8 (10.65)
Median74.0
Q1 | Q368.0 | 81.0
Min | Max39 | 100
Descriptive Statistics of DIABP at End of Treatment/ AFTER STANDING FOR 3 MINUTES
n227
Mean (SD)74.5 (10.61)
Median76.0
Q1 | Q368.0 | 81.0
Min | Max49 | 102
+ Source: tidyCDISC app + Run Date: 19APR2023 +
+
+ + From 996fceb22d21e398d5680dfb931c6e33c29984c1 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 19 Apr 2023 13:18:09 -0400 Subject: [PATCH 073/110] Change `_arg` to `_selection` in blockData --- R/blockData.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index f25a5875..c5d0a0b8 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -326,10 +326,10 @@ table_blocks <- out_lst <- list() out_lst$data <- block$df out_lst$variable <- block$txt - out_lst$var_arg <- block$val + out_lst$var_selection <- block$val out_lst$var_options <- if (!is.null(block$val)) list(ATPT = as.list(block$val)) out_lst$statistic <- agg$txt - out_lst$stat_arg <- agg$val + out_lst$stat_selection <- agg$val out_lst }) From a0666634bac2bc8fa29fdc480e9e54ab7fffaa7f Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 19 Apr 2023 13:21:43 -0400 Subject: [PATCH 074/110] Update NEWS --- DESCRIPTION | 2 +- NEWS.md | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index fe969ee8..2ec9bdb3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: tidyCDISC Title: Quick Table Generation & Exploratory Analyses on ADaM-Ish Datasets -Version: 0.2.1.9002 +Version: 0.2.1.9003 Authors@R: c( person("Aaron", "Clark", , "clark.aaronchris@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-0123-0970")), diff --git a/NEWS.md b/NEWS.md index c0204f57..ca508f66 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ * Improved code determining which standard tables to provide as options based on data uploaded (#167) * Fixed bug causing standard tables to run twice when grouping selected (#167) * Added var option functionality to "recipe" creation +* Added a new R6 class to create blockData (#126) # tidyCDISC 0.2.1 (CRAN Release) From 83d252d9c5b4e6cac0ccaa2e4f587c0d24bdf6b6 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 19 Apr 2023 13:54:47 -0400 Subject: [PATCH 075/110] Update WORDLIST --- inst/WORDLIST | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/inst/WORDLIST b/inst/WORDLIST index 96ef441d..4c885487 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -23,7 +23,6 @@ CDISC CMD CSR Conf -DIABP DIY DT Downloader @@ -56,14 +55,13 @@ VARN VARN's YYYY adae -addBlock adlbc adsl adtte advs automagically -bd bdat +blockData bonafide boxPlot callModule From 6bfc249746ec847a0dc5aaa8c58df3ea3cdb5ccd Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 19 Apr 2023 13:56:05 -0400 Subject: [PATCH 076/110] Add "ATPT" and "ATPTN" to list of global variables --- R/global.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/global.R b/R/global.R index 3ee7f870..16fe761e 100644 --- a/R/global.R +++ b/R/global.R @@ -126,7 +126,8 @@ utils::globalVariables(c( "pval_hover", "sort_n", "v", "var", "var_rn", "where", "y", "type", "title" ,":=", - "DATE", "EVENT_TIME", "DATE_ST", "DECODE_ST", "DATE_EN", "DECODE_EN" + "DATE", "EVENT_TIME", "DATE_ST", "DECODE_ST", "DATE_EN", "DECODE_EN", + "ATPT", "ATPTN" )) From aaf0ae434d49ca8a4031d2de0ee3ac57f4fa393f Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 20 Apr 2023 11:20:33 -0400 Subject: [PATCH 077/110] Fix issue with `setGroup()` and `setTitle()` --- R/blockData.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index c5d0a0b8..4eb65eb7 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -103,7 +103,7 @@ table_blocks <- #' Set the title for the table #' @param title The title for the table set_title = function(title) { - if (!group_by %in% private$all_cols) + if (length(title) != 1 || !is.character(title)) stop("Invalid input. Title must be a string.") self$title <- title @@ -113,7 +113,7 @@ table_blocks <- #' Set the group by field #' @param group_by A field to group the table by set_groupby = function(group_by) { - if (length(title) != 1 || !is.character(title)) + if (!group_by %in% private$all_cols) stop("Invalid input. Must be a column from a data set in the data list.") self$group_by <- group_by From 6937054dd8ef9097242834a9d919a483d07425ef Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 20 Apr 2023 12:20:16 -0400 Subject: [PATCH 078/110] Only compute added blocks instead of whole list --- R/blockData.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 4eb65eb7..c325afb3 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -299,8 +299,9 @@ table_blocks <- private$block_drop <- c(private$block_drop, process_drops$blocks) private$agg_drop <- c(private$agg_drop, process_drops$aggs) - private$create_TG(private$agg_drop, private$block_drop) + blockData <- private$create_TG(process_drops$aggs, process_drops$blocks) + self$blocks <- dplyr::bind_rows(self$blocks, blockData) self }, #' @description @@ -311,7 +312,7 @@ table_blocks <- private$block_drop <- private$block_drop[-x] private$agg_drop <- private$agg_drop[-x] - private$create_TG(private$agg_drop, private$block_drop) + self$blocks <- self$blocks[-x, ] self }, @@ -357,8 +358,7 @@ table_blocks <- blockData$label_source <- "N/A" - self$blocks <- blockData - invisible(self) + blockData } ) ) From beef286d5dd975954b9708d2424a5bc893a7539a Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 20 Apr 2023 12:21:31 -0400 Subject: [PATCH 079/110] Add `filter` to initialized value of `blocks` --- R/blockData.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/blockData.R b/R/blockData.R index c325afb3..99b9f544 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -13,6 +13,7 @@ table_blocks <- block = character(), dataset = character(), dropdown = character(), + filter = character(), S3 = list(), gt_group = glue::glue(), label = character(), From e6aa107d680758378f2f5ad4c9ddf18580ae673d Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 20 Apr 2023 12:44:12 -0400 Subject: [PATCH 080/110] Switch to append functions allowing for placement --- R/blockData.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 99b9f544..57428ca8 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -297,12 +297,12 @@ table_blocks <- } process_drops <- process_droppables(list(list(aggs)), list(list(blocks))) - private$block_drop <- c(private$block_drop, process_drops$blocks) - private$agg_drop <- c(private$agg_drop, process_drops$aggs) + private$block_drop <- append(private$block_drop, process_drops$blocks) + private$agg_drop <- append(private$agg_drop, process_drops$aggs) blockData <- private$create_TG(process_drops$aggs, process_drops$blocks) - self$blocks <- dplyr::bind_rows(self$blocks, blockData) + self$blocks <- dplyr::add_row(self$blocks, blockData) self }, #' @description From 34752f6be11a7d91df90eb157b6363fc2ee3bcc2 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Apr 2023 09:24:53 -0400 Subject: [PATCH 081/110] Allow insertion of table blocks into specified row --- R/blockData.R | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 57428ca8..4a6bc49f 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -127,7 +127,8 @@ table_blocks <- #' @param dropdown A subgroup on which the statistic is calculated (usually an AVISIT) #' @param tpnt A time point on which the calculation is filtered #' @param df The dataset the parameter or field is from - add_block = function(variable, stat, dropdown, tpnt, df) { + #' @param after A subscript, after which the values are to be appended + add_block = function(variable, stat, dropdown, tpnt, df, after = NULL) { blocks <- list() aggs <- list() get_var <- function(x) { @@ -296,13 +297,15 @@ table_blocks <- aggs$val <- get_dropdown(dropdown, "cols") } + if (is.null(after)) after <- length(self$blocks) + process_drops <- process_droppables(list(list(aggs)), list(list(blocks))) - private$block_drop <- append(private$block_drop, process_drops$blocks) - private$agg_drop <- append(private$agg_drop, process_drops$aggs) + private$block_drop <- append(private$block_drop, process_drops$blocks, after = after) + private$agg_drop <- append(private$agg_drop, process_drops$aggs, after = after) blockData <- private$create_TG(process_drops$aggs, process_drops$blocks) - self$blocks <- dplyr::add_row(self$blocks, blockData) + self$blocks <- dplyr::add_row(self$blocks, blockData, .after = after) self }, #' @description @@ -418,6 +421,7 @@ setGroup <- function(bd, group_by) { #' @param dropdown A subgroup on which the statistic is calculated (usually an AVISIT) #' @param tpnt A time point on which the calculation is filtered #' @param df The dataset the parameter or field is from +#' @param after A subscript, after which the values are to be appended #' #' @return The \code{bd} block data object with additional block #' @@ -437,8 +441,8 @@ setGroup <- function(bd, group_by) { #' #' addBlock(bd, "DIABP", "MEAN", "ALL", "ALL") #' bd -addBlock <- function(bd, variable, stat, dropdown, tpnt, df) { - invisible(bd$add_block(variable = variable, stat = stat, dropdown = dropdown, tpnt = tpnt, df = df)) +addBlock <- function(bd, variable, stat, dropdown, tpnt, df, after = NULL) { + invisible(bd$add_block(variable = variable, stat = stat, dropdown = dropdown, tpnt = tpnt, df = df, after = after)) } #' Remove Block(s) from Block Data Object From e9f4ad88e57758bc7583070e84b5a81cde6f4af3 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Apr 2023 09:25:50 -0400 Subject: [PATCH 082/110] Fix issues with inaccurate returns from user input --- R/blockData.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 4a6bc49f..005e99ea 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -139,17 +139,17 @@ table_blocks <- } if (block_txt == "1") { purrr::iwalk(tmp$all_rows, ~ {cat(.y, ":\n ", sep = ""); cat(.x[[1]], sep = ", "); cat("\n")}) - get_var() + return(get_var()) } else if (block_txt == "2") { cat(names(self$all_rows), sep = ", ") - get_var() + return(get_var()) } else if (block_txt %in% names(self$all_rows)) { cat(self$all_rows[[block_txt]][[1]], sep = ","); cat("\n") - get_var() + return(get_var()) } else { if (!any(purrr::map_lgl(self$all_rows, ~ block_txt %in% .x[[1]]))) { cat("Param/field not found. Please type 1 to see all available options.\n") - get_var() + return(get_var()) } return(block_txt) } @@ -165,7 +165,7 @@ table_blocks <- if (filter_txt == "A") { cat("Please type the name or the number corresponding to the desired time point.\n") cat(paste0(seq_along(opt_lst), ": ", opt_lst), sep = "\n"); cat("\n") - get_filter(atpt_lst = atpt_lst) + return(get_filter(atpt_lst = atpt_lst)) } else if (filter_txt %in% seq_along(opt_lst)) { if (filter_txt == "1") return("NONE") @@ -186,11 +186,11 @@ table_blocks <- get_filter(atpt_lst = atpt_lst) } else { x <- as.character(match(filter_txt, unlist(atpt_lst)) + 1) - get_filter(x, atpt_lst = atpt_lst) + return(get_filter(x, atpt_lst = atpt_lst)) } } else { cat('Time point not valid. Please type "A" to see all available options.\n') - get_filter(atpt_lst = atpt_lst) + return(get_filter(atpt_lst = atpt_lst)) } } get_stat <- function(x) { @@ -202,14 +202,14 @@ table_blocks <- if (agg_txt == "A") { cat("Please type statistic or the number corresponding to desired stat.\n") cat(paste0(seq_along(private$stats), ": ", private$stats), sep = "\n"); cat("\n") - get_stat() + return(get_stat()) } else if (agg_txt %in% seq_along(private$stats)) { return(private$stats[as.numeric(agg_txt)]) } else if (agg_txt %in% private$stats) { return(agg_txt) } else { cat('Statistic not valid. Please type "A" to see all available options.\n') - get_stat() + return(get_stat()) } } get_dropdown <- function(x, opts = c("weeks", "cols")) { @@ -232,14 +232,14 @@ table_blocks <- } else if (agg_val == "A") { cat("Please type the week or the number corresponding to the desired option.\n") cat(paste0(seq_along(opt_lst), ": ", opt_lst), sep = "\n"); cat("\n") - get_dropdown(opts=opts) + return(get_dropdown(opts=opts)) } else if (agg_val %in% seq_along(opt_lst)) { return(opt_lst[as.numeric(agg_val)]) } else if (agg_val %in% opt_lst) { return(agg_val) } else { cat('Option not valid. Please type "A" to see all available.\n') - get_dropdown(opts=opts) + return(get_dropdown(opts=opts)) } } get_df <- function(x, possible_dfs) { From 7ca29c63a69b7a7dcdbd8884bc1de8712d841192 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Apr 2023 09:26:37 -0400 Subject: [PATCH 083/110] Return call when user input requested --- R/blockData.R | 47 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 42 insertions(+), 5 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 005e99ea..0e364b29 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -129,6 +129,13 @@ table_blocks <- #' @param df The dataset the parameter or field is from #' @param after A subscript, after which the values are to be appended add_block = function(variable, stat, dropdown, tpnt, df, after = NULL) { + msg_call <- deparse1(sys.calls()[[sys.nframe()-1]], collapse = "") %>% + stringr::str_match("(^addBlock\\().*\\)?(,.*\\)$)") %>% + as.character() %>% + `[`(-1) %>% + paste(collapse = "bd") + user_interface <- list(triggered = FALSE, + message = paste("Requested user input for", msg_call)) blocks <- list() aggs <- list() get_var <- function(x) { @@ -244,6 +251,10 @@ table_blocks <- } get_df <- function(x, possible_dfs) { if (!missing(x) && !(x %in% possible_dfs || x %in% seq_along(possible_dfs))) { + if (!user_interface$triggered) { + cat(user_interface$message, "\n\n") + user_interface$triggered <- TRUE + } cat("The selected variable is not in the supplied dataset.\n") } else if (!missing(x) && x %in% possible_dfs) { return(x) @@ -259,17 +270,28 @@ table_blocks <- get_df(df_val, possible_dfs) } - if (missing(variable)) + if (missing(variable)) { + if (!user_interface$triggered) { + cat(user_interface$message, "\n\n") + user_interface$triggered <- TRUE + } cat('Please provide a PARAMCD or field.', 'To see all options, type 1. To see all datasets, type 2. To see options for a particular dataset, type its name (e.g. "ADAE").\n', sep = "\n") + } blocks$txt <- get_var(variable) possible_dfs <- names(self$all_rows)[purrr::map_lgl(self$all_rows, ~ blocks$txt %in% .x[[1]])] + browser() blocks$df <- get_df(df, possible_dfs) if (blocks$df %in% names(private$my_avals) && blocks$txt %in% names(private$my_avals[[blocks$df]])) { - if (missing(tpnt)) + if (missing(tpnt)) { + if (!user_interface$triggered) { + cat(user_interface$message, "\n\n") + user_interface$triggered <- TRUE + } cat('Pleae provide a time point.', 'To see all options, type "A".\n', sep = "\n") + } atpt_lst <- private$my_avals[[blocks$df]][[blocks$txt]] filter_return <- get_filter(tpnt, atpt_lst = atpt_lst) blocks$grp <- names(filter_return) @@ -278,22 +300,37 @@ table_blocks <- blocks$lst <- atpt_lst[[blocks$grp]][-1] } - if (missing(stat)) + if (missing(stat)) { + if (!user_interface$triggered) { + cat(user_interface$message, "\n\n") + user_interface$triggered <- TRUE + } cat('Please provide an aggregator.', 'To see all options, type "A".\n', sep = "\n") + } aggs$txt <- get_stat(stat) if (aggs$txt %in% c("ANOVA", "CHG", "MEAN") & !is.null(private$my_weeks)) { - if (missing(dropdown)) + if (missing(dropdown)) { + if (!user_interface$triggered) { + cat(user_interface$message, "\n\n") + user_interface$triggered <- TRUE + } cat('Please provide an AVISIT.', 'To see all options, type "A".\n', sep = "\n") + } aggs$val <- get_dropdown(dropdown, "weeks") if (!is.null(aggs$val) && aggs$val == "ALL") aggs$lst <- as.list(private$my_weeks) } else if (aggs$txt %in% c("NESTED_FREQ_DSC", "NESTED_FREQ_ABC")) { - if (missing(dropdown)) + if (missing(dropdown)) { + if (!user_interface$triggered) { + cat(user_interface$message, "\n\n") + user_interface$triggered <- TRUE + } cat('Please provide a field.', 'To see all options, type "A",\n', sep = "\n") + } aggs$val <- get_dropdown(dropdown, "cols") } From 7a43f56ddd1b91d4e7993e650b68daafc74b03db Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Apr 2023 09:44:38 -0400 Subject: [PATCH 084/110] Oops --- R/blockData.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/blockData.R b/R/blockData.R index 0e364b29..e54657a1 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -280,7 +280,6 @@ table_blocks <- } blocks$txt <- get_var(variable) possible_dfs <- names(self$all_rows)[purrr::map_lgl(self$all_rows, ~ blocks$txt %in% .x[[1]])] - browser() blocks$df <- get_df(df, possible_dfs) if (blocks$df %in% names(private$my_avals) && blocks$txt %in% names(private$my_avals[[blocks$df]])) { From d2b774f1a6831ca99f8cf01fe564372ebd4531c5 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Apr 2023 09:48:33 -0400 Subject: [PATCH 085/110] Change from `readline` to `readLines` so that testing can be created --- R/blockData.R | 10 +++++----- R/zzz.R | 3 +++ 2 files changed, 8 insertions(+), 5 deletions(-) create mode 100644 R/zzz.R diff --git a/R/blockData.R b/R/blockData.R index e54657a1..0e4498cd 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -140,7 +140,7 @@ table_blocks <- aggs <- list() get_var <- function(x) { if (missing(x)) { - block_txt <- readline("INPUT: ") + block_txt <- readLines(con = getOption("tidyCDISC.connection"), n = 1) } else { block_txt <- x } @@ -165,7 +165,7 @@ table_blocks <- opt_lst <- c("NONE", purrr::imap(atpt_lst, ~ glue::glue("{.y} - {.x}")) %>% unlist()) if (missing(x)) { - filter_txt <- readline("INPUT: ") + filter_txt <- readLines(con = getOption("tidyCDISC.connection"), n = 1) } else { filter_txt <- x } @@ -202,7 +202,7 @@ table_blocks <- } get_stat <- function(x) { if (missing(x)) { - agg_txt <- readline("INPUT: ") + agg_txt <- readLines(con = getOption("tidyCDISC.connection"), n = 1) } else { agg_txt <- x } @@ -230,7 +230,7 @@ table_blocks <- } if (missing(x)) { - agg_val <- readline("INPUT: ") + agg_val <- readLines(con = getOption("tidyCDISC.connection"), n = 1) } else { agg_val <- x } @@ -266,7 +266,7 @@ table_blocks <- cat("Please type the dataset or the number corresponding to the desired option.\n") cat(paste0(seq_along(possible_dfs), ": ", possible_dfs), sep = "\n"); cat("\n") - df_val <- readline("Input: ") + df_val <- readLines(con = getOption("tidyCDISC.connection"), n = 1) get_df(df_val, possible_dfs) } diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 00000000..713f7ff9 --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,3 @@ +.onLoad <- function(libname, pkgname) { + options(tidyCDISC.connection = stdin()) +} \ No newline at end of file From aa37926bec1b7cf3b14b75767d411b7f0eedfe4d Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Apr 2023 09:52:24 -0400 Subject: [PATCH 086/110] Update text to explicitly tell the user to type their response --- R/blockData.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 0e4498cd..69d86273 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -275,7 +275,7 @@ table_blocks <- cat(user_interface$message, "\n\n") user_interface$triggered <- TRUE } - cat('Please provide a PARAMCD or field.', + cat('Please type a PARAMCD or field to use.', 'To see all options, type 1. To see all datasets, type 2. To see options for a particular dataset, type its name (e.g. "ADAE").\n', sep = "\n") } blocks$txt <- get_var(variable) @@ -288,7 +288,7 @@ table_blocks <- cat(user_interface$message, "\n\n") user_interface$triggered <- TRUE } - cat('Pleae provide a time point.', + cat('Pleae type a time point to use.', 'To see all options, type "A".\n', sep = "\n") } atpt_lst <- private$my_avals[[blocks$df]][[blocks$txt]] @@ -304,7 +304,7 @@ table_blocks <- cat(user_interface$message, "\n\n") user_interface$triggered <- TRUE } - cat('Please provide an aggregator.', + cat('Please type an aggregator to use.', 'To see all options, type "A".\n', sep = "\n") } aggs$txt <- get_stat(stat) @@ -315,7 +315,7 @@ table_blocks <- cat(user_interface$message, "\n\n") user_interface$triggered <- TRUE } - cat('Please provide an AVISIT.', + cat('Please type an AVISIT to use.', 'To see all options, type "A".\n', sep = "\n") } aggs$val <- get_dropdown(dropdown, "weeks") @@ -327,7 +327,7 @@ table_blocks <- cat(user_interface$message, "\n\n") user_interface$triggered <- TRUE } - cat('Please provide a field.', + cat('Please type a field to use.', 'To see all options, type "A",\n', sep = "\n") } aggs$val <- get_dropdown(dropdown, "cols") From 1051824cf69957537d5295c2defa7bcf410293e3 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Apr 2023 11:30:54 -0400 Subject: [PATCH 087/110] Fix buggy messaging --- R/blockData.R | 90 ++++++++++++++++++++++----------------------------- 1 file changed, 39 insertions(+), 51 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 69d86273..f7635df5 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -129,15 +129,27 @@ table_blocks <- #' @param df The dataset the parameter or field is from #' @param after A subscript, after which the values are to be appended add_block = function(variable, stat, dropdown, tpnt, df, after = NULL) { - msg_call <- deparse1(sys.calls()[[sys.nframe()-1]], collapse = "") %>% - stringr::str_match("(^addBlock\\().*\\)?(,.*\\)$)") %>% - as.character() %>% - `[`(-1) %>% - paste(collapse = "bd") + arg_list <- c('variable', 'stat', 'dropdown', 'tpnt', 'df') + msg_call <- "addBlock(bd" + for (i in arg_list) { + if (do.call(missing, list(i))) + next + + argument <- glue::glue("{i} = '{eval(parse(text = i))}'") + msg_call <- paste(msg_call, argument, sep = ", ") + } + msg_call <- paste0(msg_call, ")") user_interface <- list(triggered = FALSE, message = paste("Requested user input for", msg_call)) blocks <- list() aggs <- list() + cat1 <- function(...) { + if (!user_interface$triggered) { + cat(user_interface$message, "\n\n") + user_interface$triggered <<- TRUE + } + cat(...) + } get_var <- function(x) { if (missing(x)) { block_txt <- readLines(con = getOption("tidyCDISC.connection"), n = 1) @@ -145,17 +157,17 @@ table_blocks <- block_txt <- x } if (block_txt == "1") { - purrr::iwalk(tmp$all_rows, ~ {cat(.y, ":\n ", sep = ""); cat(.x[[1]], sep = ", "); cat("\n")}) + purrr::iwalk(tmp$all_rows, ~ {cat1(.y, ":\n ", sep = ""); cat1(.x[[1]], sep = ", "); cat1("\n")}) return(get_var()) } else if (block_txt == "2") { - cat(names(self$all_rows), sep = ", ") + cat1(names(self$all_rows), sep = ", ") return(get_var()) } else if (block_txt %in% names(self$all_rows)) { - cat(self$all_rows[[block_txt]][[1]], sep = ","); cat("\n") + cat1(self$all_rows[[block_txt]][[1]], sep = ","); cat1("\n") return(get_var()) } else { if (!any(purrr::map_lgl(self$all_rows, ~ block_txt %in% .x[[1]]))) { - cat("Param/field not found. Please type 1 to see all available options.\n") + cat1("Param/field not found. Please type 1 to see all available options.\n") return(get_var()) } return(block_txt) @@ -170,8 +182,8 @@ table_blocks <- filter_txt <- x } if (filter_txt == "A") { - cat("Please type the name or the number corresponding to the desired time point.\n") - cat(paste0(seq_along(opt_lst), ": ", opt_lst), sep = "\n"); cat("\n") + cat1("Please type the name or the number corresponding to the desired time point.\n") + cat1(paste0(seq_along(opt_lst), ": ", opt_lst), sep = "\n"); cat1("\n") return(get_filter(atpt_lst = atpt_lst)) } else if (filter_txt %in% seq_along(opt_lst)) { if (filter_txt == "1") @@ -189,14 +201,14 @@ table_blocks <- return(filter_return) } else if (filter_txt %in% unlist(atpt_lst)) { if (sum(filter_txt == unlist(atpt_lst)) > 1) { - cat('Time point is not unique. Please type "A" to see all available options.\n') + cat1('Time point is not unique. Please type "A" to see all available options.\n') get_filter(atpt_lst = atpt_lst) } else { x <- as.character(match(filter_txt, unlist(atpt_lst)) + 1) return(get_filter(x, atpt_lst = atpt_lst)) } } else { - cat('Time point not valid. Please type "A" to see all available options.\n') + cat1('Time point not valid. Please type "A" to see all available options.\n') return(get_filter(atpt_lst = atpt_lst)) } } @@ -207,15 +219,15 @@ table_blocks <- agg_txt <- x } if (agg_txt == "A") { - cat("Please type statistic or the number corresponding to desired stat.\n") - cat(paste0(seq_along(private$stats), ": ", private$stats), sep = "\n"); cat("\n") + cat1("Please type statistic or the number corresponding to desired stat.\n") + cat1(paste0(seq_along(private$stats), ": ", private$stats), sep = "\n"); cat1("\n") return(get_stat()) } else if (agg_txt %in% seq_along(private$stats)) { return(private$stats[as.numeric(agg_txt)]) } else if (agg_txt %in% private$stats) { return(agg_txt) } else { - cat('Statistic not valid. Please type "A" to see all available options.\n') + cat1('Statistic not valid. Please type "A" to see all available options.\n') return(get_stat()) } } @@ -237,25 +249,21 @@ table_blocks <- if (is.null(agg_val) || is.na(agg_val)) { return(NULL) } else if (agg_val == "A") { - cat("Please type the week or the number corresponding to the desired option.\n") - cat(paste0(seq_along(opt_lst), ": ", opt_lst), sep = "\n"); cat("\n") + cat1("Please type the week or the number corresponding to the desired option.\n") + cat1(paste0(seq_along(opt_lst), ": ", opt_lst), sep = "\n"); cat1("\n") return(get_dropdown(opts=opts)) } else if (agg_val %in% seq_along(opt_lst)) { return(opt_lst[as.numeric(agg_val)]) } else if (agg_val %in% opt_lst) { return(agg_val) } else { - cat('Option not valid. Please type "A" to see all available.\n') + cat1('Option not valid. Please type "A" to see all available.\n') return(get_dropdown(opts=opts)) } } get_df <- function(x, possible_dfs) { if (!missing(x) && !(x %in% possible_dfs || x %in% seq_along(possible_dfs))) { - if (!user_interface$triggered) { - cat(user_interface$message, "\n\n") - user_interface$triggered <- TRUE - } - cat("The selected variable is not in the supplied dataset.\n") + cat1("The selected variable is not in the supplied dataset.\n") } else if (!missing(x) && x %in% possible_dfs) { return(x) } else if (!missing(x) && x %in% seq_along(possible_dfs)) { @@ -264,18 +272,14 @@ table_blocks <- return(possible_dfs) } - cat("Please type the dataset or the number corresponding to the desired option.\n") - cat(paste0(seq_along(possible_dfs), ": ", possible_dfs), sep = "\n"); cat("\n") + cat1("Please type the dataset or the number corresponding to the desired option.\n") + cat1(paste0(seq_along(possible_dfs), ": ", possible_dfs), sep = "\n"); cat1("\n") df_val <- readLines(con = getOption("tidyCDISC.connection"), n = 1) get_df(df_val, possible_dfs) } if (missing(variable)) { - if (!user_interface$triggered) { - cat(user_interface$message, "\n\n") - user_interface$triggered <- TRUE - } - cat('Please type a PARAMCD or field to use.', + cat1('Please type a PARAMCD or field to use.', 'To see all options, type 1. To see all datasets, type 2. To see options for a particular dataset, type its name (e.g. "ADAE").\n', sep = "\n") } blocks$txt <- get_var(variable) @@ -284,11 +288,7 @@ table_blocks <- if (blocks$df %in% names(private$my_avals) && blocks$txt %in% names(private$my_avals[[blocks$df]])) { if (missing(tpnt)) { - if (!user_interface$triggered) { - cat(user_interface$message, "\n\n") - user_interface$triggered <- TRUE - } - cat('Pleae type a time point to use.', + cat1('Pleae type a time point to use.', 'To see all options, type "A".\n', sep = "\n") } atpt_lst <- private$my_avals[[blocks$df]][[blocks$txt]] @@ -300,22 +300,14 @@ table_blocks <- } if (missing(stat)) { - if (!user_interface$triggered) { - cat(user_interface$message, "\n\n") - user_interface$triggered <- TRUE - } - cat('Please type an aggregator to use.', + cat1('Please type an aggregator to use.', 'To see all options, type "A".\n', sep = "\n") } aggs$txt <- get_stat(stat) if (aggs$txt %in% c("ANOVA", "CHG", "MEAN") & !is.null(private$my_weeks)) { if (missing(dropdown)) { - if (!user_interface$triggered) { - cat(user_interface$message, "\n\n") - user_interface$triggered <- TRUE - } - cat('Please type an AVISIT to use.', + cat1('Please type an AVISIT to use.', 'To see all options, type "A".\n', sep = "\n") } aggs$val <- get_dropdown(dropdown, "weeks") @@ -323,11 +315,7 @@ table_blocks <- aggs$lst <- as.list(private$my_weeks) } else if (aggs$txt %in% c("NESTED_FREQ_DSC", "NESTED_FREQ_ABC")) { if (missing(dropdown)) { - if (!user_interface$triggered) { - cat(user_interface$message, "\n\n") - user_interface$triggered <- TRUE - } - cat('Please type a field to use.', + cat1('Please type a field to use.', 'To see all options, type "A",\n', sep = "\n") } aggs$val <- get_dropdown(dropdown, "cols") From b9be89406a869b44b90d24cce0ae5b7c085be860 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Apr 2023 12:11:53 -0400 Subject: [PATCH 088/110] Add a hanful more tests --- tests/testthat/test-blockData.R | 35 ++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-blockData.R b/tests/testthat/test-blockData.R index b1715afc..7d6b3356 100644 --- a/tests/testthat/test-blockData.R +++ b/tests/testthat/test-blockData.R @@ -114,4 +114,37 @@ test_that("table_block wrappers work", { row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")) expect_equal(bd$blocks, block_table) -}) \ No newline at end of file + setTitle(bd, "My Title") + expect_equal(bd$title, "My Title") + + setGroup(bd, "TRT01P") + expect_equal(bd$group_by, "TRT01P") + +}) + +test_that("User input is working", { + con <- file() + options(tidyCDISC.connection = con) + + datalist <- list(ADSL = tidyCDISC::adsl, ADAE = tidyCDISC::adae) + + bd <- createBlockdata(datalist) + + user_input <- c("AGEGR1", "FREQ") + write(paste(user_input, collapse = "\n"), con) + addBlock(bd) + expect_equal(nrow(bd$blocks), 1) + + user_input <- c("AGE", "MEN") + write(paste(user_input, collapse = "\n"), con) + expect_error(addBlock(bd)) + expect_equal(nrow(bd$blocks), 1) + + user_input <- c("AGE", "MEN", "MEAN") + write(paste(user_input, collapse = "\n"), con) + addBlock(bd) + expect_equal(nrow(bd$blocks), 2) + + options(tidyCDISC.connection = stdin()) + close(con) +}) From 6896f888da63c685e49ab22253181230bf45ee4c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Apr 2023 13:09:57 -0400 Subject: [PATCH 089/110] Update documentation for `addBlock()` --- man/addBlock.Rd | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/man/addBlock.Rd b/man/addBlock.Rd index fd4a85dc..6e1139fa 100644 --- a/man/addBlock.Rd +++ b/man/addBlock.Rd @@ -4,7 +4,7 @@ \alias{addBlock} \title{Add Block to Block Data Object} \usage{ -addBlock(bd, variable, stat, dropdown, tpnt, df) +addBlock(bd, variable, stat, dropdown, tpnt, df, after = NULL) } \arguments{ \item{bd}{A block data object} @@ -18,6 +18,8 @@ addBlock(bd, variable, stat, dropdown, tpnt, df) \item{tpnt}{A time point on which the calculation is filtered} \item{df}{The dataset the parameter or field is from} + +\item{after}{A subscript, after which the values are to be appended} } \value{ The \code{bd} block data object with additional block From 883227977fcfc358a159cfb22dc39a6fe3d72899 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 08:49:07 -0400 Subject: [PATCH 090/110] Test specifying R version --- .github/workflows/test-coverage.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 880e83bb..e012fe30 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -22,6 +22,7 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true + r-version: 'renv' - uses: r-lib/actions/setup-renv@v2 with: From 3d9436056358c5c001baa0d33f3942aa1dc05e9e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 08:59:08 -0400 Subject: [PATCH 091/110] Use `renv` R version for other Github Actions --- .github/workflows/R-CMD-check-devel.yaml | 2 ++ .github/workflows/pkgdown.yaml | 1 + 2 files changed, 3 insertions(+) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index 22eae00a..3be37113 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -43,6 +43,8 @@ jobs: - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 + with: + r-version: 'renv' - uses: r-lib/actions/setup-renv@v2 with: r-version: ${{ matrix.config.r }} diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 84edbf33..90df1030 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -27,6 +27,7 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true + r-version: 'renv' - uses: r-lib/actions/setup-renv@v2 with: From 15952c2a2b3e94eef763a3fa7da95b166b69766a Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 09:27:49 -0400 Subject: [PATCH 092/110] Correct inputs to Github Actions --- .github/workflows/R-CMD-check-devel.yaml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index 3be37113..e16c2f34 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -43,14 +43,11 @@ jobs: - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 - with: - r-version: 'renv' - - uses: r-lib/actions/setup-renv@v2 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - extra-packages: rcmdcheck + - uses: r-lib/actions/setup-renv@v2 - uses: r-lib/actions/setup-r-dependencies@v2 with: From 0d0a3d4839efaf896889557b66d29213bfaee63b Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 09:28:15 -0400 Subject: [PATCH 093/110] Don't output `cat` when running tests --- R/blockData.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/blockData.R b/R/blockData.R index f7635df5..02b15cf9 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -144,6 +144,8 @@ table_blocks <- blocks <- list() aggs <- list() cat1 <- function(...) { + if(identical(Sys.getenv("TESTTHAT"), "true")) return(NULL) + if (!user_interface$triggered) { cat(user_interface$message, "\n\n") user_interface$triggered <<- TRUE From b542ca37725f505552331386e00a797fb87af746 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 09:28:31 -0400 Subject: [PATCH 094/110] Add couple basic tests for blockData --- tests/testthat/test-blockData.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-blockData.R b/tests/testthat/test-blockData.R index 7d6b3356..31e33ad0 100644 --- a/tests/testthat/test-blockData.R +++ b/tests/testthat/test-blockData.R @@ -25,10 +25,12 @@ table_blocks_tester <- R6::R6Class( test_that("table_blocks is working", { datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs) - test_bd <- table_blocks_tester$new(datalist) + test_bd <- table_blocks_tester$new(datalist, "My Title") # Check initialization values expect_equal(nrow(test_bd$blocks), 0) + expect_equal(test_bd$title, "My Title") + expect_equal(test_bd$group_by, NULL) stats <- c("ANOVA", "CHG", "MEAN", "FREQ", "Y_FREQ", "MAX_FREQ", "NON_MISSING", "NESTED_FREQ_DSC", "NESTED_FREQ_ABC") test_bd$test_stats(stats) From 0c665e4c048c2998b7bac2290b201ee579465b84 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 10:54:43 -0400 Subject: [PATCH 095/110] Remove `{rcmdcheck}` because it's already included in renv.lock --- .github/workflows/R-CMD-check-devel.yaml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index e16c2f34..e7d3d45a 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -48,10 +48,6 @@ jobs: http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - uses: r-lib/actions/setup-renv@v2 - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: rcmdcheck # likely not needed since 'r-lib/actions/check-r-package@v2' will build # the pkg, but including it for consistency with other workflows From 7bea3d2398a06bb92b3796aa31d008767deffec2 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 15:39:43 -0400 Subject: [PATCH 096/110] Use `renv` R version and packages for tests on `devel` --- .github/workflows/R-CMD-check-devel.yaml | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index e7d3d45a..1dbc18a0 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -18,11 +18,9 @@ jobs: fail-fast: false matrix: config: - - {os: macOS-latest, r: 'release'} - - {os: windows-latest, r: 'release'} - - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - - {os: ubuntu-latest, r: 'release'} - - {os: ubuntu-latest, r: 'oldrel-1'} + - {os: macOS-latest, r: 'renv'} + - {os: windows-latest, r: 'renv'} + - {os: ubuntu-latest, r: 'renv'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} @@ -45,7 +43,6 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} - http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - uses: r-lib/actions/setup-renv@v2 From 429d21d9543387d6b22bdf92dc22676c2d9cbe74 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 16:22:01 -0400 Subject: [PATCH 097/110] Invalidate the cache --- .github/workflows/R-CMD-check-devel.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index 1dbc18a0..ee7a33b2 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -45,6 +45,8 @@ jobs: r-version: ${{ matrix.config.r }} use-public-rspm: true - uses: r-lib/actions/setup-renv@v2 + with: + cache-version: 2 # likely not needed since 'r-lib/actions/check-r-package@v2' will build # the pkg, but including it for consistency with other workflows From 8e2baaae21e6f91f3b58ee4ab97573901d8871cb Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 16:34:16 -0400 Subject: [PATCH 098/110] Add cache back in --- .github/workflows/R-CMD-check-devel.yaml | 2 -- 1 file changed, 2 deletions(-) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index ee7a33b2..1dbc18a0 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -45,8 +45,6 @@ jobs: r-version: ${{ matrix.config.r }} use-public-rspm: true - uses: r-lib/actions/setup-renv@v2 - with: - cache-version: 2 # likely not needed since 'r-lib/actions/check-r-package@v2' will build # the pkg, but including it for consistency with other workflows From 53f1b5e27ba28dcfda9e543d43633752bf716b64 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 16:47:25 -0400 Subject: [PATCH 099/110] Install `gcc` --- .github/workflows/R-CMD-check-devel.yaml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index 1dbc18a0..7f21230b 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -35,6 +35,12 @@ jobs: sudo apt-get install -y libcurl4-openssl-dev sudo apt-get install -y libharfbuzz-dev sudo apt-get install -y libfribidi-dev + + - name: Install Mac dependencies + if: runner.os == "macOS" + shell: bash + run: | + brew install gcc - uses: actions/checkout@v2 From 5eb4fdb5e49680bca08e1b1e2347274fd800b99c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 25 Apr 2023 16:49:53 -0400 Subject: [PATCH 100/110] Oops --- .github/workflows/R-CMD-check-devel.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index 7f21230b..a93139ff 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -37,7 +37,7 @@ jobs: sudo apt-get install -y libfribidi-dev - name: Install Mac dependencies - if: runner.os == "macOS" + if: runner.os == 'macOS' shell: bash run: | brew install gcc From 418a6e66b8bbf48ea4b009d0e4d05d2bbf49f9b5 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Apr 2023 08:15:32 -0400 Subject: [PATCH 101/110] Don't use `renv` for devel check --- .github/workflows/R-CMD-check-devel.yaml | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index a93139ff..b2a1daf0 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -18,9 +18,9 @@ jobs: fail-fast: false matrix: config: - - {os: macOS-latest, r: 'renv'} - - {os: windows-latest, r: 'renv'} - - {os: ubuntu-latest, r: 'renv'} + - {os: macOS-latest, r: 'release'} + - {os: windows-latest, r: 'release'} + - {os: ubuntu-latest, r: 'release'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} @@ -35,12 +35,6 @@ jobs: sudo apt-get install -y libcurl4-openssl-dev sudo apt-get install -y libharfbuzz-dev sudo apt-get install -y libfribidi-dev - - - name: Install Mac dependencies - if: runner.os == 'macOS' - shell: bash - run: | - brew install gcc - uses: actions/checkout@v2 @@ -50,7 +44,10 @@ jobs: with: r-version: ${{ matrix.config.r }} use-public-rspm: true - - uses: r-lib/actions/setup-renv@v2 + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: rcmdcheck # likely not needed since 'r-lib/actions/check-r-package@v2' will build # the pkg, but including it for consistency with other workflows From c92465d8a2063650797efec577dc437b86cc738a Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Apr 2023 12:54:18 -0400 Subject: [PATCH 102/110] Reset workflows to `devel` --- .github/workflows/R-CMD-check-devel.yaml | 5 +++++ .github/workflows/pkgdown.yaml | 1 - .github/workflows/test-coverage.yaml | 1 - 3 files changed, 5 insertions(+), 2 deletions(-) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index b2a1daf0..22eae00a 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -20,7 +20,9 @@ jobs: config: - {os: macOS-latest, r: 'release'} - {os: windows-latest, r: 'release'} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'oldrel-1'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} @@ -41,9 +43,12 @@ jobs: - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 + - uses: r-lib/actions/setup-renv@v2 with: r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true + extra-packages: rcmdcheck - uses: r-lib/actions/setup-r-dependencies@v2 with: diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 90df1030..84edbf33 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -27,7 +27,6 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - r-version: 'renv' - uses: r-lib/actions/setup-renv@v2 with: diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index e012fe30..880e83bb 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -22,7 +22,6 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - r-version: 'renv' - uses: r-lib/actions/setup-renv@v2 with: From ccab09abe25f1a5edf686b7e0063864f9a10b107 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Apr 2023 12:59:15 -0400 Subject: [PATCH 103/110] Update test-coverage --- .github/workflows/test-coverage.yaml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 880e83bb..4cb21830 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -22,10 +22,9 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true + r-version: 'renv' - uses: r-lib/actions/setup-renv@v2 - with: - extra-packages: covr - name: Install tidyCDISC shell: bash From 5db0a23f1790a795db5c324b56a4d3bd8346abf9 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Apr 2023 12:59:31 -0400 Subject: [PATCH 104/110] Update pkgdown --- .github/workflows/pkgdown.yaml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 84edbf33..ca1b0577 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -27,14 +27,12 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true + r-version: 'renv' - uses: r-lib/actions/setup-renv@v2 - with: - extra-packages: any::pkgdown, local::. - needs: website - name: Install specific pkgdown version - run: install.packages("remotes") ; remotes::install_version("pkgdown", version = "2.0.3", repos = "cran.rstudio.com", dependencies = FALSE) + run: remotes::install_version("pkgdown", version = "2.0.3", repos = "cran.rstudio.com", dependencies = FALSE) shell: Rscript {0} - name: Install tidyCDISC From 7a8e25dd09839623c2e5253ea360fdd24c93464b Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Apr 2023 12:59:48 -0400 Subject: [PATCH 105/110] Update devel R-CMD check --- .github/workflows/R-CMD-check-devel.yaml | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index 22eae00a..2eefd500 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -18,11 +18,9 @@ jobs: fail-fast: false matrix: config: - - {os: macOS-latest, r: 'release'} - - {os: windows-latest, r: 'release'} - - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - - {os: ubuntu-latest, r: 'release'} - - {os: ubuntu-latest, r: 'oldrel-1'} + - {os: macOS-latest, r: 'renv'} + - {os: windows-latest, r: 'renv'} + - {os: ubuntu-latest, r: 'renv'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} @@ -43,16 +41,11 @@ jobs: - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 - - uses: r-lib/actions/setup-renv@v2 with: r-version: ${{ matrix.config.r }} - http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - extra-packages: rcmdcheck - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: rcmdcheck + - uses: r-lib/actions/setup-r-renv@v2 # likely not needed since 'r-lib/actions/check-r-package@v2' will build # the pkg, but including it for consistency with other workflows From 65e3326d474e1ea789216c15885ec7909113fd0d Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Apr 2023 13:02:36 -0400 Subject: [PATCH 106/110] setup-renv not setup-r-renv --- .github/workflows/R-CMD-check-devel.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/R-CMD-check-devel.yaml b/.github/workflows/R-CMD-check-devel.yaml index 2eefd500..55da5fcc 100644 --- a/.github/workflows/R-CMD-check-devel.yaml +++ b/.github/workflows/R-CMD-check-devel.yaml @@ -45,7 +45,7 @@ jobs: r-version: ${{ matrix.config.r }} use-public-rspm: true - - uses: r-lib/actions/setup-r-renv@v2 + - uses: r-lib/actions/setup-renv@v2 # likely not needed since 'r-lib/actions/check-r-package@v2' will build # the pkg, but including it for consistency with other workflows From b3892105cac82330d1dff6be5acf1e6b1bd8c7b5 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 28 Apr 2023 11:33:46 -0400 Subject: [PATCH 107/110] Display `group_by` and `title` --- R/blockData.R | 22 +++++++++++++++++++++- man/setGroup.Rd | 8 ++++++++ man/setTitle.Rd | 8 ++++++++ 3 files changed, 37 insertions(+), 1 deletion(-) diff --git a/R/blockData.R b/R/blockData.R index 02b15cf9..2e3abb51 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -97,7 +97,11 @@ table_blocks <- #' @description #' Print the data frame containing the blocks print = function() { - print(self$blocks) + print(list( + Title = self$title, + "Group By" = self$group_by, + Blocks = self$blocks + )) invisible(self) }, #' @description @@ -422,6 +426,14 @@ createBlockdata <- function(datalist, title) { #' #' @export #' @keywords table_blocks +#' +#' @examples +#' +#' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, +#' ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +#' bd <- createBlockdata(datalist) +#' setTitle("Table 1") +#' bd$title setTitle <- function(bd, title) { invisible(bd$set_title(title = title)) } @@ -435,6 +447,14 @@ setTitle <- function(bd, title) { #' #' @export #' @keywords table_blocks +#' +#' @examples +#' +#' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, +#' ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +#' bd <- createBlockdata(datalist) +#' setGroup("TRT01P") +#' bd$group_by setGroup <- function(bd, group_by) { invisible(bd$set_groupby(group_by = group_by)) } diff --git a/man/setGroup.Rd b/man/setGroup.Rd index 2a668826..8172b1c6 100644 --- a/man/setGroup.Rd +++ b/man/setGroup.Rd @@ -17,4 +17,12 @@ The \code{bd} block data object with updated group by field \description{ Set the title for the table object } +\examples{ + +datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, + ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +bd <- createBlockdata(datalist) +setGroup("TRT01P") +bd$group_by +} \keyword{table_blocks} diff --git a/man/setTitle.Rd b/man/setTitle.Rd index 4e75bec7..5feca7ab 100644 --- a/man/setTitle.Rd +++ b/man/setTitle.Rd @@ -17,4 +17,12 @@ The \code{bd} block data object with supplied title \description{ Set the title for the table object } +\examples{ + +datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, + ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) +bd <- createBlockdata(datalist) +setTitle("Table 1") +bd$title +} \keyword{table_blocks} From ef757ee6eeabe3f958cfe6fa231d8024c5b481a4 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 28 Apr 2023 11:41:55 -0400 Subject: [PATCH 108/110] Add `label` and `label_source` to blocks --- R/blockData.R | 27 +++++++++++++++++++++++---- tests/testthat/test-blockData.R | 15 +++++++-------- 2 files changed, 30 insertions(+), 12 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index 2e3abb51..e14cf2fd 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -386,11 +386,30 @@ table_blocks <- create_TG = function(aggs, blocks) { blockData <- convertTGOutput(aggs, blocks) - blockData$label <- - "N/A" + blockData$label <- + purrr::map2(blockData$block, blockData$dataset, function(var, dat) { + if(!is.null(attr(self$datalist[[dat]][[var]], 'label'))){ + attr(self$datalist[[dat]][[var]], 'label') + } else if(all(c("PARAM","PARAMCD") %in% colnames(self$datalist[[dat]]))){ + self$datalist[[dat]] %>% + filter(PARAMCD == var) %>% + distinct(PARAM) %>% + pull() %>% as.character() + } else { + var + } + }) %>% unname() %>% stringr::str_trim() - blockData$label_source <- - "N/A" + blockData$label_source <- + purrr::map2(blockData$block, blockData$dataset, function(var, dat) { + if(!is.null(attr(self$datalist[[dat]][[var]], 'label'))){ + 'SAS "label" attribute' + } else if("PARAMCD" %in% colnames(self$datalist[[dat]])){ + 'PARAM' + } else { + 'No Label' + } + }) %>% unname() %>% stringr::str_trim() blockData } diff --git a/tests/testthat/test-blockData.R b/tests/testthat/test-blockData.R index 31e33ad0..1be14e73 100644 --- a/tests/testthat/test-blockData.R +++ b/tests/testthat/test-blockData.R @@ -92,13 +92,12 @@ test_that("table_block wrappers work", { dropdown = c(NA, "DCSREAS"), filter = c(NA_character_, NA_character_), S3 = list(structure("RANDFL", class = c("character", "ADSL")), - structure("EOSSTT", class = c("character", "ADSL"))), + structure("EOSSTT", class = c("character", "ADSL"))), gt_group = structure(c("Y_FREQ of RANDFL", "NESTED_FREQ_ABC of EOSSTT and DCSREAS"), - class = c("glue", "character")), - label = c("N/A", "N/A"), - label_source = c("N/A", "N/A")), - row.names = c(NA, -2L), - class = c("tbl_df", "tbl", "data.frame")) + class = c("glue", "character")), + label = c("Randomized Population Flag", "End of Study Status"), + label_source = c("SAS \"label\" attribute", "SAS \"label\" attribute")), + row.names = c(NA, -2L), class = c("tbl_df", "tbl", "data.frame")) expect_equal(bd$blocks, block_table) removeBlock(bd, 1) @@ -111,8 +110,8 @@ test_that("table_block wrappers work", { filter = NA_character_, S3 = list(structure("EOSSTT", class = c("character", "ADSL"))), gt_group = structure("NESTED_FREQ_ABC of EOSSTT and DCSREAS", class = c("glue", "character")), - label = "N/A", - label_source = "N/A"), + label = "End of Study Status", + label_source = "SAS \"label\" attribute"), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")) expect_equal(bd$blocks, block_table) From 8498ed8850d75c07b34939a6c1fcc3eec7baec7c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 28 Apr 2023 11:56:08 -0400 Subject: [PATCH 109/110] Oops --- R/blockData.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/blockData.R b/R/blockData.R index e14cf2fd..e18a26c4 100644 --- a/R/blockData.R +++ b/R/blockData.R @@ -451,7 +451,7 @@ createBlockdata <- function(datalist, title) { #' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, #' ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) #' bd <- createBlockdata(datalist) -#' setTitle("Table 1") +#' setTitle(bd, "Table 1") #' bd$title setTitle <- function(bd, title) { invisible(bd$set_title(title = title)) @@ -472,7 +472,7 @@ setTitle <- function(bd, title) { #' datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, #' ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) #' bd <- createBlockdata(datalist) -#' setGroup("TRT01P") +#' setGroup(bd, "TRT01P") #' bd$group_by setGroup <- function(bd, group_by) { invisible(bd$set_groupby(group_by = group_by)) From ebadc429c98e42086c19f75d54dcab564c346891 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 28 Apr 2023 12:10:28 -0400 Subject: [PATCH 110/110] Maybe update documents and not just roxygen --- man/setGroup.Rd | 2 +- man/setTitle.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/man/setGroup.Rd b/man/setGroup.Rd index 8172b1c6..426e430e 100644 --- a/man/setGroup.Rd +++ b/man/setGroup.Rd @@ -22,7 +22,7 @@ Set the title for the table object datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) bd <- createBlockdata(datalist) -setGroup("TRT01P") +setGroup(bd, "TRT01P") bd$group_by } \keyword{table_blocks} diff --git a/man/setTitle.Rd b/man/setTitle.Rd index 5feca7ab..0316e5c6 100644 --- a/man/setTitle.Rd +++ b/man/setTitle.Rd @@ -22,7 +22,7 @@ Set the title for the table object datalist <- list(ADSL = tidyCDISC::adsl, ADVS = tidyCDISC::advs, ADAE = tidyCDISC::adae, ADLBC = tidyCDISC::adlbc) bd <- createBlockdata(datalist) -setTitle("Table 1") +setTitle(bd, "Table 1") bd$title } \keyword{table_blocks}