From 0562ff191095195d62b9f508bd708810db2e4d9b Mon Sep 17 00:00:00 2001 From: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Date: Thu, 7 Nov 2024 15:22:43 +0530 Subject: [PATCH 1/2] Modify the print for modules to contain more information (#1401) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Closes #1378 Example code to test the format: ```r devtools::load_all("teal") custom_module <- function(label = "label", ui_args = NULL, server_args = NULL, datanames = "all", transformers = list(), bk = FALSE) { ans <- module( label, server = function(id, data, ...) { moduleServer(id, function(input, output, session) { }) }, ui = function(id, ...) { }, datanames = datanames, transformers = transformers, ui_args = ui_args, server_args = server_args ) attr(ans, "teal_bookmarkable") <- bk ans } dummy_transformer <- teal_transform_module( label = "Dummy Transform", ui = function(id) div("(does nothing)"), server = function(id, data) { moduleServer(id, function(input, output, session) data) } ) plot_transformer <- teal_transform_module( label = "Plot Settings", ui = function(id) div("(does nothing)"), server = function(id, data) { moduleServer(id, function(input, output, session) data) } ) complete_modules <- modules( custom_module( label = "Data Overview", datanames = c("ADSL", "ADAE", "ADVS"), ui_args = list( view_type = "table", page_size = 10, filters = c("ARM", "SEX", "RACE") ), server_args = list( cache = TRUE, debounce = 1000 ), transformers = list(dummy_transformer), bk = TRUE ), modules( label = "Nested 1", custom_module( label = "Interactive Plots", datanames = c("ADSL", "ADVS"), ui_args = list( plot_type = c("scatter", "box", "line"), height = 600, width = 800, color_scheme = "viridis" ), server_args = list( render_type = "svg", cache_plots = TRUE ), transformers = list(dummy_transformer, plot_transformer), bk = TRUE ), modules( label = "Nested 2", custom_module( label = "Summary Statistics", datanames = "ADSL", ui_args = list( stats = c("mean", "median", "sd", "range"), grouping = c("ARM", "SEX") ) ), modules( label = "Labeled nested modules", custom_module( label = "Subgroup Analysis", datanames = c("ADSL", "ADAE"), ui_args = list( subgroups = c("AGE", "SEX", "RACE"), analysis_type = "stratified" ), bk = TRUE ) ), modules(custom_module(label = "Subgroup Analysis in non-labled modules")) ) ), custom_module("Non-nested module") ) complete_modules ``` ```r > complete_modules TEAL ROOT ├─ Data Overview │ ├─ Data Sources: ADSL, ADAE, ADVS │ ├─ Properties: │ │ ├─ Bookmarkable: Yes │ │ └─ Reportable: No │ ├─ UI Arguments: view_type, page_size, filters │ ├─ Server Arguments: cache, debounce │ └─ Transformers: Dummy Transform ├─ Nested 1 │ ├─ Interactive Plots │ │ ├─ Data Sources: ADSL, ADVS │ │ ├─ Properties: │ │ │ ├─ Bookmarkable: Yes │ │ │ └─ Reportable: No │ │ ├─ UI Arguments: plot_type, height, width, color_scheme │ │ ├─ Server Arguments: render_type, cache_plots │ │ └─ Transformers: Dummy Transform, Plot Settings │ └─ Nested 2 │ ├─ Summary Statistics │ │ ├─ Data Sources: ADSL │ │ ├─ Properties: │ │ │ ├─ Bookmarkable: No │ │ │ └─ Reportable: No │ │ ├─ UI Arguments: stats, grouping │ │ ├─ Server Arguments: ─ none │ │ └─ Transformers: ─ none │ ├─ Labeled nested modules │ │ └─ Subgroup Analysis │ │ ├─ Data Sources: ADSL, ADAE │ │ ├─ Properties: │ │ │ ├─ Bookmarkable: Yes │ │ │ └─ Reportable: No │ │ ├─ UI Arguments: subgroups, analysis_type │ │ ├─ Server Arguments: ─ none │ │ └─ Transformers: ─ none │ └─ root │ └─ Subgroup Analysis in non-labled modules │ ├─ Data Sources: all │ ├─ Properties: │ │ ├─ Bookmarkable: No │ │ └─ Reportable: No │ ├─ UI Arguments: ─ none │ ├─ Server Arguments: ─ none │ └─ Transformers: ─ none └─ Non-nested module ├─ Data Sources: all ├─ Properties: │ ├─ Bookmarkable: No │ └─ Reportable: No ├─ UI Arguments: ─ none ├─ Server Arguments: ─ none └─ Transformers: ─ none ``` --------- Signed-off-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> --- .pre-commit-config.yaml | 5 +- DESCRIPTION | 3 +- R/modules.R | 273 ++++++++++++++++++++++++++++++++-- R/utils.R | 4 + inst/WORDLIST | 2 + man/teal_modules.Rd | 138 ++++++++++++++++- tests/testthat/test-modules.R | 4 +- 7 files changed, 402 insertions(+), 27 deletions(-) diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index cc3d83e961..3e1cc7600e 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -10,8 +10,8 @@ repos: hooks: - id: style-files name: Style code with `styler` - args: [--style_pkg=styler, --style_fun=tidyverse_style, - --cache-root=styler] + args: + [--style_pkg=styler, --style_fun=tidyverse_style, --cache-root=styler] - id: roxygenize name: Regenerate package documentation additional_dependencies: @@ -19,6 +19,7 @@ repos: - davidgohel/gdtools # for flextable - mirai - checkmate + - crayon - jsonlite - lifecycle - logger diff --git a/DESCRIPTION b/DESCRIPTION index 2b5b4335c7..cd87356e03 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,6 +41,7 @@ Depends: teal.slice (>= 0.5.1.9009) Imports: checkmate (>= 2.1.0), + crayon, jsonlite, lifecycle (>= 0.2.0), logger (>= 0.2.0), @@ -75,7 +76,7 @@ RdMacros: lifecycle Config/Needs/verdepcheck: rstudio/shiny, insightsengineering/teal.data, insightsengineering/teal.slice, mllg/checkmate, jeroen/jsonlite, - r-lib/lifecycle, daroczig/logger, shikokuchuo/mirai, + r-lib/lifecycle, daroczig/logger, shikokuchuo/mirai, r-lib/crayon, shikokuchuo/nanonext, rstudio/renv, r-lib/rlang, daattali/shinyjs, insightsengineering/teal.code, insightsengineering/teal.logger, insightsengineering/teal.reporter, insightsengineering/teal.widgets, diff --git a/R/modules.R b/R/modules.R index 59ad3e5d97..a021187e61 100644 --- a/R/modules.R +++ b/R/modules.R @@ -321,11 +321,263 @@ modules <- function(..., label = "root") { # printing methods ---- #' @rdname teal_modules +#' @param is_last (`logical(1)`) Whether this is the last item in its parent's children list. +#' Affects the tree branch character used (L- vs |-) +#' @param parent_prefix (`character(1)`) The prefix inherited from parent nodes, +#' used to maintain the tree structure in nested levels +#' @param is_root (`logical(1)`) Whether this is the root node of the tree. Only used in +#' format.teal_modules(). Determines whether to show "TEAL ROOT" header +#' @param what (`character`) Specifies which metadata to display. +#' Possible values: "datasets", "properties", "ui_args", "server_args", "transformers" +#' @examples +#' mod <- module( +#' label = "My Custom Module", +#' server = function(id, data, ...) {}, +#' ui = function(id, ...) {}, +#' datanames = c("ADSL", "ADTTE"), +#' transformers = list(), +#' ui_args = list(a = 1, b = "b"), +#' server_args = list(x = 5, y = list(p = 1)) +#' ) +#' cat(format(mod)) #' @export -format.teal_module <- function(x, indent = 0, ...) { - paste0(paste(rep(" ", indent), collapse = ""), "+ ", x$label, "\n", collapse = "") +format.teal_module <- function( + x, indent = 0, is_last = FALSE, parent_prefix = "", + what = c("datasets", "properties", "ui_args", "server_args", "transformers"), ...) { + empty_text <- "" + branch <- if (is_last) "L-" else "|-" + current_prefix <- paste0(parent_prefix, branch, " ") + content_prefix <- paste0(parent_prefix, if (is_last) " " else "| ") + + format_list <- function(lst, empty = empty_text, label_width = 0) { + if (is.null(lst) || length(lst) == 0) { + empty + } else { + colon_space <- paste(rep(" ", label_width), collapse = "") + + first_item <- sprintf("%s (%s)", names(lst)[1], crayon::silver(class(lst[[1]])[1])) + rest_items <- if (length(lst) > 1) { + paste( + vapply( + names(lst)[-1], + function(name) { + sprintf( + "%s%s (%s)", + paste0(content_prefix, "| ", colon_space), + name, + crayon::silver(class(lst[[name]])[1]) + ) + }, + character(1) + ), + collapse = "\n" + ) + } + if (length(lst) > 1) paste0(first_item, "\n", rest_items) else first_item + } + } + + bookmarkable <- isTRUE(attr(x, "teal_bookmarkable")) + reportable <- "reporter" %in% names(formals(x$server)) + + transformers <- if (length(x$transformers) > 0) { + paste(sapply(x$transformers, function(t) attr(t, "label")), collapse = ", ") + } else { + empty_text + } + + output <- pasten(current_prefix, crayon::bgWhite(x$label)) + + if ("datasets" %in% what) { + output <- paste0( + output, + content_prefix, "|- ", crayon::yellow("Datasets : "), paste(x$datanames, collapse = ", "), "\n" + ) + } + if ("properties" %in% what) { + output <- paste0( + output, + content_prefix, "|- ", crayon::blue("Properties:"), "\n", + content_prefix, "| |- ", crayon::cyan("Bookmarkable : "), bookmarkable, "\n", + content_prefix, "| L- ", crayon::cyan("Reportable : "), reportable, "\n" + ) + } + if ("ui_args" %in% what) { + ui_args_formatted <- format_list(x$ui_args, label_width = 19) + output <- paste0( + output, + content_prefix, "|- ", crayon::green("UI Arguments : "), ui_args_formatted, "\n" + ) + } + if ("server_args" %in% what) { + server_args_formatted <- format_list(x$server_args, label_width = 19) + output <- paste0( + output, + content_prefix, "|- ", crayon::green("Server Arguments : "), server_args_formatted, "\n" + ) + } + if ("transformers" %in% what) { + output <- paste0( + output, + content_prefix, "L- ", crayon::magenta("Transformers : "), transformers, "\n" + ) + } + + output } +#' @rdname teal_modules +#' @examples +#' custom_module <- function( +#' label = "label", ui_args = NULL, server_args = NULL, +#' datanames = "all", transformers = list(), bk = FALSE) { +#' ans <- module( +#' label, +#' server = function(id, data, ...) {}, +#' ui = function(id, ...) { +#' }, +#' datanames = datanames, +#' transformers = transformers, +#' ui_args = ui_args, +#' server_args = server_args +#' ) +#' attr(ans, "teal_bookmarkable") <- bk +#' ans +#' } +#' +#' dummy_transformer <- teal_transform_module( +#' label = "Dummy Transform", +#' ui = function(id) div("(does nothing)"), +#' server = function(id, data) { +#' moduleServer(id, function(input, output, session) data) +#' } +#' ) +#' +#' plot_transformer <- teal_transform_module( +#' label = "Plot Settings", +#' ui = function(id) div("(does nothing)"), +#' server = function(id, data) { +#' moduleServer(id, function(input, output, session) data) +#' } +#' ) +#' +#' complete_modules <- modules( +#' custom_module( +#' label = "Data Overview", +#' datanames = c("ADSL", "ADAE", "ADVS"), +#' ui_args = list( +#' view_type = "table", +#' page_size = 10, +#' filters = c("ARM", "SEX", "RACE") +#' ), +#' server_args = list( +#' cache = TRUE, +#' debounce = 1000 +#' ), +#' transformers = list(dummy_transformer), +#' bk = TRUE +#' ), +#' modules( +#' label = "Nested 1", +#' custom_module( +#' label = "Interactive Plots", +#' datanames = c("ADSL", "ADVS"), +#' ui_args = list( +#' plot_type = c("scatter", "box", "line"), +#' height = 600, +#' width = 800, +#' color_scheme = "viridis" +#' ), +#' server_args = list( +#' render_type = "svg", +#' cache_plots = TRUE +#' ), +#' transformers = list(dummy_transformer, plot_transformer), +#' bk = TRUE +#' ), +#' modules( +#' label = "Nested 2", +#' custom_module( +#' label = "Summary Statistics", +#' datanames = "ADSL", +#' ui_args = list( +#' stats = c("mean", "median", "sd", "range"), +#' grouping = c("ARM", "SEX") +#' ) +#' ), +#' modules( +#' label = "Labeled nested modules", +#' custom_module( +#' label = "Subgroup Analysis", +#' datanames = c("ADSL", "ADAE"), +#' ui_args = list( +#' subgroups = c("AGE", "SEX", "RACE"), +#' analysis_type = "stratified" +#' ), +#' bk = TRUE +#' ) +#' ), +#' modules(custom_module(label = "Subgroup Analysis in non-labled modules")) +#' ) +#' ), +#' custom_module("Non-nested module") +#' ) +#' +#' cat(format(complete_modules)) +#' cat(format(complete_modules, what = c("ui_args", "server_args", "transformers"))) +#' @export +format.teal_modules <- function(x, indent = 0, is_root = TRUE, is_last = FALSE, parent_prefix = "", ...) { + if (is_root) { + header <- pasten(crayon::bold("TEAL ROOT")) + new_parent_prefix <- " " #' Initial indent for root level + } else { + if (!is.null(x$label)) { + branch <- if (is_last) "L-" else "|-" + header <- pasten(parent_prefix, branch, " ", crayon::bold(x$label)) + new_parent_prefix <- paste0(parent_prefix, if (is_last) " " else "| ") + } else { + header <- "" + new_parent_prefix <- parent_prefix + } + } + + if (length(x$children) > 0) { + children_output <- character(0) + n_children <- length(x$children) + + for (i in seq_along(x$children)) { + child <- x$children[[i]] + is_last_child <- (i == n_children) + + if (inherits(child, "teal_modules")) { + children_output <- c( + children_output, + format(child, + indent = indent, + is_root = FALSE, + is_last = is_last_child, + parent_prefix = new_parent_prefix, + ... + ) + ) + } else { + children_output <- c( + children_output, + format(child, + indent = indent, + is_last = is_last_child, + parent_prefix = new_parent_prefix, + ... + ) + ) + } + } + + paste0(header, paste(children_output, collapse = "")) + } else { + header + } +} #' @rdname teal_modules #' @export @@ -334,17 +586,11 @@ print.teal_module <- function(x, ...) { invisible(x) } - #' @rdname teal_modules #' @export -format.teal_modules <- function(x, indent = 0, ...) { - paste( - c( - paste0(rep(" ", indent), "+ ", x$label, "\n"), - unlist(lapply(x$children, format, indent = indent + 1, ...)) - ), - collapse = "" - ) +print.teal_modules <- function(x, ...) { + cat(format(x, ...)) + invisible(x) } #' @param modules (`teal_module` or `teal_modules`) @@ -380,11 +626,6 @@ set_datanames <- function(modules, datanames) { modules } -#' @rdname teal_modules -#' @export -print.teal_modules <- print.teal_module - - # utilities ---- ## subset or modify modules ---- diff --git a/R/utils.R b/R/utils.R index 345350fe0d..312d3a5f73 100644 --- a/R/utils.R +++ b/R/utils.R @@ -377,6 +377,10 @@ strip_style <- function(string) { ) } +#' @keywords internal +#' @noRd +pasten <- function(...) paste0(..., "\n") + #' Convert character list to human readable html with commas and "and" #' @noRd paste_datanames_character <- function(x, diff --git a/inst/WORDLIST b/inst/WORDLIST index 5bb4a5bf45..77ac78fdfb 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -8,6 +8,7 @@ Reproducibility TLG UI UX +args bookmarkable cloneable customizable @@ -26,4 +27,5 @@ summarization tabset themer theming +ui uncheck diff --git a/man/teal_modules.Rd b/man/teal_modules.Rd index b763c01513..486682e5e6 100644 --- a/man/teal_modules.Rd +++ b/man/teal_modules.Rd @@ -6,10 +6,10 @@ \alias{teal_module} \alias{modules} \alias{format.teal_module} -\alias{print.teal_module} \alias{format.teal_modules} -\alias{set_datanames} +\alias{print.teal_module} \alias{print.teal_modules} +\alias{set_datanames} \title{Create \code{teal_module} and \code{teal_modules} objects} \usage{ module( @@ -26,15 +26,22 @@ module( modules(..., label = "root") -\method{format}{teal_module}(x, indent = 0, ...) +\method{format}{teal_module}( + x, + indent = 0, + is_last = FALSE, + parent_prefix = "", + what = c("datasets", "properties", "ui_args", "server_args", "transformers"), + ... +) + +\method{format}{teal_modules}(x, indent = 0, is_root = TRUE, is_last = FALSE, parent_prefix = "", ...) \method{print}{teal_module}(x, ...) -\method{format}{teal_modules}(x, indent = 0, ...) +\method{print}{teal_modules}(x, ...) set_datanames(modules, datanames) - -\method{print}{teal_modules}(x, ...) } \arguments{ \item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group. @@ -93,6 +100,18 @@ Transformers' \code{datanames} are added to the \code{datanames}. See \code{\lin \item{indent}{(\code{integer(1)}) Indention level; each nested element is indented one level more.} +\item{is_last}{(\code{logical(1)}) Whether this is the last item in its parent's children list. +Affects the tree branch character used (L- vs |-)} + +\item{parent_prefix}{(\code{character(1)}) The prefix inherited from parent nodes, +used to maintain the tree structure in nested levels} + +\item{what}{(\code{character}) Specifies which metadata to display. +Possible values: "datasets", "properties", "ui_args", "server_args", "transformers"} + +\item{is_root}{(\code{logical(1)}) Whether this is the root node of the tree. Only used in +format.teal_modules(). Determines whether to show "TEAL ROOT" header} + \item{modules}{(\code{teal_module} or \code{teal_modules})} } \value{ @@ -205,6 +224,113 @@ app <- init( if (interactive()) { shinyApp(app$ui, app$server) } +mod <- module( + label = "My Custom Module", + server = function(id, data, ...) {}, + ui = function(id, ...) {}, + datanames = c("ADSL", "ADTTE"), + transformers = list(), + ui_args = list(a = 1, b = "b"), + server_args = list(x = 5, y = list(p = 1)) +) +cat(format(mod)) +custom_module <- function( + label = "label", ui_args = NULL, server_args = NULL, + datanames = "all", transformers = list(), bk = FALSE) { + ans <- module( + label, + server = function(id, data, ...) {}, + ui = function(id, ...) { + }, + datanames = datanames, + transformers = transformers, + ui_args = ui_args, + server_args = server_args + ) + attr(ans, "teal_bookmarkable") <- bk + ans +} + +dummy_transformer <- teal_transform_module( + label = "Dummy Transform", + ui = function(id) div("(does nothing)"), + server = function(id, data) { + moduleServer(id, function(input, output, session) data) + } +) + +plot_transformer <- teal_transform_module( + label = "Plot Settings", + ui = function(id) div("(does nothing)"), + server = function(id, data) { + moduleServer(id, function(input, output, session) data) + } +) + +complete_modules <- modules( + custom_module( + label = "Data Overview", + datanames = c("ADSL", "ADAE", "ADVS"), + ui_args = list( + view_type = "table", + page_size = 10, + filters = c("ARM", "SEX", "RACE") + ), + server_args = list( + cache = TRUE, + debounce = 1000 + ), + transformers = list(dummy_transformer), + bk = TRUE + ), + modules( + label = "Nested 1", + custom_module( + label = "Interactive Plots", + datanames = c("ADSL", "ADVS"), + ui_args = list( + plot_type = c("scatter", "box", "line"), + height = 600, + width = 800, + color_scheme = "viridis" + ), + server_args = list( + render_type = "svg", + cache_plots = TRUE + ), + transformers = list(dummy_transformer, plot_transformer), + bk = TRUE + ), + modules( + label = "Nested 2", + custom_module( + label = "Summary Statistics", + datanames = "ADSL", + ui_args = list( + stats = c("mean", "median", "sd", "range"), + grouping = c("ARM", "SEX") + ) + ), + modules( + label = "Labeled nested modules", + custom_module( + label = "Subgroup Analysis", + datanames = c("ADSL", "ADAE"), + ui_args = list( + subgroups = c("AGE", "SEX", "RACE"), + analysis_type = "stratified" + ), + bk = TRUE + ) + ), + modules(custom_module(label = "Subgroup Analysis in non-labled modules")) + ) + ), + custom_module("Non-nested module") +) + +cat(format(complete_modules)) +cat(format(complete_modules, what = c("ui_args", "server_args", "transformers"))) # change the module's datanames set_datanames(module(datanames = "all"), "a") diff --git a/tests/testthat/test-modules.R b/tests/testthat/test-modules.R index 9085f76462..b1658af98c 100644 --- a/tests/testthat/test-modules.R +++ b/tests/testthat/test-modules.R @@ -508,8 +508,8 @@ testthat::test_that("format.teal_modules returns proper structure", { appended_mods <- append_module(mods, mod3) testthat::expect_equal( - format(appended_mods), - "+ c\n + a\n + c\n + c\n" + gsub("\033\\[[0-9;]*m", "", format(appended_mods)), + "TEAL ROOT\n |- a\n | |- Datasets : all\n | |- Properties:\n | | |- Bookmarkable : FALSE\n | | L- Reportable : FALSE\n | |- UI Arguments : \n | |- Server Arguments : \n | L- Transformers : \n |- c\n | |- Datasets : all\n | |- Properties:\n | | |- Bookmarkable : FALSE\n | | L- Reportable : FALSE\n | |- UI Arguments : \n | |- Server Arguments : \n | L- Transformers : \n L- c\n |- Datasets : all\n |- Properties:\n | |- Bookmarkable : FALSE\n | L- Reportable : FALSE\n |- UI Arguments : \n |- Server Arguments : \n L- Transformers : \n" # nolint: line_length ) }) From a994f716a2c9b6696c0e6f7115c00299ce02520c Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 7 Nov 2024 09:53:41 +0000 Subject: [PATCH 2/2] [skip actions] Bump version to 0.15.2.9081 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index cd87356e03..8f33815491 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9080 -Date: 2024-11-06 +Version: 0.15.2.9081 +Date: 2024-11-07 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), diff --git a/NEWS.md b/NEWS.md index 55d7d9f4ce..4ec0f426fd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9080 +# teal 0.15.2.9081 ### New features