split listings

NEWS.md

@@ -1,8 +1,9 @@
 # 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.
+* `grob_list` and `gg_list` are now deprecated. Use `list()` instead.
 
 # 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 `list` object.
 #'
 #' @details
 #'  * Removes duplicate rows.
@@ -35,13 +36,16 @@ 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]],
+
+  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,
+    ...
   )
 }
 
@@ -72,7 +76,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, "list")) {
+    if (length(tlg) == 0) tlg <- null_report
+  } else {
+    if (nrow(tlg) == 0) tlg <- null_report
+  }
 
   tlg
 }

R/mng01.R

@@ -22,7 +22,7 @@
 #' @param ggtheme (`theme`) passed to [tern::g_lineplot()].
 #' @param table (`character`) names of the statistics to be displayed in the table. If `NULL`, no table is displayed.
 #' @param ... passed to [tern::g_lineplot()].
-#' @returns the main function returns a `gg_list` object.
+#' @returns the main function returns a `list` of `ggplot` objects.
 #'
 #' @note
 #'  * `adam_db` object must contain the table specified by `dataset` with the columns specified by `x_var`, `y_var`,
@@ -117,7 +117,7 @@ mng01_main <- function(adam_db,
     col <- line_col
   }
 
-  ret <- lapply(
+  lapply(
     data_ls,
     tern::g_lineplot,
     alt_counts_df = adam_db[["adsl"]],
@@ -133,7 +133,6 @@ mng01_main <- function(adam_db,
     subtitle_add_unit = !is.na(y_unit),
     ...
   )
-  do_call(gg_list, ret)
 }
 
 #' @describeIn mng01 Preprocessing

R/utils.R

@@ -109,33 +109,7 @@ fuse_sequentially <- function(x, y) {
   c(x, y[sel_names_y])
 }
 
-#' List of `grob` object
-#'
-#' @param ... (`grob`) objects.
-#' @returns a `grob_list` object.
-#' @export
-grob_list <- function(...) {
-  ret <- list(...)
-  assert_list(ret, types = c("grob"))
-  structure(
-    ret,
-    class = c("grob_list", "list")
-  )
-}
-
-#' List of `gg` object
-#'
-#' @param ... (`ggplot`) objects.
-#' @returns a `gg_list` object.
-#' @export
-gg_list <- function(...) {
-  ret <- list(...)
-  assert_list(ret, types = c("ggplot"))
-  structure(
-    ret,
-    class = c("gg_list", "list")
-  )
-}
+# lvl ----
 
 #' @export
 droplevels.character <- function(x, ...) {
@@ -390,3 +364,29 @@ to_list <- function(x) {
   x <- as.list(x)
   lapply(x, to_list)
 }
+
+# Deprecated functions ----
+
+#' List of `grob` object
+#'
+#' `r lifecycle::badge("deprecated")`
+#'
+#' @param ... (`grob`) objects.
+#' @returns a `grob_list` object.
+#' @export
+grob_list <- function(...) {
+  lifecycle::deprecate_warn("0.2.5.9009", "grob_list()", "list()")
+  list(...)
+}
+
+#' List of `gg` object
+#'
+#' `r lifecycle::badge("deprecated")`
+#'
+#' @param ... (`ggplot`) objects.
+#' @returns a `gg_list` object.
+#' @export
+gg_list <- function(...) {
+  lifecycle::deprecate_warn("0.2.5.9009", "gg_list()", "list()")
+  list(...)
+}

_pkgdown.yaml

@@ -114,9 +114,7 @@ reference:
       - report_null
       - smart_prune
       - var_labels_for
-      - gg_list
       - gg_theme_chevron
-      - grob_list
       - h_format_dec
       - lvls
       - convert_to_month
@@ -128,8 +126,11 @@ reference:
       - missing_rule
       - empty_rule
       - get_grade_rule
-
   - title: Non-exported Documented Functions for Packagage Developers
     contents:
       - gen_args
       - fuse_sequentially
+  - title: Deprecated Functions
+    contents:
+      - grob_list
+      - gg_list

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)))
+})

tests/testthat/test-utils.R

@@ -55,18 +55,6 @@ test_that("fuse_sequentially works", {
   )
 })
 
-# grob_list ----
-
-test_that("grob_list works", {
-  grob <- grid::grob()
-  grobs <- expect_silent(
-    grob_list(grob, grob, grob)
-  )
-  expect_s3_class(grobs, "grob_list")
-  expect_identical(length(grobs), 3L)
-  expect_identical(grobs[[1]], grob)
-})
-
 # ifneeded_split_row ----
 
 test_that("ifneeded_split_row works as expected", {
@@ -293,3 +281,37 @@ test_that("get_section_div works", {
     expect_identical(get_section_div(), c("", NA_character_, ""))
   )
 })
+
+# Deprecated Functions ----
+
+test_that("grob_list is deprecated", {
+  withr::with_options(
+    list(lifecycle_verbosity = "warning"),
+    {
+      graph <- run(chevron::mng01, syn_data, dataset = "adlb")
+      graph <- ggplot2::ggplotGrob(graph[[3]])
+      class(graph) <- "grob"
+
+      expect_warning(
+        grob_list(graph),
+        "`grob_list()` was deprecated in chevron 0.2.5.9009.",
+        fixed = TRUE
+      )
+    }
+  )
+})
+
+test_that("gg_list is deprecated", {
+  withr::with_options(
+    list(lifecycle_verbosity = "warning"),
+    {
+      graph <- run(chevron::mng01, syn_data, dataset = "adlb")
+
+      expect_warning(
+        gg_list(graph),
+        "`gg_list()` was deprecated in chevron 0.2.5.9009.",
+        fixed = TRUE
+      )
+    }
+  )
+})