Fix split list for pagination when with ordered factors

R/rlistings.R

@@ -335,6 +335,13 @@ setMethod(
       )
     )
 
+    if (any(grepl("([{}])", fullmat))) {
+      stop(
+        "Labels cannot contain { or } due to their use for indicating referential footnotes.\n",
+        "These are not supported at the moment in {rlistings}."
+      )
+    }
+
     MatrixPrintForm(
       strings = fullmat,
       spans = matrix(1,
@@ -452,9 +459,10 @@ add_listing_col <- function(df,
 #' Each listing can only be split by variable once. If this function is applied prior to
 #' pagination, parameter values will be separated by page.
 #'
-#' @param lsting listing_df. The listing to split.
-#' @param var character. Name of the variable to split on.
-#' @param page_prefix character. Prefix to be appended with the split value (`var` level),
+#' @param lsting (`listing_df`)\cr the listing to split.
+#' @param var (`string`)\cr name of the variable to split on. If the column is a factor,
+#'   the resulting list follows the order of the levels.
+#' @param page_prefix (`string`)\cr prefix to be appended with the split value (`var` level),
 #'   at the end of the subtitles, corresponding to each resulting list element (listing).
 #'
 #' @return A list of `lsting_df` objects each corresponding to a unique value of `var`.
@@ -482,8 +490,17 @@ split_into_pages_by_var <- function(lsting, var, page_prefix = var) {
   checkmate::assert_class(lsting, "listing_df")
   checkmate::assert_choice(var, names(lsting))
 
+  # Pre-processing in case of factor variable
+  levels_or_vals <- if (is.factor(lsting[[var]])) {
+    lvls <- levels(lsting[[var]])
+    lvls[lvls %in% unique(lsting[[var]])] # Filter out missing values
+  } else {
+    unique(lsting[[var]])
+  }
+
+  # Main list creator (filters rows by var)
   lsting_by_var <- list()
-  for (lvl in unique(lsting[[var]])) {
+  for (lvl in levels_or_vals) {
     var_desc <- paste0(page_prefix, ": ", lvl)
     lsting_by_var[[lvl]] <- lsting[lsting[[var]] == lvl, ]
     subtitles(lsting_by_var[[lvl]]) <- c(subtitles(lsting), var_desc)

tests/testthat/test-listings.R

@@ -330,7 +330,7 @@ testthat::test_that("split_into_pages_by_var works as expected", {
     split_into_pages_by_var("SEX", page_prefix = "Patient Subset - Sex")
 
   testthat::expect_equal(length(lsting), length(unique(tmp_data[["SEX"]])))
-  testthat::expect_equal(subtitles(lsting[[1]]), "Patient Subset - Sex: M")
+  testthat::expect_equal(subtitles(lsting[[1]]), "Patient Subset - Sex: F")
 
   lsting <- as_listing(
     tmp_data,

tests/testthat/test-matrix_form.R

@@ -41,3 +41,31 @@ testthat::test_that("matrix_form keeps relevant information and structure about
   testthat::expect_equal(ncol(rlmf), ncol(rlmf$strings))
   testthat::expect_false(mf_has_rlabels(rlmf))
 })
+
+test_that("matrix_form detects { or } in labels and sends meaningful error message", {
+  dat <- ex_adae[1:10, ]
+  dat$AENDY[3:6] <- "something {haha} something"
+  lsting <- as_listing(
+    dat,
+    key_cols = c("USUBJID"),
+    disp_cols = c("STUDYID", "AENDY")
+  )
+  expect_error(
+    matrix_form(lsting),
+    "Labels cannot contain"
+  )
+
+  # Workaround for ref_fnotes works
+  levels(dat$ARM)[1] <- "A: Drug X(1)"
+
+  # Generate listing
+  lsting <- as_listing(
+    df = adae,
+    key_cols = c("ARM"),
+    disp_cols = c("BMRKR1"),
+    main_footer = "(1) adasdasd"
+  )
+
+  expect_true(grepl(toString(lsting), pattern = "\\(1\\) adasdasd"))
+  expect_true(grepl(toString(lsting), pattern = "A: Drug X\\(1\\)"))
+})

tests/testthat/test-paginate_listing.R

@@ -320,11 +320,14 @@ testthat::test_that("paginate_listing works with split_into_pages_by_var", {
     add_listing_col("BMRKR1", format = "xx.x") %>%
     split_into_pages_by_var("SEX", page_prefix = "Patient Subset - Sex")
 
+  # split keeps the order of the levels
+  expect_equal(names(lsting), levels(tmp_data$SEX)[seq(2)])
+
   pag_listing <- paginate_listing(lsting, lpp = 20, cpp = 65, print_pages = FALSE)[[3]]
   testthat::expect_equal(main_title(pag_listing), "title")
-  testthat::expect_equal(subtitles(pag_listing), "Patient Subset - Sex: F")
+  testthat::expect_equal(subtitles(pag_listing), "Patient Subset - Sex: M")
   testthat::expect_equal(main_footer(pag_listing), "foot")
-  testthat::expect_true(all(pag_listing$strings[-1, 3] == "F"))
+  testthat::expect_true(all(pag_listing$strings[-1, 3] == "M"))
   testthat::expect_snapshot(fast_print(list(pag_listing)))
 
   # This works also for the pagination print

vignettes/ref_footnotes.Rmd

@@ -87,8 +87,8 @@ df_lbls <- var_labels(adae)
 # Specify order of levels with new referential footnotes added
 adae <- adae %>% dplyr::mutate(
   ARM = factor(
-    ifelse(ARM == "A: Drug X" & ASEQ %in% 1:2, paste0(ARM, "*"), as.character(ARM)),
-    levels = c(sapply(levels(adae$ARM), paste0, c("", "*")))
+    ifelse(ARM == "A: Drug X" & ASEQ %in% 1:2, paste0(ARM, " (1)"), as.character(ARM)),
+    levels = c(sapply(levels(adae$ARM), paste0, c("", "(1)")))
   )
 )
 
@@ -100,6 +100,7 @@ lsting <- as_listing(
   df = adae,
   key_cols = c("ARM", "USUBJID", "ASEQ", "ASTDY"),
   disp_cols = c("BMRKR1", "AESEV"),
+  main_footer = "(1)   ASEQ 1 or 2"
 )
 
 lsting