Merge pull request #65 from Biogen-Inc/non_pilot_tests

Non pilot tests

Author: AARON-CLARK

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tidyCDISC
 Title: tidyCDISC: Quick Exploratory Data Analyses on ADaM-ish Datasets
-Version: 0.0.1
+Version: 0.0.2
 Authors@R: as.person(c( 
     "Aaron Clark <[email protected]> [aut, cre]",
     "Maya Gans <[email protected]> [aut]",

NEWS.md

@@ -1,3 +1,15 @@
+# tidyCDISC 0.0.2
+
+This release (PR #65) performs a lot of functions, testing on many non-pilot ADSL files to ensure app's robustness beyond just the CDISC pilot data:
+
+* closes #64: Agg class objects lost droppability when only ADSL uploaded
+* get's rid of annoying font awesome message about verifying an icon exists
+* updates gt code that was deprecated
+* Made sure 'PARAM' exists in the data when trying to label a block
+* got rid of unnecessary argument in col_for_list() and col_for_list_expr()
+* added some code that helped the FREQ block produce the correct results when ran locally (via a reproducibility script)
+* a little code clean up for readability
+
 # tidyCDISC 0.0.1
 
 This release adds meat to the previous skeleton version of `tidyCDISC`. The initial development release was intended to be a "bare bones" platform that could serve as a foundation to build a great clinical data exploratory tool. Version `0.0.1` enriches the user experience by adding useful & commonly needed features for analysis. For more on this release, see [the announcement](https://biogen-inc.github.io/tidyCDISC/articles/Blog.html#announcing-tidycdisc-0-0-1-1) on our blog.

R/mod_dataComply_fct_helpers.R

@@ -273,8 +273,8 @@ gather_reqs <- function(input, output, session,
       gt(rowname_col = "type_col" , groupname_col = "df") %>%
       cols_label(not_exist_disp = "Doesn't Exist", missing_disp = "Missing Data") %>%
       text_transform(
-        locations = list(cells_body(columns = vars(not_exist_disp), rows = not_exist_disp == "X"),
-                         cells_body(columns = vars(missing_disp), rows = missing_disp == "X")),
+        locations = list(cells_body(columns = c(not_exist_disp), rows = not_exist_disp == "X"),
+                         cells_body(columns = c(missing_disp), rows = missing_disp == "X")),
         fn = function(X) local_image(filename = "inst/app/www/red_x.png", height = 15)
       ) %>%
       tab_header(

R/mod_popExp_ui.R

@@ -33,7 +33,7 @@ mod_popExp_ui <- function(id, label = "Population Explorer"){
                div(id = "pop_cic_adv_filtering", class="filter-accordion",
                  checkboxInput(ns("adv_filtering"), 
                    div(class="filter-container", span("Filter Data ", style="float:left;"), 
-                        span(icon("chevron-down w3-tiny"), style="float:right;")),
+                        span(icon("chevron-down w3-tiny", verify_fa = FALSE), style="float:right;")),
                    value = F)
                ),
                conditionalPanel(condition = "input.adv_filtering == true", ns = ns,

R/mod_tableGen.R

@@ -204,18 +204,13 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL
   # this allows our dropdown to be in chronological order
   avisit_words <- reactive({ 
     req(datafile())
-    # req(any(purrr::map_lgl(datafile(), ~"AVISIT" %in% colnames(.x))))
 
     if(any(purrr::map_lgl(datafile(), ~"AVISIT" %in% colnames(.x)))){
-      # if("AVISIT" %in% colnames(BDS())){
         purrr::map(BDS(), function(x) x %>% dplyr::select(AVISIT)) %>%
           dplyr::bind_rows() %>%
           dplyr::pull(AVISIT)
-      # }else {
-      #   c("fake_weeky","dummy_weeky")
-      # }
     } else {
-      c("fake_weeky","dummy_weeky")
+      NULL #c("fake_weeky","dummy_weeky") # DON'T use this comment part. It's handled in AVISIT()
     }
 
   })
@@ -225,13 +220,9 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL
     req(any(purrr::map_lgl(datafile(), ~"AVISIT" %in% colnames(.x))))
 
     if(any(purrr::map_lgl(datafile(), ~"AVISIT" %in% colnames(.x)))){
-      # if("AVISITN" %in% colnames(BDS())){
         purrr::map(BDS(), function(x) x %>% dplyr::select(AVISITN)) %>%
           dplyr::bind_rows() %>%
           dplyr::pull(AVISITN)
-      # } else {
-      #   1:2
-      # }
     } else {
       1:2
     }
@@ -251,7 +242,6 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL
         pull(AVISIT) %>%
         unique()
     }
-    # print(avisit_words[avisit_words != ""])
     avisit_words[avisit_words != ""]
   })
 
@@ -359,7 +349,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL
       purrr::map2(blockData$block, blockData$dataset, function(var, dat) {
         if(!is.null(attr(data_to_use_str(dat)[[var]], 'label'))){
           attr(data_to_use_str(dat)[[var]], 'label')
-        } else if("PARAMCD" %in% colnames(data_to_use_str(dat))){
+        } else if(all(c("PARAM","PARAMCD") %in% colnames(data_to_use_str(dat)))){
           data_to_use_str(dat) %>%
             filter(PARAMCD == var) %>%
             distinct(PARAM) %>%
@@ -488,7 +478,7 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL
                       ,gsub("<br/>", "\n        ", pre_filter_msgs())))
     }
 
-    purrr::pmap(list(blocks_and_functions()$agg, 
+    d <- purrr::pmap(list(blocks_and_functions()$agg, 
                       blocks_and_functions()$S3, 
                       blocks_and_functions()$dropdown,
                       blocks_and_functions()$dataset), 
@@ -506,43 +496,40 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL
           pattern = '\\b'%s+%pretty_blocks$Pattern%s+%'\\b',
           replacement = pretty_blocks$Replacement,
           vectorize_all = FALSE))
+    return(d)
   })
 
   output$for_gt_table <- renderTable({ for_gt() })
 
   # remove the first two columns from the row names to use since 
   # these are used for grouping in gt. Make sure Total is at the end
   row_names_n <- reactive({ 
-    test <- names(for_gt())[-c(1:2)] 
-    test[grepl("\\.\\.\\.", test)] <- "Missing"
-    test <- test[test != "Total"]
-    append(test, "Total")
+    some_names <- names(for_gt())[-c(1:2)] 
+    some_names[grepl("\\.\\.\\.", some_names)] <- "Missing"
+    some_names_no_tot <- some_names[some_names != "Total"]
+    append(some_names_no_tot, "Total")
   })
 
   # create the labels for each column using the total function
   # so the columns are now NAME N= X
-  col_for_list <- function(nm, x) {
+  col_for_list <- function(nm) {
     if (is.numeric(use_data_reactive()[[input$COLUMN]])) {
       stop("Need categorical column for grouping")
     }
     nm = md(glue::glue("**{row_names_n()}** <br> N={total()}"))
   }
 
-  
-  
-  
-  
   # create gt table
   gt_table <- reactive({
     for_gt() %>%
       # gt(rowname_col = "Variable", groupname_col = "ID") %>%
       gt(groupname_col = "ID") %>%
-      fmt_markdown(columns = vars(Variable),
+      fmt_markdown(columns = c(Variable),
                    rows = stringr::str_detect(Variable,'&nbsp;') |
                      stringr::str_detect(Variable,'<b>') |
                      stringr::str_detect(Variable,'</b>')) %>%
       tab_options(table.width = px(700)) %>%
-      cols_label(.list = imap(for_gt()[-c(1:2)], ~col_for_list(.y, .x))) %>%
+      cols_label(.list = purrr::imap(for_gt()[-c(1:2)], ~col_for_list(.x))) %>%
       tab_header(
         title = md(input$table_title),
         subtitle = md(subtitle_html())
@@ -859,12 +846,12 @@ mod_tableGen_server <- function(input, output, session, datafile = reactive(NULL
       library(gt)
       tg_table %>%
           gt(groupname_col = 'ID') %>%
-          fmt_markdown(columns = vars(Variable),
+          fmt_markdown(columns = c(Variable),
                  rows = stringr::str_detect(Variable,'&nbsp;') |
                    stringr::str_detect(Variable,'<b>') |
                    stringr::str_detect(Variable,'</b>')) %>%
           tab_options(table.width = px(700)) %>%
-          cols_label(.list = imap(tg_table[-c(1:2)], ~ tidyCDISC::col_for_list_expr(.y, .x))) %>%
+          cols_label(.list = imap(tg_table[-c(1:2)], ~ tidyCDISC::col_for_list_expr(.x))) %>%
           tab_header(
             title = md('{input$table_title}'),
             subtitle = md(\"{subtitle_html()}\")

R/mod_tableGen_fct_blocks.R

@@ -38,7 +38,7 @@ rowPallete <- function(data) {
        ~div(class="accordion-container",
             div(class="accordion",
                 h6(.x, style="display:inline-block;"),
-                tags$button(icon("chevron-down w3-tiny", class="rotate"))),
+                tags$button(icon("chevron-down w3-tiny", verify_fa = FALSE, class="rotate"))),
             div(class="accordion-panel",
                 div(
                   tags$ul(rowBlock(.y,.x), class = 'all_blocks', class = .x)

R/mod_tableGen_fct_freq.R

@@ -132,6 +132,7 @@ app_freq.ADAE <- app_freq.ADSL <- function(column, group = NULL, data, totals) {
              prop = ifelse(n_tot == 0, 0, n / n_tot),
              v = paste0(n, ' (', sprintf("%.1f", round(prop*100, 1)), ')')) %>%
       select(-n, -prop) %>%
+      mutate(!!group := ifelse(!!group == '', '_missing_', !!group)) %>%
       tidyr::pivot_wider(!!column, names_from = !!group, values_from = v)
 
     cbind(groups, total$x)

R/mod_tableGen_fct_meanSummary.R

@@ -24,4 +24,4 @@ mean_summary <- function(.data, to_count) {
       `Min | Max` = paste0(round(min(na.omit(!!to_count)), 2), " | ", 
                            round(max(na.omit(!!to_count)), 2))
     )
-}
+}

R/mod_tableGen_fct_methods.R

@@ -31,6 +31,8 @@ app_methods <- function(agg, column, week, group, data, totals) {
       ){
     stop(glue::glue("{column} variable doesn't exist in data, please remove or replace that variable from drop zone."))
   }
+  
+  
   if (agg == "MEAN") {
     app_mean(column, week, group, data)
   } else if (agg == "FREQ") {

R/utils_helpers.R

@@ -10,7 +10,7 @@
 #' @keywords tabGen_repro
 #' 
 # get column names with N
-col_for_list_expr <- function(nm, x) {
+col_for_list_expr <- function(nm) {
   nm = md(glue::glue("**{row_names_n}** <br> N={total}"))
 }