From 6c115acb0e529abae5f587d21968459c8cd2931c Mon Sep 17 00:00:00 2001 From: benoit Date: Fri, 5 Apr 2024 11:18:32 +0200 Subject: [PATCH 1/8] split listings --- NAMESPACE | 1 + NEWS.md | 2 +- R/ael01_nollt.R | 24 +++++++++++++++++++----- R/utils.R | 14 ++++++++++++++ _pkgdown.yaml | 1 + man/ael01_nollt.Rd | 4 ++-- man/rl_list.Rd | 17 +++++++++++++++++ tests/testthat/test-ael01_nollt.R | 15 +++++++++++++++ tests/testthat/test-utils.R | 27 +++++++++++++++++++++++++++ 9 files changed, 97 insertions(+), 8 deletions(-) create mode 100644 man/rl_list.Rd diff --git a/NAMESPACE b/NAMESPACE index 420ff96345..9ffb66ae20 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -175,6 +175,7 @@ export(postprocess) export(preprocess) export(reformat) export(report_null) +export(rl_list) export(rmpt01) export(rmpt01_main) export(rmpt01_post) diff --git a/NEWS.md b/NEWS.md index fccecec02e..ae315d05ca 100644 --- a/NEWS.md +++ b/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 diff --git a/R/ael01_nollt.R b/R/ael01_nollt.R index 74f2f5e007..ce8b0ec0da 100644 --- a/R/ael01_nollt.R +++ b/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")) { + do_call(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 } diff --git a/R/utils.R b/R/utils.R index a411a03358..093c7bc46f 100755 --- a/R/utils.R +++ b/R/utils.R @@ -137,6 +137,20 @@ gg_list <- function(...) { ) } +#' List of `rlistings` object +#' +#' @param ... (`rlistings`) objects. +#' @returns a `rl_list` object. +#' @export +rl_list <- function(...) { + ret <- list(...) + assert_list(ret, types = c("listing_df")) + structure( + ret, + class = c("rl_list", "list") + ) +} + #' @export droplevels.character <- function(x, ...) { x diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 47bac6424f..c282c565d2 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -115,6 +115,7 @@ reference: - smart_prune - var_labels_for - gg_list + - rl_list - gg_theme_chevron - grob_list - h_format_dec diff --git a/man/ael01_nollt.Rd b/man/ael01_nollt.Rd index 55400b4ef4..243e152328 100644 --- a/man/ael01_nollt.Rd +++ b/man/ael01_nollt.Rd @@ -51,12 +51,12 @@ Key columns allow you to group repeat occurrences.} \item{unique_rows}{(\code{flag}) whether to keep only unique rows in listing.} -\item{...}{not used.} +\item{...}{additional arguments passed to \code{\link[rlistings:listings]{rlistings::as_listing}}.} \item{tlg}{(\code{TableTree}, \code{Listing} or \code{ggplot}) object typically produced by a \code{main} function.} } \value{ -the main function returns an \code{rlistings} object. +the main function returns an \code{rlistings} or a \code{rl_list} object. the preprocessing function returns a \code{list} of \code{data.frame}. diff --git a/man/rl_list.Rd b/man/rl_list.Rd new file mode 100644 index 0000000000..428b4f8c6b --- /dev/null +++ b/man/rl_list.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{rl_list} +\alias{rl_list} +\title{List of \code{rlistings} object} +\usage{ +rl_list(...) +} +\arguments{ +\item{...}{(\code{rlistings}) objects.} +} +\value{ +a \code{rl_list} object. +} +\description{ +List of \code{rlistings} object +} diff --git a/tests/testthat/test-ael01_nollt.R b/tests/testthat/test-ael01_nollt.R index 21092562e9..83f5ddbd14 100644 --- a/tests/testthat/test-ael01_nollt.R +++ b/tests/testthat/test-ael01_nollt.R @@ -47,3 +47,18 @@ 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, type = "listing_df") + expect_snapshot(cat(export_as_txt(res, lpp = 100))) +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index dd9fe4c19e..1b9f1e3e54 100755 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -293,3 +293,30 @@ test_that("get_section_div works", { expect_identical(get_section_div(), c("", NA_character_, "")) ) }) + +# gg_list ---- + +test_that("gg_list works as expected", { + p <- ggplot(mtcars, aes(x = hp, y = mpg)) + + geom_point() + p_ls <- list(a = p, b = p) + + res <- expect_silent(gg_list(p)) + expect_class(res, "gg_list") + + res <- expect_silent(do_call(gg_list, p_ls)) + expect_class(res, "gg_list") +}) + +# rl_list ---- + +test_that("rl_list works as expected", { + l <- as_listing(iris, key_cols = "Species") + l_ls <- list(a = l, b = l) + + res <- expect_silent(rl_list(l)) + expect_class(res, "rl_list") + + res <- expect_silent(do_call(rl_list, l_ls)) + expect_class(res, "rl_list") +}) From e3c1632cf167a5bb0e217d86e0daf14ecfe0034c Mon Sep 17 00:00:00 2001 From: benoit Date: Thu, 18 Apr 2024 17:08:38 +0200 Subject: [PATCH 2/8] liming's suggestions --- NAMESPACE | 6 +++ R/ael01_nollt.R | 2 +- R/mng01.R | 2 +- R/utils.R | 57 ++++++++++++++++++++++++++++ man/gg_list.Rd | 12 ++++++ man/rl_list.Rd | 20 +++++++++- tests/testthat/_snaps/ael01_nollt.md | 26 +++++++++++++ tests/testthat/test-ael01_nollt.R | 2 +- tests/testthat/test-utils.R | 4 +- 9 files changed, 125 insertions(+), 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 9ffb66ae20..31025b9278 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/ael01_nollt.R b/R/ael01_nollt.R index ce8b0ec0da..9d779b0db9 100644 --- a/R/ael01_nollt.R +++ b/R/ael01_nollt.R @@ -49,7 +49,7 @@ ael01_nollt_main <- function(adam_db, ) if (is(ret, "list")) { - do_call(rl_list, ret) + as.rl_list(ret) } else { ret } diff --git a/R/mng01.R b/R/mng01.R index 4f681a8808..5a58196011 100755 --- a/R/mng01.R +++ b/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 diff --git a/R/utils.R b/R/utils.R index 093c7bc46f..79bb900638 100755 --- a/R/utils.R +++ b/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,10 +140,38 @@ 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) { + 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(...) @@ -151,6 +182,32 @@ rl_list <- function(...) { ) } +#' Convert Object to List of `rl_list`. +#' +#' @param obj (`rlisting` or `list` of `rlistings`) +#' @return a `rl_list` object. +#' @rdname rl_list +#' +#' @export +as.rl_list <- function(obj) { + 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 diff --git a/man/gg_list.Rd b/man/gg_list.Rd index eff76d6d48..2ea4bf6caa 100644 --- a/man/gg_list.Rd +++ b/man/gg_list.Rd @@ -2,16 +2,28 @@ % Please edit documentation in R/utils.R \name{gg_list} \alias{gg_list} +\alias{as.gg_list} +\alias{as.gg_list.list} \title{List of \code{gg} object} \usage{ gg_list(...) + +as.gg_list(obj) + +\method{as.gg_list}{list}(obj) } \arguments{ \item{...}{(\code{ggplot}) objects.} + +\item{obj}{(\code{ggplot} or \code{list} of \code{ggplot})} } \value{ +a \code{gg_list} object. + a \code{gg_list} object. } \description{ List of \code{gg} object + +Convert Object to List of \code{gg_list}. } diff --git a/man/rl_list.Rd b/man/rl_list.Rd index 428b4f8c6b..4d01b51dcc 100644 --- a/man/rl_list.Rd +++ b/man/rl_list.Rd @@ -1,17 +1,35 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R -\name{rl_list} +\name{as.gg_list.ggplot} +\alias{as.gg_list.ggplot} \alias{rl_list} +\alias{as.rl_list} +\alias{as.rl_list.list} +\alias{as.rl_list.listing_df} \title{List of \code{rlistings} object} \usage{ +\method{as.gg_list}{ggplot}(obj) + rl_list(...) + +as.rl_list(obj) + +\method{as.rl_list}{list}(obj) + +\method{as.rl_list}{listing_df}(obj) } \arguments{ +\item{obj}{(\code{rlisting} or \code{list} of \code{rlistings})} + \item{...}{(\code{rlistings}) objects.} } \value{ +a \code{rl_list} object. + a \code{rl_list} object. } \description{ List of \code{rlistings} object + +Convert Object to List of \code{rl_list}. } diff --git a/tests/testthat/_snaps/ael01_nollt.md b/tests/testthat/_snaps/ael01_nollt.md index d3cacb82ad..a485a2899f 100644 --- a/tests/testthat/_snaps/ael01_nollt.md +++ b/tests/testthat/_snaps/ael01_nollt.md @@ -63,3 +63,29 @@ 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 + diff --git a/tests/testthat/test-ael01_nollt.R b/tests/testthat/test-ael01_nollt.R index 83f5ddbd14..f58356817d 100644 --- a/tests/testthat/test-ael01_nollt.R +++ b/tests/testthat/test-ael01_nollt.R @@ -59,6 +59,6 @@ test_that("ael01_nollt listing can be split by an additional variable", { split_into_pages_by_var = "SEX" ) ) - expect_list(res, type = "listing_df") + expect_list(res, types = "listing_df") expect_snapshot(cat(export_as_txt(res, lpp = 100))) }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 1b9f1e3e54..c8276421cb 100755 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -297,8 +297,8 @@ test_that("get_section_div works", { # gg_list ---- test_that("gg_list works as expected", { - p <- ggplot(mtcars, aes(x = hp, y = mpg)) + - geom_point() + p <- ggplot2::ggplot(mtcars, ggplot2::aes(x = hp, y = mpg)) + + ggplot2::geom_point() p_ls <- list(a = p, b = p) res <- expect_silent(gg_list(p)) From d62ed883f89d8ec7b6807984034122a141bc774f Mon Sep 17 00:00:00 2001 From: benoit Date: Thu, 18 Apr 2024 17:30:32 +0200 Subject: [PATCH 3/8] linter --- R/utils.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 79bb900638..db1845b4ed 100755 --- a/R/utils.R +++ b/R/utils.R @@ -147,7 +147,7 @@ gg_list <- function(...) { #' @rdname gg_list #' #' @export -as.gg_list <- function(obj) { +as.gg_list <- function(obj) { # nolint UseMethod("as.gg_list") } @@ -189,7 +189,7 @@ rl_list <- function(...) { #' @rdname rl_list #' #' @export -as.rl_list <- function(obj) { +as.rl_list <- function(obj) { # nolint UseMethod("as.rl_list") } From df778b5f257d05e25356cb37fdf519155c2f42ce Mon Sep 17 00:00:00 2001 From: benoit Date: Thu, 18 Apr 2024 17:31:02 +0200 Subject: [PATCH 4/8] update test --- tests/testthat/test-ael01_nollt.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ael01_nollt.R b/tests/testthat/test-ael01_nollt.R index f58356817d..a27ebb1509 100644 --- a/tests/testthat/test-ael01_nollt.R +++ b/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", { From a6a5220e9a65839307b6d7fe314f83b1ba78b11d Mon Sep 17 00:00:00 2001 From: benoit Date: Thu, 18 Apr 2024 18:05:13 +0200 Subject: [PATCH 5/8] add tests --- tests/testthat/_snaps/ael01_nollt.md | 21 +++++++++++++++++++++ tests/testthat/test-ael01_nollt.R | 18 ++++++++++++++++++ tests/testthat/test-utils.R | 27 +++++++++++++++++++++++++-- 3 files changed, 64 insertions(+), 2 deletions(-) diff --git a/tests/testthat/_snaps/ael01_nollt.md b/tests/testthat/_snaps/ael01_nollt.md index a485a2899f..1f3f95050b 100644 --- a/tests/testthat/_snaps/ael01_nollt.md +++ b/tests/testthat/_snaps/ael01_nollt.md @@ -89,3 +89,24 @@ 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 + diff --git a/tests/testthat/test-ael01_nollt.R b/tests/testthat/test-ael01_nollt.R index a27ebb1509..54bbb34a18 100644 --- a/tests/testthat/test-ael01_nollt.R +++ b/tests/testthat/test-ael01_nollt.R @@ -62,3 +62,21 @@ test_that("ael01_nollt listing can be split by an additional variable", { 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))) +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index c8276421cb..079985c9dc 100755 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -304,7 +304,19 @@ test_that("gg_list works as expected", { res <- expect_silent(gg_list(p)) expect_class(res, "gg_list") - res <- expect_silent(do_call(gg_list, p_ls)) + res <- expect_silent(do.call(gg_list, p_ls)) + expect_class(res, "gg_list") +}) + +test_that("as.gg_list works as expected", { + p <- ggplot2::ggplot(mtcars, ggplot2::aes(x = hp, y = mpg)) + + ggplot2::geom_point() + p_ls <- list(a = p, b = p) + + res <- expect_silent(as.gg_list(p)) + expect_class(res, "gg_list") + + res <- expect_silent(as.gg_list(p_ls)) expect_class(res, "gg_list") }) @@ -317,6 +329,17 @@ test_that("rl_list works as expected", { res <- expect_silent(rl_list(l)) expect_class(res, "rl_list") - res <- expect_silent(do_call(rl_list, l_ls)) + res <- expect_silent(do.call(rl_list, l_ls)) + expect_class(res, "rl_list") +}) + +test_that("as.rl_list works as expected", { + l <- as_listing(iris, key_cols = "Species") + l_ls <- list(a = l, b = l) + + res <- expect_silent(as.rl_list(l)) + expect_class(res, "rl_list") + + res <- expect_silent(as.rl_list(l_ls)) expect_class(res, "rl_list") }) From 7aea77f1a2f0b5e1a0f49e1d7788b2b4e604f975 Mon Sep 17 00:00:00 2001 From: benoit Date: Thu, 18 Apr 2024 18:32:55 +0200 Subject: [PATCH 6/8] update doc --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index db1845b4ed..befbca54bc 100755 --- a/R/utils.R +++ b/R/utils.R @@ -185,7 +185,7 @@ rl_list <- function(...) { #' Convert Object to List of `rl_list`. #' #' @param obj (`rlisting` or `list` of `rlistings`) -#' @return a `rl_list` object. +#' @returns a `rl_list` object. #' @rdname rl_list #' #' @export From c504254b68207ce4e0718b3d5dd8d9a7dbb81cc1 Mon Sep 17 00:00:00 2001 From: benoit Date: Fri, 19 Apr 2024 13:58:34 +0200 Subject: [PATCH 7/8] liming's suggestion --- R/utils.R | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/R/utils.R b/R/utils.R index befbca54bc..d7da99f127 100755 --- a/R/utils.R +++ b/R/utils.R @@ -155,13 +155,19 @@ as.gg_list <- function(obj) { # nolint #' @export as.gg_list.list <- function(obj) { assert_list(obj, types = "ggplot") - do_call(gg_list, obj) + structure( + obj, + class = c("gg_list", "list") + ) } #' @rdname rl_list #' @export as.gg_list.ggplot <- function(obj) { - do_call(gg_list, list(obj)) + structure( + list(obj), + class = c("gg_list", "list") + ) } # rl_list ---- @@ -197,13 +203,19 @@ as.rl_list <- function(obj) { # nolint #' @export as.rl_list.list <- function(obj) { assert_list(obj, types = "listing_df") - do_call(rl_list, obj) + structure( + obj, + class = c("rl_list", "list") + ) } #' @rdname rl_list #' @export as.rl_list.listing_df <- function(obj) { - do_call(rl_list, list(obj)) + structure( + list(obj), + class = c("rl_list", "list") + ) } # lvl ---- From bfd43d4887e367842cdfea90577766b530fb43ec Mon Sep 17 00:00:00 2001 From: Liming <36079400+clarkliming@users.noreply.github.com> Date: Tue, 23 Apr 2024 21:15:48 +0800 Subject: [PATCH 8/8] use list of objects (#741) make minor modification on the program to allow simpler usage (use list directly for listings, can this can already support list of rtables) --------- Co-authored-by: benoit --- NAMESPACE | 7 -- NEWS.md | 1 + R/ael01_nollt.R | 12 +--- R/mng01.R | 5 +- R/utils.R | 135 +++++++----------------------------- _pkgdown.yaml | 8 +-- man/ael01_nollt.Rd | 2 +- man/gg_list.Rd | 14 +--- man/grob_list.Rd | 2 +- man/mng01.Rd | 2 +- man/rl_list.Rd | 35 ---------- tests/testthat/test-utils.R | 86 ++++++++--------------- 12 files changed, 69 insertions(+), 240 deletions(-) delete mode 100644 man/rl_list.Rd diff --git a/NAMESPACE b/NAMESPACE index 31025b9278..420ff96345 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,5 @@ # 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) @@ -51,8 +47,6 @@ 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) @@ -181,7 +175,6 @@ export(postprocess) export(preprocess) export(reformat) export(report_null) -export(rl_list) export(rmpt01) export(rmpt01_main) export(rmpt01_post) diff --git a/NEWS.md b/NEWS.md index ae315d05ca..94f765f173 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ * 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 diff --git a/R/ael01_nollt.R b/R/ael01_nollt.R index 9d779b0db9..9414a50802 100644 --- a/R/ael01_nollt.R +++ b/R/ael01_nollt.R @@ -7,7 +7,7 @@ #' @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`]. #' @param ... additional arguments passed to [`rlistings::as_listing`]. -#' @returns the main function returns an `rlistings` or a `rl_list` object. +#' @returns the main function returns an `rlistings` or a `list` object. #' #' @details #' * Removes duplicate rows. @@ -37,7 +37,7 @@ ael01_nollt_main <- function(adam_db, assert_list(col_formatting, null.ok = TRUE, types = "fmt_config", names = "unique") assert_flag(unique_rows) - ret <- execute_with_args( + execute_with_args( as_listing, df = adam_db[[dataset]], key_cols = key_cols, @@ -47,12 +47,6 @@ ael01_nollt_main <- function(adam_db, unique_rows = unique_rows, ... ) - - if (is(ret, "list")) { - as.rl_list(ret) - } else { - ret - } } #' @describeIn ael01_nollt Preprocessing @@ -82,7 +76,7 @@ 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 (is(tlg, "rl_list")) { + if (is(tlg, "list")) { if (length(tlg) == 0) tlg <- null_report } else { if (nrow(tlg) == 0) tlg <- null_report diff --git a/R/mng01.R b/R/mng01.R index 5a58196011..4ccb2bd258 100755 --- a/R/mng01.R +++ b/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), ... ) - as.gg_list(ret) } #' @describeIn mng01 Preprocessing diff --git a/R/utils.R b/R/utils.R index d7da99f127..71520e054f 100755 --- a/R/utils.R +++ b/R/utils.R @@ -109,115 +109,6 @@ 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") - ) -} - -# gg_list ---- - -#' List of `gg` object -#' -#' @param ... (`ggplot`) objects. -#' @returns a `gg_list` object. -#' @rdname gg_list -#' @export -gg_list <- function(...) { - ret <- list(...) - assert_list(ret, types = c("ggplot")) - structure( - ret, - class = c("gg_list", "list") - ) -} - -#' 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") - structure( - obj, - class = c("gg_list", "list") - ) -} - -#' @rdname rl_list -#' @export -as.gg_list.ggplot <- function(obj) { - structure( - list(obj), - class = c("gg_list", "list") - ) -} - -# 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") - structure( - obj, - class = c("rl_list", "list") - ) -} - -#' @rdname rl_list -#' @export -as.rl_list.listing_df <- function(obj) { - structure( - list(obj), - class = c("rl_list", "list") - ) -} - # lvl ---- #' @export @@ -473,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(...) +} diff --git a/_pkgdown.yaml b/_pkgdown.yaml index c282c565d2..b399669ade 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -114,10 +114,7 @@ reference: - report_null - smart_prune - var_labels_for - - gg_list - - rl_list - gg_theme_chevron - - grob_list - h_format_dec - lvls - convert_to_month @@ -129,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 diff --git a/man/ael01_nollt.Rd b/man/ael01_nollt.Rd index 243e152328..ff59d72096 100644 --- a/man/ael01_nollt.Rd +++ b/man/ael01_nollt.Rd @@ -56,7 +56,7 @@ Key columns allow you to group repeat occurrences.} \item{tlg}{(\code{TableTree}, \code{Listing} or \code{ggplot}) object typically produced by a \code{main} function.} } \value{ -the main function returns an \code{rlistings} or a \code{rl_list} object. +the main function returns an \code{rlistings} or a \code{list} object. the preprocessing function returns a \code{list} of \code{data.frame}. diff --git a/man/gg_list.Rd b/man/gg_list.Rd index 2ea4bf6caa..1827881ca3 100644 --- a/man/gg_list.Rd +++ b/man/gg_list.Rd @@ -2,28 +2,16 @@ % Please edit documentation in R/utils.R \name{gg_list} \alias{gg_list} -\alias{as.gg_list} -\alias{as.gg_list.list} \title{List of \code{gg} object} \usage{ gg_list(...) - -as.gg_list(obj) - -\method{as.gg_list}{list}(obj) } \arguments{ \item{...}{(\code{ggplot}) objects.} - -\item{obj}{(\code{ggplot} or \code{list} of \code{ggplot})} } \value{ -a \code{gg_list} object. - a \code{gg_list} object. } \description{ -List of \code{gg} object - -Convert Object to List of \code{gg_list}. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} } diff --git a/man/grob_list.Rd b/man/grob_list.Rd index a59d2ac43a..dbb92b0e48 100644 --- a/man/grob_list.Rd +++ b/man/grob_list.Rd @@ -13,5 +13,5 @@ grob_list(...) a \code{grob_list} object. } \description{ -List of \code{grob} object +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} } diff --git a/man/mng01.Rd b/man/mng01.Rd index 1f978aeb18..4ad00bf898 100644 --- a/man/mng01.Rd +++ b/man/mng01.Rd @@ -64,7 +64,7 @@ mng01 \item{...}{passed to \code{\link[tern:g_lineplot]{tern::g_lineplot()}}.} } \value{ -the main function returns a \code{gg_list} object. +the main function returns a \code{list} of \code{ggplot} objects. a list of \code{ggplot} objects. diff --git a/man/rl_list.Rd b/man/rl_list.Rd deleted file mode 100644 index 4d01b51dcc..0000000000 --- a/man/rl_list.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{as.gg_list.ggplot} -\alias{as.gg_list.ggplot} -\alias{rl_list} -\alias{as.rl_list} -\alias{as.rl_list.list} -\alias{as.rl_list.listing_df} -\title{List of \code{rlistings} object} -\usage{ -\method{as.gg_list}{ggplot}(obj) - -rl_list(...) - -as.rl_list(obj) - -\method{as.rl_list}{list}(obj) - -\method{as.rl_list}{listing_df}(obj) -} -\arguments{ -\item{obj}{(\code{rlisting} or \code{list} of \code{rlistings})} - -\item{...}{(\code{rlistings}) objects.} -} -\value{ -a \code{rl_list} object. - -a \code{rl_list} object. -} -\description{ -List of \code{rlistings} object - -Convert Object to List of \code{rl_list}. -} diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 079985c9dc..afac6872a7 100755 --- a/tests/testthat/test-utils.R +++ b/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", { @@ -294,52 +282,36 @@ test_that("get_section_div works", { ) }) -# gg_list ---- - -test_that("gg_list works as expected", { - p <- ggplot2::ggplot(mtcars, ggplot2::aes(x = hp, y = mpg)) + - ggplot2::geom_point() - p_ls <- list(a = p, b = p) - - res <- expect_silent(gg_list(p)) - expect_class(res, "gg_list") +# Deprecated Functions ---- - res <- expect_silent(do.call(gg_list, p_ls)) - expect_class(res, "gg_list") -}) - -test_that("as.gg_list works as expected", { - p <- ggplot2::ggplot(mtcars, ggplot2::aes(x = hp, y = mpg)) + - ggplot2::geom_point() - p_ls <- list(a = p, b = p) - - res <- expect_silent(as.gg_list(p)) - expect_class(res, "gg_list") - - res <- expect_silent(as.gg_list(p_ls)) - expect_class(res, "gg_list") -}) - -# rl_list ---- - -test_that("rl_list works as expected", { - l <- as_listing(iris, key_cols = "Species") - l_ls <- list(a = l, b = l) - - res <- expect_silent(rl_list(l)) - expect_class(res, "rl_list") - - res <- expect_silent(do.call(rl_list, l_ls)) - expect_class(res, "rl_list") +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("as.rl_list works as expected", { - l <- as_listing(iris, key_cols = "Species") - l_ls <- list(a = l, b = l) - - res <- expect_silent(as.rl_list(l)) - expect_class(res, "rl_list") - - res <- expect_silent(as.rl_list(l_ls)) - expect_class(res, "rl_list") +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 + ) + } + ) })