377475 static footers

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: dv.listings
 Type: Package
 Title: Data listings module
-Version: 4.3.4-9004
+Version: 4.3.4-9005
 Authors@R: 
     c(
       person("Boehringer-Ingelheim Pharma GmbH & Co.KG", role = c("cph", "fnd")),

NEWS.md

@@ -1,3 +1,6 @@
+# dv.listings 4.3.4-9005
+- Static per-dataset footer text
+
 # dv.listings 4.3.4-9004
 - Review functionality:
   - Expand revision count limit from 1000 to 10000 entries

R/check_call_auto.R

@@ -3,8 +3,8 @@
 # styler: off
 
 # dv.listings::mod_listings
-check_mod_listings_auto <- function(afmm, datasets, module_id, dataset_names, default_vars, pagination,
-    intended_use_label, subjid_var, receiver_id, review, err) {
+check_mod_listings_auto <- function(afmm, datasets, module_id, dataset_names, default_vars, footers,
+    pagination, intended_use_label, subjid_var, receiver_id, review, err) {
     OK <- logical(0)
     used_dataset_names <- new.env(parent = emptyenv())
     OK[["module_id"]] <- CM$check_module_id("module_id", module_id, err)
@@ -14,6 +14,9 @@ check_mod_listings_auto <- function(afmm, datasets, module_id, dataset_names, de
     "NOTE: default_vars (group) tagged as \"manual_check\""
     "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
+    "NOTE: footers (group) tagged as \"manual_check\""
+    "      The expectation is that it either does not require automated checks or that"
+    "      the caller of this function has written manual checks near the call site."
     "NOTE: pagination (logical) tagged as \"manual_check\""
     "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."

R/export_helpers.R

@@ -406,7 +406,7 @@ pdf_preprocessing <- function(df, ref) {
 #' @return Named list containing the data frames which are now ready for download.
 #'
 #' @keywords internal
-prep_export_data <- function(data_selection, current_data, data_selection_name, dataset_list) {
+prep_export_data <- function(data_selection, current_data, data_selection_name, dataset_list, footers) {
   # check validity of parameters
   checkmate::assert(
     checkmate::check_string(data_selection),
@@ -424,17 +424,31 @@ prep_export_data <- function(data_selection, current_data, data_selection_name,
     data_to_download <- dataset_list
   }
 
-  names(data_to_download) <- shorten_entries(
+  shortened_names <- shorten_entries(
     paste0(names(data_to_download), " (", get_labels(data_to_download), ")"),
     as.integer(31) # name has to be shortened to 31 characters due to Excel's sheet name limit
   )
 
-  # convert types to character to avoid representation issues in Excel
-  data_to_download <- lapply(data_to_download, function(df) {
-    labels <- get_labels(df)
-    data <- data.frame(sapply(df, as.character))
-    data <- set_labels(data, labels)
+  data_to_download <- local({
+    res <- list()
+    for (i_dataset in seq_along(data_to_download)){
+      df <- data_to_download[[i_dataset]]
+
+      # convert types to character to avoid representation issues in Excel
+      labels <- get_labels(df)
+      data <- data.frame(sapply(df, as.character))
+      data <- set_labels(data, labels)
+
+      # attach footer, if available
+      dataset_name <- names(data_to_download)[[i_dataset]]
+      attr(data, "footer") <- footers[[dataset_name]]
+
+      res[[length(res) + 1]] <- data
+    }
+    return(res)
   })
+
+  names(data_to_download) <- shortened_names
 
   return(data_to_download)
 }
@@ -458,9 +472,16 @@ excel_export <- function(data_to_download, file, intended_use_label) {
     combine = "and"
   )
 
-  # Add column labels
+  # Add column labels and footers
   data_to_download <- lapply(data_to_download, function(x) {
     names(x) <- paste0(names(x), " [", get_labels(x), "]")
+    footer <- attr(x, "footer")
+    if (!is.null(footer)) {
+      first_new_row <- nrow(x) + 1
+      last_new_row <- nrow(x) + length(footer)
+      x[first_new_row:last_new_row, ] <- NA
+      x[first_new_row:last_new_row, 1] <- footer
+    }
     return(x)
   })
 
@@ -522,6 +543,7 @@ pdf_export <- function(data_to_download, ref_cols, file, metadata, active_sessio
       trial_name = gsub("_", "\\\\_", metadata[1]), # Rmd does not allow underscore
       time_stamp = gsub("[^-/A-Za-z0-9!?.,:() ]", "?", metadata[2]), # replace characters that could cause problems
       snap_shot_name = gsub("[^-/A-Za-z0-9!?.,:() ]", "?", metadata[3]), # same here
+      footer = attr(data_to_download[[1]], "footer"),
       df_list = res_preprocess,
       active_session = active_session
     ),

R/mod_export_listings.R

@@ -94,7 +94,8 @@ mod_export_listings_server <- function(module_id,
                                        data,
                                        data_selection_name,
                                        current_rows,
-                                       intended_use_label) {
+                                       intended_use_label,
+                                       footers) {
   # check validity of parameters
   checkmate::assert(
     checkmate::check_string(module_id, min.chars = 1),
@@ -266,7 +267,7 @@ mod_export_listings_server <- function(module_id,
           shiny::removeModal() # close pop up
 
           data_to_download <- prep_export_data(
-            input[[EXP$DATASEL_ID]], current_data(), data_selection_name(), v_dataset_list()
+            input[[EXP$DATASEL_ID]], current_data(), data_selection_name(), v_dataset_list(), footers
           )
 
           if (input[[EXP$FILETYPE_ID]] == ".xlsx") {

R/mod_listings.R

@@ -8,6 +8,7 @@ TBL <- pack_of_constants( # nolint
   DRPDBUTTON_WIDTH = "300px",
   DRPDBUTTON_LABEL = "Click to see inputs",
   TABLE_ID = "listing",
+  FOOTER_ID = "footer",
   NO_COL_MSG = "Please select at least one column.",
   EXPORT_ID = "export",
   RESET_FILT_BUTTON_ID = "reset_filt_btn",
@@ -50,7 +51,8 @@ listings_UI <- function(module_id) { # nolint
 
   shiny::tagList(
     add_dv_listings_dependency(),
-    highlight_review_cols,    
+    highlight_review_cols,
+    htmltools::div(style = "display: flex; flex-direction:column; height: 100%",
     shiny::div(
       style = "display: flex; gap: 10px; align-items: baseline",
       shinyWidgets::dropdownButton(
@@ -140,7 +142,12 @@ listings_UI <- function(module_id) { # nolint
         )
       ),
     ),
-    DT::dataTableOutput(ns(TBL$TABLE_ID), height = "87vh"),
+    shiny::div(
+      style = "flex-grow:1",
+      DT::dataTableOutput(ns(TBL$TABLE_ID), height = "100%"),
+    ),
+    shiny::uiOutput(ns(TBL$FOOTER_ID)),
+    ),
     shiny::tags[["script"]](shiny::HTML(sprintf("
     $('#%s').on('init.dt', function(e, settings) {    
       const table_container_id = '%s';
@@ -223,6 +230,7 @@ listings_UI <- function(module_id) { # nolint
 listings_server <- function(module_id,
                             dataset_list,
                             default_vars = NULL,
+                            footers = NULL,
                             dataset_metadata,
                             pagination = NULL,
                             intended_use_label = NULL,
@@ -400,7 +408,8 @@ listings_server <- function(module_id,
       data = shiny::reactive(set_data(listings_data(), r_selected_columns_in_dataset()[[input[[TBL$DATASET_ID]]]])),
       data_selection_name = shiny::reactive(input[[TBL$DATASET_ID]]),
       current_rows = shiny::reactive(input[[paste0(TBL$TABLE_ID, "_rows_all")]]),
-      intended_use_label = intended_use_label
+      intended_use_label = intended_use_label,
+      footers
     )
 
     # Proxy reference to dataTable
@@ -662,11 +671,24 @@ listings_server <- function(module_id,
           ordering = TRUE,
           columnDefs = column_defs,
           # TODO: Update to use new recommended API: https://datatables.net/reference/option/layout
-          dom = "<'top'<'top-title'>>rtilp", # Buttons, filtering, processing display element, table, information summary, length, pagination
+          dom = "<'top'<'top-title'>>rt<'controls-row'l<'spacer'>i<'spacer'>p>", # Buttons, filtering, processing display element, table, information summary, length, pagination
           fixedColumns = list(left = review_col_count),
           colResize = list(),
           processing = TRUE,
           initComplete = htmlwidgets::JS(init_complete_js),
+          rowCallback = htmlwidgets::JS(
+            # Source - https://stackoverflow.com/a/58526580
+            # Posted by Stéphane Laurent
+            # Retrieved 2026-04-09, License - CC BY-SA 4.0
+            "function(row, data){",
+            "  for(var i=0; i<data.length; i++){",
+            "    if(data[i] === null){",
+            "      $('td:eq('+i+')', row).html('NA')",
+            "        .css({'color': 'rgb(151,151,151)', 'font-style': 'italic'});",
+            "    }",
+            "  }",
+            "}"
+          ),
           drawCallback = htmlwidgets::JS("
             function (settings) {  
             const table_wrapper = settings.nTableWrapper;
@@ -729,6 +751,13 @@ listings_server <- function(module_id,
 
       return(res)
     })
+
+    output[[TBL$FOOTER_ID]] <- shiny::renderUI({
+      dataset_name <- input[[TBL$DATASET_ID]]
+      shiny::req(dataset_name)
+      footer <- footers[[dataset_name]]
+      htmltools::HTML(sprintf("<p>%s</p>", paste0(footer, collapse = "<br>")))
+    })
 
     shiny::exportTestValues(
       selected_columns_in_dataset = r_selected_columns_in_dataset()
@@ -819,6 +848,7 @@ mod_listings <- function(
     module_id,
     dataset_names,
     default_vars = NULL,
+    footers = NULL,
     pagination = NULL,
     intended_use_label = "Use only for internal review and monitoring during the conduct of clinical trials.",
     subjid_var = "USUBJID",
@@ -874,6 +904,7 @@ mod_listings <- function(
       listings_server(
         dataset_list = dataset_list,
         default_vars = default_vars,
+        footers = footers,
         dataset_metadata = afmm$dataset_metadata,
         pagination = pagination,
         module_id = module_id,
@@ -895,6 +926,7 @@ mod_listings_API_docs <- list(
   module_id = "",
   dataset_names = list(""),
   default_vars = list(""),
+  footers = list(""),
   pagination = list(""),
   intended_use_label = list(""),
   subjid_var = list(""), 
@@ -912,6 +944,7 @@ mod_listings_API_spec <- TC$group(
   module_id = TC$mod_ID(),
   dataset_names = TC$dataset_name() |> TC$flag("one_or_more"),
   default_vars = TC$group() |> TC$flag("manual_check"),                         # manually tested by check_mod_listings
+  footers = TC$group() |> TC$flag("manual_check"),                              # manually tested by check_mod_listings
   pagination = TC$logical() |> TC$flag("manual_check", "optional"),             # manually tested by check_mod_listings
   intended_use_label = TC$character() |> TC$flag("manual_check", "optional"),   # manually tested by check_mod_listings
   subjid_var = TC$character() |> TC$flag("manual_check"),                       # manually tested by check_mod_listings
@@ -929,13 +962,13 @@ dataset_info_listings <- function(dataset_names, ...) {
 }
 
 check_mod_listings <- function(afmm, datasets, module_id, dataset_names, 
-                               default_vars, pagination, intended_use_label,
+                               default_vars, footers, pagination, intended_use_label,
                                subjid_var, receiver_id, review) {
   err <- CM$container()
 
   ok <- check_mod_listings_auto(
     afmm, datasets,
-    module_id, dataset_names, default_vars, pagination, intended_use_label,
+    module_id, dataset_names, default_vars, footers, pagination, intended_use_label,
     subjid_var, receiver_id, review, err
   )
 
@@ -959,6 +992,16 @@ check_mod_listings <- function(afmm, datasets, module_id, dataset_names,
       }
     }
   }
+
+  # footers
+  if (ok[["dataset_names"]] && !is.null(footers)) {
+    CM$assert(
+      container = err,
+      cond = (checkmate::test_list(footers, types = "character", names = "unique") &&
+              checkmate::test_subset(names(footers), dataset_names)),
+      msg = "`footers` should be a named list, whose names are unique references to elements of `dataset_names`."
+    )
+  }
 
   # pagination
   CM$assert(

inst/rmd/create_pdf_export.Rmd

@@ -10,6 +10,7 @@ params:
   snap_shot_name: NULL
   df_list: NULL
   active_session: NULL
+  footer: NULL
 title: "`r params$set_title`"
 subtitle: "`r params$set_subtitle`"
 header-includes:
@@ -54,9 +55,21 @@ purrr::iwalk(params$df_list, ~ {
 
   # Print table
   print(k)
-  cat("\\clearpage")
+  if (.y < num_pages) cat("\\clearpage") # no trailing new page
 })
 
+html_to_text <- function(html_var) {
+  txt <- gsub("<br\\s*/?>", "\n\n", html_var, ignore.case = TRUE) # Rmd double newlines
+  txt <- gsub("<[^>]+>", "", txt) # strip all other HTML tags
+  return(txt)
+}
+
+if (length(params$footer)) {
+  html_output <- sprintf("<p>%s</p>", paste(params$footer, collapse = "<br>"))
+  text_output <- html_to_text(html_output)
+  cat(text_output)
+}
+
 if (params$active_session) {
   shiny::setProgress(
     message = "Finalizing document.",

inst/www/css/dv_listings.css

@@ -137,3 +137,22 @@
 .dataTables_wrapper:has(.dv-listings-table) div.dataTables_processing>div:last-child>div {
   background: #00E47C !important;
 }
+
+.dataTables_wrapper:has(.dv-listings-table) .dataTables_info,
+.dataTables_wrapper:has(.dv-listings-table) .dataTables_length,
+.dataTables_wrapper:has(.dv-listings-table) .dataTables_paginate {
+  display: inline-block;
+  white-space: nowrap;
+  padding: 0 !important;
+}
+
+.dataTables_wrapper:has(.dv-listings-table) .controls-row {
+  display: flex;
+  align-items: center;
+  width: 100%;
+  padding: 10px 0;
+}
+
+.dataTables_wrapper:has(.dv-listings-table) .spacer {
+  flex-grow: 1;
+}