From 95bd28bb82d330cf2f723ddf808421388d69af3d Mon Sep 17 00:00:00 2001 From: Aaron Clark Date: Wed, 31 Aug 2022 16:26:18 -0400 Subject: [PATCH 01/19] Increment version number to 0.1.0.9000 --- DESCRIPTION | 2 +- NEWS.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5acbf011..28aed557 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: tidyCDISC Title: Quick Table Generation & Exploratory Analyses on ADaM-Ish Datasets -Version: 0.1.0 +Version: 0.1.0.9000 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 87389201..fe0f79b7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +# tidyCDISC (development version) + # tidyCDISC 0.1.0 (CRAN Release) * cleaning up `devtools::check()` & preparing for CRAN release. From 1fe148b6e501838459cdfdac727913a2708e124d Mon Sep 17 00:00:00 2001 From: Aaron Clark Date: Wed, 31 Aug 2022 16:27:07 -0400 Subject: [PATCH 02/19] initiated new dev version of tidyCDISC --- NEWS.md | 2 ++ dev/02_dev.R | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index fe0f79b7..82b28f3e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # tidyCDISC (development version) + + # tidyCDISC 0.1.0 (CRAN Release) * cleaning up `devtools::check()` & preparing for CRAN release. diff --git a/dev/02_dev.R b/dev/02_dev.R index 56fe4838..8ceba21e 100644 --- a/dev/02_dev.R +++ b/dev/02_dev.R @@ -175,7 +175,7 @@ usethis::use_vignette("dev03_Indv_Expl") # Before submitting a PR, run this code & update NEWS.md -usethis::use_version("patch") #choices: "dev", "patch", "minor", "major" +usethis::use_version("dev") #choices: "dev", "patch", "minor", "major" # Build pkg, including vignettes. Do this before updating documentation. devtools::build() # calls pkgbuld::build() # X.X MB From af5e0ac3b38d1e48c013b9c85d1804792043d09f Mon Sep 17 00:00:00 2001 From: Aaron Clark Date: Wed, 31 Aug 2022 16:30:43 -0400 Subject: [PATCH 03/19] Delete old CRAN-SUBMISSION tag and also changed when gha workflow is kicked off, providing r cmd check on PRs seeking merge into 'devel' branch --- .github/workflows/R-CMD-check.yaml | 2 +- CRAN-SUBMISSION | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) delete mode 100644 CRAN-SUBMISSION diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 198521b9..975c3ded 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -4,7 +4,7 @@ on: push: branches: [main, master] pull_request: - branches: [main, master, for_cranny] + branches: [main, master, devel] name: R-CMD-check diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION deleted file mode 100644 index d43ebf7d..00000000 --- a/CRAN-SUBMISSION +++ /dev/null @@ -1,3 +0,0 @@ -Version: 0.1.0 -Date: 2022-08-29 17:42:49 UTC -SHA: 159e03405e689075e62917d43b735ab39f033dfd From 9061e5048ade706b6fc5a92c7cdbeefb689117a0 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 6 Sep 2022 14:06:23 -0400 Subject: [PATCH 04/19] Remove data_from from grouping input choices --- R/mod_popExp_line.R | 6 ++++-- R/mod_popExp_scatter.R | 2 ++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/R/mod_popExp_line.R b/R/mod_popExp_line.R index c44f7481..89d10ab5 100644 --- a/R/mod_popExp_line.R +++ b/R/mod_popExp_line.R @@ -314,9 +314,11 @@ linePlot_srv <- function(input, output, session, data, run) { if(!(input$yvar %in% colnames(data())) ){ # yvar paramcd #& input$xvar %in% colnames(data()) group_dat <- data() %>% dplyr::filter(PARAMCD == input$yvar) %>% - select_if(~!all(is.na(.))) # remove NA cols + select_if(~!all(is.na(.))) %>% # remove NA cols + select(-data_from) } else { - group_dat <- data() + group_dat <- data() %>% + select(-data_from) } # character and factor columns for coloring or separating diff --git a/R/mod_popExp_scatter.R b/R/mod_popExp_scatter.R index 41709550..bebce426 100644 --- a/R/mod_popExp_scatter.R +++ b/R/mod_popExp_scatter.R @@ -114,6 +114,8 @@ scatterPlot_srv <- function(input, output, session, data, run) { group_dat <- x_cols %>% full_join(y_cols) } + group_dat <- select(group_dat, -data_from) + # character and factor columns for coloring or separating char_col <- subset_colclasses(group_dat, is.character) fac_col <- subset_colclasses(group_dat, is.factor) From 75c816c331bef49568db8d2d387f6cc00a5dbf70 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 9 Sep 2022 09:30:16 -0400 Subject: [PATCH 05/19] Clean up block data output to R script --- R/mod_tableGen.R | 2 +- R/mod_tableGen_utils.R | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index f7eed21b..e27e1a8d 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -765,7 +765,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL # get drop zone area from tidyCDISC # and create table using data - blockData <- {paste0(capture.output(dput(blocks_and_functions())), collapse = '\n')} + blockData <- {prep_blocks(blocks_and_functions())} {df_empty_expr()} " diff --git a/R/mod_tableGen_utils.R b/R/mod_tableGen_utils.R index 3249f3d6..4e589107 100644 --- a/R/mod_tableGen_utils.R +++ b/R/mod_tableGen_utils.R @@ -445,6 +445,14 @@ pretty_IDs <- function(ID) { ) } +prep_blocks <- function(blockData) { + dput(blockData) %>% + capture.output() %>% + paste0(collapse = "") %>% + str_replace_all("\\s{2,}", " ") %>% + str_replace_all("(\\),)", "\\1\n") +} + #' Table Generator Cicerone R6 Object #' #' This object is used within the table generator module From 08c773252b3a1307fd581a4e32426ab67723469c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 9 Sep 2022 11:39:41 -0400 Subject: [PATCH 06/19] Add a Run Date footnote to TG table --- R/mod_tableGen.R | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index e27e1a8d..e522307f 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -536,7 +536,12 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL ), locations = gt::cells_stub(rows = TRUE) )%>% - gt::cols_label(Variable = "") + gt::cols_label(Variable = "") %>% + gt::tab_footnote(HTML("Run Date:", toupper(format(Sys.Date(), "%d%b%Y")))) %>% + gt::tab_style( + style = gt::cell_text(align = "right"), + locations = gt::cells_footnotes() + ) }) output$all <- gt::render_gt({ gt_table() }) @@ -856,7 +861,12 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL style = cell_text(weight = 'bold'), locations = cells_row_groups() ) %>% - cols_label(Variable = '') + cols_label(Variable = '') %>% + gt::tab_footnote(HTML('Run Date:', toupper(format(Sys.Date(), '%d%b%Y')))) %>% + gt::tab_style( + style = gt::cell_text(align = 'right'), + locations = gt::cells_footnotes() + ) " ) }) From eb98da58bf586a0137f48d01878bcee706521c87 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 9 Sep 2022 13:29:20 -0400 Subject: [PATCH 07/19] Improve implementation of standard footnote --- R/mod_tableGen.R | 22 +++++++++++----------- R/mod_tableGen_utils.R | 8 ++++++++ 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index e522307f..517bee42 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -537,12 +537,8 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL locations = gt::cells_stub(rows = TRUE) )%>% gt::cols_label(Variable = "") %>% - gt::tab_footnote(HTML("Run Date:", toupper(format(Sys.Date(), "%d%b%Y")))) %>% - gt::tab_style( - style = gt::cell_text(align = "right"), - locations = gt::cells_footnotes() - ) - }) + std_footnote("tidyCDISC app") + }) output$all <- gt::render_gt({ gt_table() }) @@ -650,6 +646,14 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL ")} }) + footnote_src <- reactive({ + if(any("CDISCPILOT01" %in% ADSL()$STUDYID)){ + "'tidyCDISC app'" + } else { + "study_dir" + } + }) + # If ADAE exists, then prep that data too adae_expr <- reactive({ if("ADAE" %in% names(datafile())){ @@ -862,11 +866,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL locations = cells_row_groups() ) %>% cols_label(Variable = '') %>% - gt::tab_footnote(HTML('Run Date:', toupper(format(Sys.Date(), '%d%b%Y')))) %>% - gt::tab_style( - style = gt::cell_text(align = 'right'), - locations = gt::cells_footnotes() - ) + tidyCDISC::std_footnote({footnote_src()}) " ) }) diff --git a/R/mod_tableGen_utils.R b/R/mod_tableGen_utils.R index 4e589107..5d4388d5 100644 --- a/R/mod_tableGen_utils.R +++ b/R/mod_tableGen_utils.R @@ -453,6 +453,14 @@ prep_blocks <- function(blockData) { str_replace_all("(\\),)", "\\1\n") } +std_footnote <- function(data, source) { + gt::tab_footnote(data, + tags$div(HTML("Source:", source), + shiny::tags$span(shiny::HTML(" Run Date:", toupper(format(Sys.Date(), "%d%b%Y"))), + style="float:right"), + style="text-align:left")) +} + #' Table Generator Cicerone R6 Object #' #' This object is used within the table generator module From fa443a710b4aabbe5d7f3ed189e614f7ac2b51c1 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 9 Sep 2022 13:45:15 -0400 Subject: [PATCH 08/19] Add custom footnote feature --- R/mod_tableGen.R | 6 ++++-- R/mod_tableGen_ui.R | 2 ++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index 517bee42..34f06032 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -537,7 +537,8 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL locations = gt::cells_stub(rows = TRUE) )%>% gt::cols_label(Variable = "") %>% - std_footnote("tidyCDISC app") + std_footnote("tidyCDISC app") %>% + gt::tab_footnote(input$table_footnote) }) output$all <- gt::render_gt({ gt_table() }) @@ -866,7 +867,8 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL locations = cells_row_groups() ) %>% cols_label(Variable = '') %>% - tidyCDISC::std_footnote({footnote_src()}) + tidyCDISC::std_footnote({footnote_src()}) %>% + tab_footnote('{input$table_footnote}') " ) }) diff --git a/R/mod_tableGen_ui.R b/R/mod_tableGen_ui.R index 2239e7f8..f9e1505f 100644 --- a/R/mod_tableGen_ui.R +++ b/R/mod_tableGen_ui.R @@ -110,6 +110,8 @@ mod_tableGen_ui <- function(id){ wellPanel( fluidRow(column(width = 12, div(id = "table_title", textInput(ns("table_title"), "Table Title", "Table Title", width = '100%')))), + fluidRow(column(width = 12, + div(id = "table_footnote", textInput(ns("table_footnote"), "Table Footnote", placeholder = "Add footnote here", width = '100%')))), fluidRow(column(width = 12, div(id = "download_table", fluidRow( column(6, downloadButton(ns("download_gt"), "Download Table")), From 381b4825b9dac02a088efce3a10416d6b0181259 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 9 Sep 2022 15:43:04 -0400 Subject: [PATCH 09/19] Wrap TG table compilation within function --- R/mod_tableGen.R | 15 ++------------- R/mod_tableGen_utils.R | 16 ++++++++++++++++ 2 files changed, 18 insertions(+), 13 deletions(-) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index 34f06032..87f5f62c 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -830,20 +830,9 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL # Calculate totals for population set {total_for_code()} + tg_datalist <- list(ADAE = ae_data, ADSL = bds_data, POPDAT = {Rscript_use_preferred_pop_data()}) - tg_table <- purrr::pmap(list( - blockData$agg, - blockData$S3, - blockData$dropdown, - blockData$dataset), - function(x,y,z,d) tidyCDISC::app_methods(x,y,z, - group = {column() %quote% 'NULL'}, - data = tidyCDISC::data_to_use_str(d, ae_data, bds_data), - totals = total_df)) %>% - map(setNames, tidyCDISC::common_rownames({Rscript_use_preferred_pop_data()}, {column() %quote% 'NULL'})) %>% - setNames(paste(blockData$gt_group)) %>% - bind_rows(.id = 'ID') %>% - mutate(ID = tidyCDISC::pretty_IDs(ID)) + tg_table <- tidyCDISC::tg_gt(tg_datalist, blockData, total_df, {column() %quote% 'NULL'}) # get the column names for the table col_names <- names(tg_table)[-c(1:2)] diff --git a/R/mod_tableGen_utils.R b/R/mod_tableGen_utils.R index 5d4388d5..f730b8ab 100644 --- a/R/mod_tableGen_utils.R +++ b/R/mod_tableGen_utils.R @@ -461,6 +461,22 @@ std_footnote <- function(data, source) { style="text-align:left")) } +tg_gt <- function(tg_datalist, blockData, total_df, group) { + purrr::pmap(list( + blockData$agg, + blockData$S3, + blockData$dropdown, + blockData$dataset), + function(x,y,z,d) tidyCDISC::app_methods(x,y,z, + group = group, + data = tidyCDISC::data_to_use_str(d, tg_datalist$ADAE, tg_datalist$ADSL), + totals = total_df)) %>% + purrr::map(setNames, tidyCDISC::common_rownames(tg_datalist$POPDAT, group)) %>% + setNames(paste(blockData$gt_group)) %>% + dplyr::bind_rows(.id = 'ID') %>% + dplyr::mutate(ID = tidyCDISC::pretty_IDs(ID)) +} + #' Table Generator Cicerone R6 Object #' #' This object is used within the table generator module From 3770d5d04bb95b7fb02672205d499345cdb8c2ba Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 12 Sep 2022 16:34:29 -0400 Subject: [PATCH 10/19] Add "ALL" option to visit dropdowns --- 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 87f5f62c..ef18cc49 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -262,7 +262,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL # Send any and all AVISITs that exist to javascript side (script.js) observe({ req(AVISIT()) - session$sendCustomMessage("my_weeks", AVISIT()) + session$sendCustomMessage("my_weeks", c("ALL", as.vector(AVISIT()))) }) From aa3f2e87284402ba4586a258647b5cba51c4d91b Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 12 Sep 2022 16:35:33 -0400 Subject: [PATCH 11/19] Return list of Visits with "ALL" selected in dropdown --- inst/app/www/script.js | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/inst/app/www/script.js b/inst/app/www/script.js index 692dd355..ba0f64b2 100644 --- a/inst/app/www/script.js +++ b/inst/app/www/script.js @@ -35,8 +35,14 @@ $( document ).ready(function() { txt = $(this).text() df = $(this).attr("class").split(" ")[1] val = $(this).parent().find("select").children("option:selected").val() + lst = []; + if (val === "ALL") { + for (let i = 2; i < $(this).parent().find("select").children().length; i++) { + lst.push($(this).parent().find("select").children()[i].text); + } + } str += `${df}*${txt.replace(" ", "")}*${val} + `.replace(/\r?\n|\r/g, "") - obj.numbers.push({txt,df,val}) + obj.numbers.push({txt,df,val,lst}) }) // currently return a string seperated by + // and blocks must be one word - this is very fragile! From d2e832ca7946b82c9802db7673b4b724b8f24407 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 12 Sep 2022 16:36:31 -0400 Subject: [PATCH 12/19] Update convertTGOutput() to output all visits if "ALL" selected --- R/mod_tableGen_fct_methods.R | 67 +++++++++++++++++++++--------------- 1 file changed, 40 insertions(+), 27 deletions(-) diff --git a/R/mod_tableGen_fct_methods.R b/R/mod_tableGen_fct_methods.R index 01bd4fad..56f83962 100644 --- a/R/mod_tableGen_fct_methods.R +++ b/R/mod_tableGen_fct_methods.R @@ -111,7 +111,7 @@ custom_class <- function(x, df) { #' @importFrom purrr map_chr #' @importFrom stringr str_trim #' -#' @param agg the aggregate statistic block +#' @param aggs the aggregate statistic block #' to apply to the column #' @param blocks the block corresponding #' to the column name to apply statistic on @@ -119,39 +119,52 @@ custom_class <- function(x, df) { #' @family tableGen Functions #' @noRd #' -convertTGOutput <- function(agg, blocks) { +convertTGOutput <- function(aggs, blocks) { - agg <- unlist(agg, recursive = FALSE) + aggs <- unlist(aggs, recursive = FALSE) blocks <- unlist(blocks, recursive = FALSE) - # why does it work if I assign it outside the tibble??? - test <- purrr::map_chr(agg, "val", .default = NA_character_) %>% unname() - - if (length(agg) > length(blocks)) { + if (length(aggs) > length(blocks)) { stop("Need addional variable block") - } else if (length(agg) < length(blocks)) { + } else if (length(aggs) < length(blocks)) { stop("Need additional statistics block") } else { - tidyr::tibble( - agg = purrr::map_chr(agg, "txt") %>% unname() %>% str_trim(), - block = purrr::map_chr(blocks, "txt") %>% unname() %>% str_trim(), - dataset = purrr::map_chr(blocks, "df") %>% unname() %>% str_trim(), - # why is this NA in the tibble, but not NA pri - # dropdown = map_chr(agg, "val", .default = NA_character_) %>% unname() - dropdown = test, - S3 = map2(block, dataset, ~ custom_class(.x, .y)), - gt_group = - case_when( - dropdown == "NONE" ~ glue("{agg} of {block}"), - is.na(dropdown) ~ glue("{agg} of {block}"), - tolower(substr(dropdown, 1, 4)) %in% c("week","base","scree","end ") ~ glue("{agg} of {block} at {dropdown}"), - TRUE ~ glue("{agg} of {block} and {dropdown}") # "and" instead of "at" - )#, # will need to feed these datasets through to this function? Or create a new funct? - # that get's called "blocks_and_functions" that adds the labels? - # label = purrr::map(blockData$block, function(x) attr(data_to_use(dataset)[[x]], 'label')) %>% - # unname() %>% str_trim() - ) + purrr::map2_df(aggs, blocks, function(aggs, blocks) { + if (aggs$val == "ALL") { + purrr::map_df(aggs$lst, function(dropdown) { + tidyr::tibble( + agg = aggs$txt %>% unname() %>% str_trim(), + block = blocks$txt %>% unname() %>% str_trim(), + dataset = blocks$df %>% unname() %>% str_trim(), + dropdown = dropdown %>% unname() %>% str_trim(), + S3 = map2(block, dataset, ~ custom_class(.x, .y)), + gt_group = + case_when( + dropdown == "NONE" ~ glue("{agg} of {block}"), + is.na(dropdown) ~ glue("{agg} of {block}"), + tolower(substr(dropdown, 1, 4)) %in% c("week","base","scree","end ") ~ glue("{agg} of {block} at {dropdown}"), + TRUE ~ glue("{agg} of {block} and {dropdown}") # "and" instead of "at" + ) + ) + }) + } else { + tidyr::tibble( + agg = aggs$txt %>% unname() %>% str_trim(), + block = blocks$txt %>% unname() %>% str_trim(), + dataset = blocks$df %>% unname() %>% str_trim(), + dropdown = aggs$val %>% unname() %>% str_trim(), + S3 = map2(block, dataset, ~ custom_class(.x, .y)), + gt_group = + case_when( + aggs$val == "NONE" ~ glue("{agg} of {block}"), + is.na(aggs$val) ~ glue("{agg} of {block}"), + tolower(substr(aggs$val, 1, 4)) %in% c("week","base","scree","end ") ~ glue("{agg} of {block} at {aggs$val}"), + TRUE ~ glue("{agg} of {block} and {aggs$val}") # "and" instead of "at" + ) + ) + } + }) } } From 1ff5187d4d82196781711e994d40877a8ae4ed6c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 14 Sep 2022 08:26:39 -0400 Subject: [PATCH 13/19] Fix convertTGOutput() to create STAN tables with missing dropdowns --- R/mod_tableGen_fct_methods.R | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/R/mod_tableGen_fct_methods.R b/R/mod_tableGen_fct_methods.R index 56f83962..708d2ec9 100644 --- a/R/mod_tableGen_fct_methods.R +++ b/R/mod_tableGen_fct_methods.R @@ -123,7 +123,7 @@ convertTGOutput <- function(aggs, blocks) { aggs <- unlist(aggs, recursive = FALSE) blocks <- unlist(blocks, recursive = FALSE) - + if (length(aggs) > length(blocks)) { stop("Need addional variable block") } else if (length(aggs) < length(blocks)) { @@ -131,7 +131,7 @@ convertTGOutput <- function(aggs, blocks) { } else { purrr::map2_df(aggs, blocks, function(aggs, blocks) { - if (aggs$val == "ALL") { + if (!is.null(aggs$val) && aggs$val == "ALL") { purrr::map_df(aggs$lst, function(dropdown) { tidyr::tibble( agg = aggs$txt %>% unname() %>% str_trim(), @@ -153,17 +153,19 @@ convertTGOutput <- function(aggs, blocks) { agg = aggs$txt %>% unname() %>% str_trim(), block = blocks$txt %>% unname() %>% str_trim(), dataset = blocks$df %>% unname() %>% str_trim(), - dropdown = aggs$val %>% unname() %>% str_trim(), + dropdown = ifelse(is.null(aggs$val), NA_character_, aggs$val %>% unname() %>% str_trim()), S3 = map2(block, dataset, ~ custom_class(.x, .y)), gt_group = case_when( - aggs$val == "NONE" ~ glue("{agg} of {block}"), - is.na(aggs$val) ~ glue("{agg} of {block}"), - tolower(substr(aggs$val, 1, 4)) %in% c("week","base","scree","end ") ~ glue("{agg} of {block} at {aggs$val}"), - TRUE ~ glue("{agg} of {block} and {aggs$val}") # "and" instead of "at" + dropdown == "NONE" ~ glue("{agg} of {block}"), + is.na(dropdown) ~ glue("{agg} of {block}"), + tolower(substr(dropdown, 1, 4)) %in% c("week","base","scree","end ") ~ glue("{agg} of {block} at {dropdown}"), + TRUE ~ glue("{agg} of {block} and {dropdown}") # "and" instead of "at" ) ) } + + }) } From ed7f1299dbfa74ca1714052fee1a2c1e57c7582d Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 14 Sep 2022 08:28:17 -0400 Subject: [PATCH 14/19] Only include ADAE data in R Script if included in uploaded data --- R/mod_tableGen.R | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index ef18cc49..c266c1f5 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -660,13 +660,12 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL if("ADAE" %in% names(datafile())){ glue::glue(" # Create AE data set - pre_adae <- datalist %>% - tidyCDISC::prep_adae(pre_adsl$data, '{RECIPE()}') - ae_data <- pre_adae$data + pre_adae <- datalist %>% + tidyCDISC::prep_adae(pre_adsl$data, '{RECIPE()}') + ae_data <- pre_adae$data " ) - } else {" - "} + } else {""} }) # capture output of filtering expression # input_filter_df <- c("one","mild","Moderate") @@ -830,7 +829,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL # Calculate totals for population set {total_for_code()} - tg_datalist <- list(ADAE = ae_data, ADSL = bds_data, POPDAT = {Rscript_use_preferred_pop_data()}) + tg_datalist <- list({ifelse(adae_expr() == '', '', 'ADAE = ae_data, ')}ADSL = bds_data, POPDAT = {Rscript_use_preferred_pop_data()}) tg_table <- tidyCDISC::tg_gt(tg_datalist, blockData, total_df, {column() %quote% 'NULL'}) From 955620204d2fa1899df55931f8dce7de78dbde89 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 14 Sep 2022 08:29:39 -0400 Subject: [PATCH 15/19] Export new functions std_footnote() and tg_gt() --- NAMESPACE | 2 ++ R/mod_tableGen_utils.R | 23 +++++++++++++++++++++++ man/std_footnote.Rd | 16 ++++++++++++++++ man/tg_gt.Rd | 20 ++++++++++++++++++++ 4 files changed, 61 insertions(+) create mode 100644 man/std_footnote.Rd create mode 100644 man/tg_gt.Rd diff --git a/NAMESPACE b/NAMESPACE index c8515dc1..728c434c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,8 @@ export(prep_adsl) export(prep_bds) export(pretty_IDs) export(run_app) +export(std_footnote) +export(tg_gt) export(varN_fctr_reorder) import(dplyr) import(shiny) diff --git a/R/mod_tableGen_utils.R b/R/mod_tableGen_utils.R index f730b8ab..13606420 100644 --- a/R/mod_tableGen_utils.R +++ b/R/mod_tableGen_utils.R @@ -445,6 +445,11 @@ pretty_IDs <- function(ID) { ) } +#' Prep Block Data for TG Tables +#' +#' @param blockData The `blockData` object from the application +#' +#' @noRd prep_blocks <- function(blockData) { dput(blockData) %>% capture.output() %>% @@ -453,6 +458,14 @@ prep_blocks <- function(blockData) { str_replace_all("(\\),)", "\\1\n") } +#' Create Standard Footnotes for TG Table +#' +#' Creates a footnote with a source on the left and date run on the right. +#' +#' @param data The `gt` table object to append the footnote +#' @param source The source of the data in the table +#' +#' @export std_footnote <- function(data, source) { gt::tab_footnote(data, tags$div(HTML("Source:", source), @@ -461,6 +474,16 @@ std_footnote <- function(data, source) { style="text-align:left")) } +#' Create the gt table object for TG +#' +#' 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 total_df A data frame containing the totals by grouping variable +#' @param group A character denoting the grouping variable +#' +#' @export tg_gt <- function(tg_datalist, blockData, total_df, group) { purrr::pmap(list( blockData$agg, diff --git a/man/std_footnote.Rd b/man/std_footnote.Rd new file mode 100644 index 00000000..227d3690 --- /dev/null +++ b/man/std_footnote.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_tableGen_utils.R +\name{std_footnote} +\alias{std_footnote} +\title{Create Standard Footnotes for TG Table} +\usage{ +std_footnote(data, source) +} +\arguments{ +\item{data}{The `gt` table object to append the footnote} + +\item{source}{The source of the data in the table} +} +\description{ +Creates a footnote with a source on the left and date run on the right. +} diff --git a/man/tg_gt.Rd b/man/tg_gt.Rd new file mode 100644 index 00000000..413340b1 --- /dev/null +++ b/man/tg_gt.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_tableGen_utils.R +\name{tg_gt} +\alias{tg_gt} +\title{Create the gt table object for TG} +\usage{ +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{total_df}{A data frame containing the totals by grouping variable} + +\item{group}{A character denoting the grouping variable} +} +\description{ +A wrapper for other functions to create the `gt` object from the data +} From 892de81fdfa2653a8dd8aae0310406200946a505 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 20 Oct 2022 16:31:25 -0400 Subject: [PATCH 16/19] Update NEWS --- DESCRIPTION | 2 +- NEWS.md | 10 +++++++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 28aed557..5ece4c08 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: tidyCDISC Title: Quick Table Generation & Exploratory Analyses on ADaM-Ish Datasets -Version: 0.1.0.9000 +Version: 0.1.1 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 82b28f3e..461f7d95 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,13 @@ -# tidyCDISC (development version) +# tidyCDISC 0.1.1 +* automate a footnote with **Source** and **Run Date** in table generation +* allow custom user provided footnotes + +* allow the selection of All when a time grouped statistic is chosen in the table generator + +* cleaned up downloadable R Script to replicate table generation output + +* fixed bug where `data_from` was listed as a grouping option in the population explorer # tidyCDISC 0.1.0 (CRAN Release) From 156846c341dc9c1116e1e388f864e511c82fcabb Mon Sep 17 00:00:00 2001 From: Aaron Clark Date: Thu, 20 Oct 2022 16:50:37 -0400 Subject: [PATCH 17/19] Update NEWS.md refreshed news.md workding --- NEWS.md | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/NEWS.md b/NEWS.md index 461f7d95..a0e4bded 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,13 +1,14 @@ # tidyCDISC 0.1.1 -* automate a footnote with **Source** and **Run Date** in table generation -* allow custom user provided footnotes +* automated a footnote with **Source** and **Run Date** in table generation -* allow the selection of All when a time grouped statistic is chosen in the table generator +* allowed custom user-defined footnotes -* cleaned up downloadable R Script to replicate table generation output +* allowed the selection of 'All' when a time/visit-based statistic is chosen in the table generator -* fixed bug where `data_from` was listed as a grouping option in the population explorer +* cleaned up downloadable R Script to replicate table generator output + +* fixed bug where `data_from` was erroneously listed as a grouping option in the population explorer # tidyCDISC 0.1.0 (CRAN Release) From d09f6fad518afe95fe01663c4c659b0da5e93d7c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Oct 2022 07:54:27 -0400 Subject: [PATCH 18/19] Add `std_footnote()` and `tg_gt()` to reference index --- R/mod_tableGen_utils.R | 2 ++ man/std_footnote.Rd | 1 + man/tg_gt.Rd | 1 + 3 files changed, 4 insertions(+) diff --git a/R/mod_tableGen_utils.R b/R/mod_tableGen_utils.R index 13606420..76b642d0 100644 --- a/R/mod_tableGen_utils.R +++ b/R/mod_tableGen_utils.R @@ -466,6 +466,7 @@ prep_blocks <- function(blockData) { #' @param source The source of the data in the table #' #' @export +#' @keywords tabGen_repro std_footnote <- function(data, source) { gt::tab_footnote(data, tags$div(HTML("Source:", source), @@ -484,6 +485,7 @@ std_footnote <- function(data, source) { #' @param group A character denoting the grouping variable #' #' @export +#' @keywords tabGen_repro tg_gt <- function(tg_datalist, blockData, total_df, group) { purrr::pmap(list( blockData$agg, diff --git a/man/std_footnote.Rd b/man/std_footnote.Rd index 227d3690..d673b03a 100644 --- a/man/std_footnote.Rd +++ b/man/std_footnote.Rd @@ -14,3 +14,4 @@ std_footnote(data, source) \description{ Creates a footnote with a source on the left and date run on the right. } +\keyword{tabGen_repro} diff --git a/man/tg_gt.Rd b/man/tg_gt.Rd index 413340b1..e02eda8c 100644 --- a/man/tg_gt.Rd +++ b/man/tg_gt.Rd @@ -18,3 +18,4 @@ tg_gt(tg_datalist, blockData, total_df, group) \description{ A wrapper for other functions to create the `gt` object from the data } +\keyword{tabGen_repro} From a76e03923305cd8aee1ee49398eea990d5e028b1 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 21 Oct 2022 08:26:59 -0400 Subject: [PATCH 19/19] check `{tidyCDISC}` version number in R Script --- R/mod_tableGen.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/mod_tableGen.R b/R/mod_tableGen.R index c266c1f5..6a937f93 100644 --- a/R/mod_tableGen.R +++ b/R/mod_tableGen.R @@ -757,6 +757,11 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL pkgs_req <- c('tidyCDISC', 'purrr', 'haven', 'dplyr', 'stringr', 'tidyr', 'gt') {install_text} + if (utils::compareVersion(as.character(utils::packageVersion('tidyCDISC')), '{packageVersion('tidyCDISC')}') < 0) {{ + install.packages('remotes') + remotes::install_github('Biogen-Inc/tidyCDISC') + }} + library(tidyCDISC) library(purrr) library(haven)