diff --git a/R/rlistings.R b/R/rlistings.R index 04d43d10..9b686a91 100644 --- a/R/rlistings.R +++ b/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) diff --git a/man/split_into_pages_by_var.Rd b/man/split_into_pages_by_var.Rd index 77123190..82f0b3ff 100644 --- a/man/split_into_pages_by_var.Rd +++ b/man/split_into_pages_by_var.Rd @@ -7,11 +7,12 @@ split_into_pages_by_var(lsting, var, page_prefix = var) } \arguments{ -\item{lsting}{listing_df. The listing to split.} +\item{lsting}{(\code{listing_df})\cr the listing to split.} -\item{var}{character. Name of the variable to split on.} +\item{var}{(\code{string})\cr name of the variable to split on. If the column is a factor, +the resulting list follows the order of the levels.} -\item{page_prefix}{character. Prefix to be appended with the split value (\code{var} level), +\item{page_prefix}{(\code{string})\cr prefix to be appended with the split value (\code{var} level), at the end of the subtitles, corresponding to each resulting list element (listing).} } \value{ diff --git a/tests/testthat/_snaps/export.md b/tests/testthat/_snaps/export.md index 670dc603..0ee2d20a 100644 --- a/tests/testthat/_snaps/export.md +++ b/tests/testthat/_snaps/export.md @@ -104,66 +104,6 @@ cat(pages_listings) Output title - Patient Subset - Sex: M - - ————————————————————————————————————— - Unique Subject Identifier Age Sex - ————————————————————————————————————— - AB12345-BRA-1-id-134 47 M - M - M - M - AB12345-BRA-1-id-236 32 M - M - M - AB12345-BRA-1-id-265 25 M - M - M - M - AB12345-BRA-1-id-42 36 M - M - M - M - M - M - M - M - M - M - ————————————————————————————————————— - - foot - \s\ntitle - Patient Subset - Sex: M - - ————————————————————————————————————————————————————————————— - Unique Subject Identifier Age Continous Level Biomarker 1 - ————————————————————————————————————————————————————————————— - AB12345-BRA-1-id-134 47 6.5 - 6.5 - 6.5 - 6.5 - AB12345-BRA-1-id-236 32 7.7 - 7.7 - 7.7 - AB12345-BRA-1-id-265 25 10.3 - 10.3 - 10.3 - 10.3 - AB12345-BRA-1-id-42 36 2.3 - 2.3 - 2.3 - 2.3 - 2.3 - 2.3 - 2.3 - 2.3 - 2.3 - 2.3 - ————————————————————————————————————————————————————————————— - - foot - \s\ntitle Patient Subset - Sex: F ————————————————————————————————————— @@ -257,6 +197,66 @@ ————————————————————————————————————————————————————————————— foot + \s\ntitle + Patient Subset - Sex: M + + ————————————————————————————————————— + Unique Subject Identifier Age Sex + ————————————————————————————————————— + AB12345-BRA-1-id-134 47 M + M + M + M + AB12345-BRA-1-id-236 32 M + M + M + AB12345-BRA-1-id-265 25 M + M + M + M + AB12345-BRA-1-id-42 36 M + M + M + M + M + M + M + M + M + M + ————————————————————————————————————— + + foot + \s\ntitle + Patient Subset - Sex: M + + ————————————————————————————————————————————————————————————— + Unique Subject Identifier Age Continous Level Biomarker 1 + ————————————————————————————————————————————————————————————— + AB12345-BRA-1-id-134 47 6.5 + 6.5 + 6.5 + 6.5 + AB12345-BRA-1-id-236 32 7.7 + 7.7 + 7.7 + AB12345-BRA-1-id-265 25 10.3 + 10.3 + 10.3 + 10.3 + AB12345-BRA-1-id-42 36 2.3 + 2.3 + 2.3 + 2.3 + 2.3 + 2.3 + 2.3 + 2.3 + 2.3 + 2.3 + ————————————————————————————————————————————————————————————— + + foot # export_as_txt works with empty listings diff --git a/tests/testthat/_snaps/paginate_listing.md b/tests/testthat/_snaps/paginate_listing.md index 02bcc79e..d972bdf9 100644 --- a/tests/testthat/_snaps/paginate_listing.md +++ b/tests/testthat/_snaps/paginate_listing.md @@ -100,17 +100,15 @@ Output Page 1 title - Patient Subset - Sex: F + Patient Subset - Sex: M ————————————————————————————————————— Unique Subject Identifier Age Sex ————————————————————————————————————— - AB12345-BRA-1-id-141 35 F - F - F - F - F - F + AB12345-BRA-1-id-134 47 M + M + M + M ————————————————————————————————————— foot @@ -122,32 +120,32 @@ Output --- Page 1/2 --- title - Patient Subset - Sex: M + Patient Subset - Sex: F ——————————————————————————————————————————————————————————————————— Unique Subject Identifier Age Sex Continous Level Biomarker 1 ——————————————————————————————————————————————————————————————————— - AB12345-BRA-1-id-134 47 M 6.5 - M 6.5 - M 6.5 - M 6.5 + AB12345-BRA-1-id-141 35 F 7.5 + F 7.5 + F 7.5 + F 7.5 + F 7.5 + F 7.5 ——————————————————————————————————————————————————————————————————— foot --- Page 2/2 --- title - Patient Subset - Sex: F + Patient Subset - Sex: M ——————————————————————————————————————————————————————————————————— Unique Subject Identifier Age Sex Continous Level Biomarker 1 ——————————————————————————————————————————————————————————————————— - AB12345-BRA-1-id-141 35 F 7.5 - F 7.5 - F 7.5 - F 7.5 - F 7.5 - F 7.5 + AB12345-BRA-1-id-134 47 M 6.5 + M 6.5 + M 6.5 + M 6.5 ——————————————————————————————————————————————————————————————————— foot diff --git a/tests/testthat/test-listings.R b/tests/testthat/test-listings.R index 4f463723..0e2a9ab5 100644 --- a/tests/testthat/test-listings.R +++ b/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, diff --git a/tests/testthat/test-matrix_form.R b/tests/testthat/test-matrix_form.R index fe4bd133..cd43445f 100644 --- a/tests/testthat/test-matrix_form.R +++ b/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 = dat, + 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\\)")) +}) diff --git a/tests/testthat/test-paginate_listing.R b/tests/testthat/test-paginate_listing.R index c9c6bca0..6afed42d 100644 --- a/tests/testthat/test-paginate_listing.R +++ b/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 diff --git a/vignettes/ref_footnotes.Rmd b/vignettes/ref_footnotes.Rmd index f8049a6f..fe50f07c 100644 --- a/vignettes/ref_footnotes.Rmd +++ b/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