split listings

NAMESPACE

@@ -1,5 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as.gg_list,ggplot)
+S3method(as.gg_list,list)
+S3method(as.rl_list,list)
+S3method(as.rl_list,listing_df)
 S3method(assert_valid_var,character)
 S3method(assert_valid_var,default)
 S3method(assert_valid_var,factor)
@@ -47,6 +51,8 @@ export(aet10_main)
 export(aet10_post)
 export(aet10_pre)
 export(args_ls)
+export(as.gg_list)
+export(as.rl_list)
 export(assert_single_value)
 export(assert_valid_var)
 export(assert_valid_variable)
@@ -175,6 +181,7 @@ export(postprocess)
 export(preprocess)
 export(reformat)
 export(report_null)
+export(rl_list)
 export(rmpt01)
 export(rmpt01_main)
 export(rmpt01_post)

NEWS.md

@@ -1,8 +1,8 @@
 # chevron 0.2.5.9009
 
 * Added assertion on class of `summaryvars` argument of `dmt01()`.
-
 * Soft deprecated `strat` argument of `kmg01_main` - use `strata` instead.
+* Additional arguments can be passed to `ael01_nollt` run method, for instance to split the resulting listing.
 
 # chevron 0.2.5
 

R/ael01_nollt.R

@@ -6,7 +6,8 @@
 #' @param dataset (`character`) the name of a table in the `adam_db` object.
 #' @param default_formatting (`list`) the default format of the listing columns. See [`rlistings::as_listing`].
 #' @param col_formatting (`list`) the format of specific listing columns. See [`rlistings::as_listing`].
-#' @returns the main function returns an `rlistings` object.
+#' @param ... additional arguments passed to [`rlistings::as_listing`].
+#' @returns the main function returns an `rlistings` or a `rl_list` object.
 #'
 #' @details
 #'  * Removes duplicate rows.
@@ -35,14 +36,23 @@ ael01_nollt_main <- function(adam_db,
   assert_list(default_formatting, types = "fmt_config", names = "unique")
   assert_list(col_formatting, null.ok = TRUE, types = "fmt_config", names = "unique")
   assert_flag(unique_rows)
-  as_listing(
-    adam_db[[dataset]],
+
+  ret <- execute_with_args(
+    as_listing,
+    df = adam_db[[dataset]],
     key_cols = key_cols,
     disp_cols = disp_cols,
     default_formatting = default_formatting,
     col_formatting = col_formatting,
-    unique_rows = unique_rows
+    unique_rows = unique_rows,
+    ...
   )
+
+  if (is(ret, "list")) {
+    as.rl_list(ret)
+  } else {
+    ret
+  }
 }
 
 #' @describeIn ael01_nollt Preprocessing
@@ -72,7 +82,11 @@ ael01_nollt_pre <- function(adam_db,
 #' @returns the postprocessing function returns an `rlistings` object or an `ElementaryTable` (null report).
 #'
 ael01_nollt_post <- function(tlg, ...) {
-  if (nrow(tlg) == 0) tlg <- null_report
+  if (is(tlg, "rl_list")) {
+    if (length(tlg) == 0) tlg <- null_report
+  } else {
+    if (nrow(tlg) == 0) tlg <- null_report
+  }
 
   tlg
 }

R/mng01.R

@@ -133,7 +133,7 @@ mng01_main <- function(adam_db,
     subtitle_add_unit = !is.na(y_unit),
     ...
   )
-  do_call(gg_list, ret)
+  as.gg_list(ret)
 }
 
 #' @describeIn mng01 Preprocessing

R/utils.R

@@ -123,10 +123,13 @@ grob_list <- function(...) {
   )
 }
 
+# gg_list ----
+
 #' List of `gg` object
 #'
 #' @param ... (`ggplot`) objects.
 #' @returns a `gg_list` object.
+#' @rdname gg_list
 #' @export
 gg_list <- function(...) {
   ret <- list(...)
@@ -137,6 +140,74 @@ gg_list <- function(...) {
   )
 }
 
+#' Convert Object to List of `gg_list`.
+#'
+#' @param obj (`ggplot` or `list` of `ggplot`)
+#' @return a `gg_list` object.
+#' @rdname gg_list
+#'
+#' @export
+as.gg_list <- function(obj) { # nolint
+  UseMethod("as.gg_list")
+}
+
+#' @rdname gg_list
+#' @export
+as.gg_list.list <- function(obj) {
+  assert_list(obj, types = "ggplot")
+  do_call(gg_list, obj)
+}
+
+#' @rdname rl_list
+#' @export
+as.gg_list.ggplot <- function(obj) {
+  do_call(gg_list, list(obj))
+}
+
+# rl_list ----
+
+#' List of `rlistings` object
+#'
+#' @param ... (`rlistings`) objects.
+#' @returns a `rl_list` object.
+#' @rdname rl_list
+#'
+#' @export
+rl_list <- function(...) {
+  ret <- list(...)
+  assert_list(ret, types = c("listing_df"))
+  structure(
+    ret,
+    class = c("rl_list", "list")
+  )
+}
+
+#' Convert Object to List of `rl_list`.
+#'
+#' @param obj (`rlisting` or `list` of `rlistings`)
+#' @returns a `rl_list` object.
+#' @rdname rl_list
+#'
+#' @export
+as.rl_list <- function(obj) { # nolint
+  UseMethod("as.rl_list")
+}
+
+#' @rdname rl_list
+#' @export
+as.rl_list.list <- function(obj) {
+  assert_list(obj, types = "listing_df")
+  do_call(rl_list, obj)
+}
+
+#' @rdname rl_list
+#' @export
+as.rl_list.listing_df <- function(obj) {
+  do_call(rl_list, list(obj))
+}
+
+# lvl ----
+
 #' @export
 droplevels.character <- function(x, ...) {
   x

_pkgdown.yaml

@@ -115,6 +115,7 @@ reference:
       - smart_prune
       - var_labels_for
       - gg_list
+      - rl_list
       - gg_theme_chevron
       - grob_list
       - h_format_dec

tests/testthat/_snaps/ael01_nollt.md

@@ -63,3 +63,50 @@
       No Coding Available         No Coding Available     trm C.1.1.1.3                      
                                                           trm D.1.1.4.2                      
 
+# ael01_nollt listing can be split by an additional variable
+
+    Code
+      cat(export_as_txt(res, lpp = 100))
+    Output
+      SEX: F
+
+      —————————————————————————————————————————————————————————————————————————————————————————
+      MedDRA System Organ Class   MedDRA Preferred Term   Reported Term for the Medical History
+      —————————————————————————————————————————————————————————————————————————————————————————
+      cl A                        trm A_1/2               trm A_1/2                            
+      cl D                        trm D_3/3               trm D_3/3                            
+      \s\nSEX: M
+
+      —————————————————————————————————————————————————————————————————————————————————————————
+      MedDRA System Organ Class   MedDRA Preferred Term   Reported Term for the Medical History
+      —————————————————————————————————————————————————————————————————————————————————————————
+      cl A                        trm A_2/2               trm A_2/2                            
+      cl B                        trm B_1/3               trm B_1/3                            
+                                  trm B_2/3               trm B_2/3                            
+                                  trm B_3/3               trm B_3/3                            
+      cl C                        trm C_1/2               trm C_1/2                            
+                                  trm C_2/2               trm C_2/2                            
+      cl D                        trm D_1/3               trm D_1/3                            
+                                  trm D_2/3               trm D_2/3                            
+
+# split ael01_nollt listing do not display missing values
+
+    Code
+      cat(export_as_txt(res, lpp = 100))
+    Output
+      SEX: F
+
+      —————————————————————————————————————————————————————————————————————————————————————————
+      MedDRA System Organ Class   MedDRA Preferred Term   Reported Term for the Medical History
+      —————————————————————————————————————————————————————————————————————————————————————————
+      cl A                        trm A_1/2               trm A_1/2                            
+                                  trm A_2/2               trm A_2/2                            
+      cl B                        trm B_1/3               trm B_1/3                            
+                                  trm B_2/3               trm B_2/3                            
+                                  trm B_3/3               trm B_3/3                            
+      cl C                        trm C_1/2               trm C_1/2                            
+                                  trm C_2/2               trm C_2/2                            
+      cl D                        trm D_1/3               trm D_1/3                            
+                                  trm D_2/3               trm D_2/3                            
+                                  trm D_3/3               trm D_3/3                            
+

tests/testthat/test-ael01_nollt.R

@@ -30,7 +30,7 @@ test_that("ael01_nollt can handle all missing values", {
     )
 
   res <- expect_silent(run(ael01_nollt, proc_data))
-  expect_identical(nrow(res), 1L)
+  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
 })
 
 test_that("ael01_nollt can handle some missing values", {
@@ -47,3 +47,36 @@ test_that("ael01_nollt can handle some missing values", {
   res <- expect_silent(run(ael01_nollt, proc_data))
   expect_snapshot(cat(export_as_txt(res, lpp = 100)))
 })
+
+test_that("ael01_nollt listing can be split by an additional variable", {
+  res <- expect_silent(
+    run(
+      ael01_nollt,
+      syn_data,
+      dataset = "admh",
+      key_cols = c("MHBODSYS", "MHDECOD"),
+      disp_cols = "MHTERM",
+      split_into_pages_by_var = "SEX"
+    )
+  )
+  expect_list(res, types = "listing_df")
+  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
+})
+
+test_that("split ael01_nollt listing do not display missing values", {
+  proc_data <- syn_data
+  proc_data$admh <- proc_data$admh[proc_data$admh$SEX == "F", ]
+
+  res <- expect_silent(
+    run(
+      ael01_nollt,
+      proc_data,
+      dataset = "admh",
+      key_cols = c("MHBODSYS", "MHDECOD"),
+      disp_cols = "MHTERM",
+      split_into_pages_by_var = "SEX"
+    )
+  )
+  expect_list(res, types = "listing_df", len = 1)
+  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
+})