Check in changes - DEVR-3489-fix-bugs-for-generating-title

DESCRIPTION

@@ -47,4 +47,4 @@ Suggests:
     tidyr
 Config/testthat/edition: 3
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2

R/tlf_ae_exp_adj.R

@@ -20,6 +20,8 @@
 #'
 #' @inheritParams tlf_ae_specific
 #'
+#' @param analysis One of analysis name existing at `outdata$meta$analysis`
+#'
 #' @return RTF file and source dataset for exposure-adjusted AE summary table.
 #'
 #' @export
@@ -37,11 +39,13 @@
 #'   format_ae_exp_adj() |>
 #'   tlf_ae_exp_adj(
 #'     source = "Source:  [CDISCpilot: adam-adsl; adae]",
+#'     analysis = "ae_exp_adj",
 #'     path_outdata = tempfile(fileext = ".Rdata"),
 #'     path_outtable = tempfile(fileext = ".rtf")
 #'   )
 tlf_ae_exp_adj <- function(outdata,
                            source,
+                           analysis,
                            col_rel_width = NULL,
                            text_font_size = 9,
                            orientation = "portrait",
@@ -56,6 +60,15 @@ tlf_ae_exp_adj <- function(outdata,
   n_row <- nrow(tbl)
   n_col <- ncol(tbl)
 
+  # Check if the parameter analysis contains the correct analysis that should exist in "outdata$meta$analysis"
+  analysis_name <- names(outdata$meta$analysis)
+  if (!(analysis %in% analysis_name)) {
+    stop(
+      "Please provide a valid analysis that matches with what being defined in 'outdata$meta$analysis'",
+      call. = FALSE
+    )
+  }
+
   parameters <- unlist(strsplit(outdata$parameter, ";"))
 
   # Title
@@ -65,7 +78,7 @@ tlf_ae_exp_adj <- function(outdata,
       outdata$population,
       outdata$observation,
       parameters[1],
-      analysis = "ae_exp_adj",
+      analysis = analysis,
       title_order = title
     )
   }

R/tlf_ae_listing.R

@@ -21,6 +21,7 @@
 #' @param outdata An `outdata` object created by [prepare_ae_listing()].
 #' @param footnotes A character vector of table footnotes.
 #' @param source A character value of the data source.
+#' @param analysis One of analysis name existing at `outdata$meta$analysis`
 #' @inheritParams r2rtf::rtf_page
 #' @inheritParams r2rtf::rtf_body
 #' @param path_outdata A character string of the outdata path.
@@ -39,20 +40,31 @@
 #'   tlf_ae_listing(
 #'     footnotes = "footnote1",
 #'     source = "Source:  [CDISCpilot: adam-adsl; adae]",
+#'     analysis = "ae_listing",
 #'     path_outdata = tempfile(fileext = ".Rdata"),
 #'     path_outtable = tempfile(fileext = ".rtf")
 #'   )
 tlf_ae_listing <- function(outdata,
                            footnotes = NULL,
                            source = NULL,
+                           analysis,
                            col_rel_width = NULL,
                            text_font_size = 9,
                            orientation = "landscape",
                            path_outdata = NULL,
                            path_outtable = NULL) {
   res <- outdata$tbl
 
-  mapping <- collect_adam_mapping(outdata$meta, "ae_listing")
+  # Check if the parameter analysis contains the correct analysis that should exist in "outdata$meta$analysis"
+  analysis_name <- names(outdata$meta$analysis)
+  if (!(analysis %in% analysis_name)) {
+    stop(
+      "Please provide a valid analysis that matches with what being defined in 'outdata$meta$analysis'",
+      call. = FALSE
+    )
+  }
+
+  mapping <- collect_adam_mapping(outdata$meta, analysis)
   var_name <- eval(mapping$var_name)
   subline <- eval(mapping$subline)
   subline_by <- eval(mapping$subline_by)
@@ -62,7 +74,7 @@ tlf_ae_listing <- function(outdata,
   col_name <- outdata$col_name
 
   # Define title
-  title <- collect_title(outdata$meta, outdata$population, outdata$observation, outdata$parameter, analysis = "ae_listing")
+  title <- collect_title(outdata$meta, outdata$population, outdata$observation, outdata$parameter, analysis = analysis)
 
   if (!nrow(res) == 0) {
     res <- as.data.frame(res)

R/tlf_ae_specific.R

@@ -22,6 +22,7 @@
 #' @param meddra_version A character value of the MedDRA version
 #'   for this dataset.
 #' @param source A character value of the data source.
+#' @param analysis One of analysis name existing at `outdata$meta$analysis`
 #' @inheritParams r2rtf::rtf_page
 #' @inheritParams r2rtf::rtf_body
 #' @param footnotes A character vector of table footnotes.
@@ -46,13 +47,15 @@
 #'   format_ae_specific() |>
 #'   tlf_ae_specific(
 #'     source = "Source:  [CDISCpilot: adam-adsl; adae]",
+#'     analysis = "ae_specific",
 #'     meddra_version = "24.0",
 #'     path_outdata = tempfile(fileext = ".Rdata"),
 #'     path_outtable = tempfile(fileext = ".rtf")
 #'   )
 tlf_ae_specific <- function(outdata,
                             meddra_version,
                             source,
+                            analysis,
                             col_rel_width = NULL,
                             text_font_size = 9,
                             orientation = "portrait",
@@ -92,14 +95,23 @@ tlf_ae_specific <- function(outdata,
     )
   }
 
+  # Check if the parameter analysis contains the correct analysis that should exist in "outdata$meta$analysis"
+  analysis_name <- names(outdata$meta$analysis)
+  if (!(analysis %in% analysis_name)) {
+    stop(
+      "Please provide a valid analysis that matches with what being defined in 'outdata$meta$analysis'",
+      call. = FALSE
+    )
+  }
+
   # Define title
   if ("analysis" %in% title | "observation" %in% title | "population" %in% title) {
     title_key <- title
     title_text <- collect_title(outdata$meta,
       outdata$population,
       outdata$observation,
       outdata$parameter,
-      analysis = "ae_specific",
+      analysis = analysis,
       title_order = title
     )
 

R/tlf_ae_specific_subgroup.R

@@ -20,6 +20,8 @@
 #'
 #' @inheritParams tlf_ae_specific
 #'
+#' @param analysis One of analysis name existing at `outdata$meta$analysis`
+#'
 #' @return RTF file and the source dataset for AE specific subgroup analysis table.
 #'
 #' @export
@@ -37,12 +39,14 @@
 #'   tlf_ae_specific_subgroup(
 #'     meddra_version = "24.0",
 #'     source = "Source:  [CDISCpilot: adam-adsl; adae]",
+#'     analysis = "ae_specific",
 #'     path_outtable = tempfile(fileext = ".rtf")
 #'   )
 tlf_ae_specific_subgroup <- function(
     outdata,
     meddra_version,
     source,
+    analysis,
     col_rel_width = NULL,
     text_font_size = 9,
     orientation = "landscape",
@@ -88,13 +92,22 @@ tlf_ae_specific_subgroup <- function(
     )
   }
 
+  # Check if the parameter analysis contains the correct analysis that should exist in "outdata$meta$analysis"
+  analysis_name <- names(outdata$meta$analysis)
+  if (!(analysis %in% analysis_name)) {
+    stop(
+      "Please provide a valid analysis that matches with what being defined in 'outdata$meta$analysis'",
+      call. = FALSE
+    )
+  }
+
   # Define title
   if (is.null(title)) {
     title <- collect_title(outdata$meta,
       outdata$population,
       outdata$observation,
       outdata$parameter,
-      analysis = "ae_specific"
+      analysis = analysis
     )
   }
 

R/tlf_ae_summary.R

@@ -20,6 +20,8 @@
 #'
 #' @inheritParams tlf_ae_specific
 #'
+#' @param analysis One of analysis name existing at `outdata$meta$analysis`
+#'
 #' @return RTF file and the source dataset for AE summary table.
 #'
 #' @export
@@ -35,11 +37,13 @@
 #'   format_ae_summary() |>
 #'   tlf_ae_summary(
 #'     source = "Source:  [CDISCpilot: adam-adsl; adae]",
+#'     analysis = "ae_summary",
 #'     path_outdata = tempfile(fileext = ".Rdata"),
 #'     path_outtable = tempfile(fileext = ".rtf")
 #'   )
 tlf_ae_summary <- function(outdata,
                            source,
+                           analysis,
                            col_rel_width = NULL,
                            text_font_size = 9,
                            orientation = "portrait",
@@ -54,6 +58,15 @@ tlf_ae_summary <- function(outdata,
   n_row <- nrow(tbl)
   n_col <- ncol(tbl)
 
+  # Check if the parameter analysis contains the correct analysis that should exist in "outdata$meta$analysis"
+  analysis_name <- names(outdata$meta$analysis)
+  if (!(analysis %in% analysis_name)) {
+    stop(
+      "Please provide a valid analysis that matches with what being defined in 'outdata$meta$analysis'",
+      call. = FALSE
+    )
+  }
+
   parameters <- unlist(strsplit(outdata$parameter, ";"))
 
   # Title
@@ -63,7 +76,7 @@ tlf_ae_summary <- function(outdata,
       outdata$population,
       outdata$observation,
       parameters[1],
-      analysis = "ae_summary",
+      analysis = analysis,
       title_order = title
     )
   }

tests/testthat/test-independent-testing-empty_table.R

@@ -39,6 +39,7 @@ generate_analysis_or_empty <- function(meta, outdata) {
       ) |>
       tlf_ae_specific(
         source = "Source: [CDISCpilot: adam-adsl; adae]",
+        analysis = "ae_specific",
         meddra_version = "24.0",
         path_outdata = path_rdata,
         path_outtable = path_rtf
@@ -74,6 +75,7 @@ test_that("RTF output: empty table or analysis table.", {
       ) |>
       tlf_ae_specific(
         source = "Source: [CDISCpilot: adam-adsl; adae]",
+        analysis = "ae_specific",
         meddra_version = "24.0",
         path_outdata = path_rdata,
         path_outtable = path_rtf

tests/testthat/test-independent-testing-tlf-ae-listing.R

@@ -15,6 +15,7 @@ tbl <- outdata |>
   tlf_ae_listing(
     footnotes = "footnote1",
     source = "Source:  [CDISCpilot: adam-adsl; adae]",
+    analysis = "ae_listing",
     path_outdata = path_rdata,
     path_outtable = path_rtf
   )