Add ability to set datanames (#824)

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: Dawid Kałędkowski <[email protected]>

DESCRIPTION

@@ -46,6 +46,7 @@ Imports:
     htmlwidgets (>= 1.6.4),
     jsonlite (>= 1.8.9),
     lattice (>= 0.18-4),
+    lifecycle (>= 0.2.0),
     MASS (>= 7.3-61),
     rlistings (>= 0.2.8),
     rtables (>= 0.6.8),
@@ -69,7 +70,6 @@ Imports:
     utils
 Suggests:
     knitr (>= 1.42),
-    lifecycle (>= 0.2.0),
     logger (>= 0.2.0),
     nestcolor (>= 0.1.0),
     pkgload,

NAMESPACE

@@ -31,3 +31,4 @@ import(shiny)
 import(teal)
 import(teal.transform)
 importFrom(dplyr,"%>%")
+importFrom(lifecycle,deprecated)

NEWS.md

@@ -1,8 +1,11 @@
 # teal.modules.general 0.3.0.9064
 
 * Removed `Show Warnings` modals from modules.
+* Soft deprecated `datasets_selected` argument of modules in favor of `datanames`.
+* Soft deprecated `show_metadata` argument of `tm_front_page()` in favor of `datanames`.
 
 ### Enhancements
+
 * Added `teal.logger` functionality for logging changes in shiny inputs in all modules.
 
 ### Bug fixes

R/tm_data_table.R

@@ -16,10 +16,8 @@
 #' Names of list elements should correspond to the names of the datasets available in the app.
 #' If no entry is specified for a dataset, the first six variables from that
 #' dataset will initially be shown.
-#' @param datasets_selected (`character`) A vector of datasets which should be
-#' shown and in what order. Names in the vector have to correspond with datasets names.
-#' If vector of `length == 0` (default) then all datasets are shown.
-#' Note: Only datasets of the `data.frame` class are compatible.
+#' @param datasets_selected (`character`) `r lifecycle::badge("deprecated")` A vector of datasets which should be
+#' shown and in what order. Use `datanames` instead.
 #' @param dt_args (`named list`) Additional arguments to be passed to [DT::datatable()]
 #' (must not include `data` or `options`).
 #' @param dt_options (`named list`) The `options` argument to `DT::datatable`. By default
@@ -86,7 +84,8 @@
 #'
 tm_data_table <- function(label = "Data Table",
                           variables_selected = list(),
-                          datasets_selected = character(0),
+                          datasets_selected = deprecated(),
+                          datanames = if (missing(datasets_selected)) "all" else datasets_selected,
                           dt_args = list(),
                           dt_options = list(
                             searching = FALSE,
@@ -111,8 +110,15 @@ tm_data_table <- function(label = "Data Table",
       }
     })
   }
-
-  checkmate::assert_character(datasets_selected, min.len = 0, min.chars = 1)
+  if (!missing(datasets_selected)) {
+    lifecycle::deprecate_soft(
+      when = "0.4.0",
+      what = "tm_data_table(datasets_selected)",
+      with = "tm_data_table(datanames)",
+      details = 'Use tm_data_table(datanames = "all") to keep the previous behavior and avoid this warning.',
+    )
+  }
+  checkmate::assert_character(datanames, min.len = 0, min.chars = 1, null.ok = TRUE)
   checkmate::assert(
     checkmate::check_list(dt_args, len = 0),
     checkmate::check_subset(names(dt_args), choices = names(formals(DT::datatable)))
@@ -128,10 +134,10 @@ tm_data_table <- function(label = "Data Table",
     label,
     server = srv_page_data_table,
     ui = ui_page_data_table,
-    datanames = if (length(datasets_selected) == 0) "all" else datasets_selected,
+    datanames = datanames,
     server_args = list(
+      datanames = datanames,
       variables_selected = variables_selected,
-      datasets_selected = datasets_selected,
       dt_args = dt_args,
       dt_options = dt_options,
       server_rendering = server_rendering
@@ -180,7 +186,7 @@ ui_page_data_table <- function(id, pre_output = NULL, post_output = NULL) {
 # Server page module
 srv_page_data_table <- function(id,
                                 data,
-                                datasets_selected,
+                                datanames,
                                 variables_selected,
                                 dt_args,
                                 dt_options,
@@ -193,16 +199,10 @@ srv_page_data_table <- function(id,
     if_filtered <- reactive(as.logical(input$if_filtered))
     if_distinct <- reactive(as.logical(input$if_distinct))
 
-    datanames <- isolate(names(data()))
     datanames <- Filter(function(name) {
       is.data.frame(isolate(data())[[name]])
     }, datanames)
 
-    if (!identical(datasets_selected, character(0))) {
-      checkmate::assert_subset(datasets_selected, datanames)
-      datanames <- datasets_selected
-    }
-
     output$dataset_table <- renderUI({
       do.call(
         tabsetPanel,

R/tm_front_page.R

@@ -13,7 +13,10 @@
 #' `HTML("html text here")`.
 #' @param footnotes (`character` vector) of text to be shown at the bottom of the module, for each
 #' element, if named the name is shown first in bold, followed by the value.
-#' @param show_metadata (`logical`) indicating whether the metadata of the datasets be available on the module.
+#' @param show_metadata (`logical`) `r lifecycle::badge("deprecated")` indicating
+#' whether the metadata of the datasets be available on the module.
+#' Metadata shown automatically when `datanames` set.
+#' @inheritParams tm_variable_browser
 #'
 #' @inherit shared_params return
 #'
@@ -50,12 +53,11 @@
 #'       ),
 #'       tables = table_input,
 #'       additional_tags = HTML("Additional HTML or shiny tags go here <br>"),
-#'       footnotes = c("X" = "is the first footnote", "Y is the second footnote"),
-#'       show_metadata = TRUE
+#'       footnotes = c("X" = "is the first footnote", "Y is the second footnote")
 #'     )
 #'   ),
 #'   header = tags$h1("Sample Application"),
-#'   footer = tags$p("Application footer"),
+#'   footer = tags$p("Application footer")
 #' )
 #'
 #' if (interactive()) {
@@ -69,7 +71,8 @@ tm_front_page <- function(label = "Front page",
                           tables = list(),
                           additional_tags = tagList(),
                           footnotes = character(0),
-                          show_metadata = FALSE) {
+                          show_metadata = deprecated(),
+                          datanames = if (missing(show_metadata)) "all" else NULL) {
   message("Initializing tm_front_page")
 
   # Start of assertions
@@ -78,7 +81,19 @@ tm_front_page <- function(label = "Front page",
   checkmate::assert_list(tables, types = "data.frame", names = "named", any.missing = FALSE)
   checkmate::assert_multi_class(additional_tags, classes = c("shiny.tag.list", "html"))
   checkmate::assert_character(footnotes, min.len = 0, any.missing = FALSE)
-  checkmate::assert_flag(show_metadata)
+  if (!missing(show_metadata)) {
+    lifecycle::deprecate_soft(
+      when = "0.4.0",
+      what = "tm_front_page(show_metadata)",
+      with = "tm_front_page(datanames)",
+      details = c(
+        "With `datanames` you can select which datasets are displayed.",
+        i = "Use `tm_front_page(datanames = 'all')` to keep the previous behavior and avoid this warning."
+      )
+    )
+  }
+  checkmate::assert_character(datanames, min.len = 0, min.chars = 1, null.ok = TRUE)
+
   # End of assertions
 
   # Make UI args
@@ -89,8 +104,8 @@ tm_front_page <- function(label = "Front page",
     server = srv_front_page,
     ui = ui_front_page,
     ui_args = args,
-    server_args = list(tables = tables, show_metadata = show_metadata),
-    datanames = if (show_metadata) "all" else NULL
+    server_args = list(tables = tables),
+    datanames = datanames
   )
   attr(ans, "teal_bookmarkable") <- TRUE
   ans
@@ -120,7 +135,7 @@ ui_front_page <- function(id, ...) {
         class = "my-4",
         args$additional_tags
       ),
-      if (args$show_metadata) {
+      if (length(args$datanames) > 0L) {
         tags$div(
           id = "front_page_metabutton",
           class = "m-4",
@@ -136,7 +151,7 @@ ui_front_page <- function(id, ...) {
 }
 
 # Server function for the front page module
-srv_front_page <- function(id, data, tables, show_metadata) {
+srv_front_page <- function(id, data, tables) {
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {
@@ -154,8 +169,7 @@ srv_front_page <- function(id, data, tables, show_metadata) {
         caption.placement = "top"
       )
     })
-
-    if (show_metadata) {
+    if (length(isolate(names(data()))) > 0L) {
       observeEvent(
         input$metadata_button, showModal(
           modalDialog(

R/tm_missing_data.R

@@ -73,7 +73,7 @@
 #' app <- init(
 #'   data = data,
 #'   modules = modules(
-#'     tm_missing_data()
+#'     tm_missing_data(parent_dataname = "mtcars")
 #'   )
 #' )
 #' if (interactive()) {
@@ -109,6 +109,7 @@
 tm_missing_data <- function(label = "Missing data",
                             plot_height = c(600, 400, 5000),
                             plot_width = NULL,
+                            datanames = "all",
                             parent_dataname = "ADSL",
                             ggtheme = c("classic", "gray", "bw", "linedraw", "light", "dark", "minimal", "void"),
                             ggplot2_args = list(
@@ -134,6 +135,7 @@ tm_missing_data <- function(label = "Missing data",
     lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
   )
 
+  checkmate::assert_character(datanames, min.len = 0, min.chars = 1, null.ok = TRUE)
   checkmate::assert_character(parent_dataname, min.len = 0, max.len = 1)
   ggtheme <- match.arg(ggtheme)
 
@@ -152,6 +154,7 @@ tm_missing_data <- function(label = "Missing data",
   ans <- module(
     label,
     server = srv_page_missing_data,
+    datanames = if (identical(datanames, "all")) union(datanames, parent_dataname) else "all",
     server_args = list(
       parent_dataname = parent_dataname,
       plot_height = plot_height,
@@ -161,7 +164,6 @@ tm_missing_data <- function(label = "Missing data",
       decorators = decorators
     ),
     ui = ui_page_missing_data,
-    datanames = "all",
     ui_args = list(pre_output = pre_output, post_output = post_output)
   )
   attr(ans, "teal_bookmarkable") <- TRUE

R/tm_variable_browser.R

@@ -10,14 +10,12 @@
 #' @inheritParams teal::module
 #' @inheritParams shared_params
 #' @param parent_dataname (`character(1)`) string specifying a parent dataset.
-#' If it exists in `datasets_selected`then an extra checkbox will be shown to
+#' If it exists in `datanames` then an extra checkbox will be shown to
 #' allow users to not show variables in other datasets which exist in this `dataname`.
 #' This is typically used to remove `ADSL` columns in `CDISC` data.
 #' In non `CDISC` data this can be ignored. Defaults to `"ADSL"`.
-#' @param datasets_selected (`character`) vector of datasets which should be
-#' shown, in order. Names must correspond with datasets names.
-#' If vector of length zero (default) then all datasets are shown.
-#' Note: Only `data.frame` objects are compatible; using other types will cause an error.
+#' @param datasets_selected (`character`) `r lifecycle::badge("deprecated")` vector of datasets to show, please
+#' use the `datanames` argument.
 #'
 #' @inherit shared_params return
 #'
@@ -81,7 +79,8 @@
 #' @export
 #'
 tm_variable_browser <- function(label = "Variable Browser",
-                                datasets_selected = character(0),
+                                datasets_selected = deprecated(),
+                                datanames = if (missing(datasets_selected)) "all" else datasets_selected,
                                 parent_dataname = "ADSL",
                                 pre_output = NULL,
                                 post_output = NULL,
@@ -90,22 +89,37 @@ tm_variable_browser <- function(label = "Variable Browser",
 
   # Start of assertions
   checkmate::assert_string(label)
-  checkmate::assert_character(datasets_selected)
+  if (!missing(datasets_selected)) {
+    lifecycle::deprecate_soft(
+      when = "0.4.0",
+      what = "tm_variable_browser(datasets_selected)",
+      with = "tm_variable_browser(datanames)",
+      details = c(
+        "If both `datasets_selected` and `datanames` are set `datasets_selected` will be silently ignored.",
+        i = 'Use `tm_variable_browser(datanames = "all")` to keep the previous behavior and avoid this warning.'
+      )
+    )
+  }
+  checkmate::assert_character(datanames, min.len = 0, min.chars = 1, null.ok = TRUE)
   checkmate::assert_character(parent_dataname, min.len = 0, max.len = 1)
   checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_class(ggplot2_args, "ggplot2_args")
   # End of assertions
 
-  datasets_selected <- unique(datasets_selected)
+  datanames <- if (identical(datanames, "all")) {
+    "all"
+  } else {
+    union(datanames, parent_dataname)
+  }
 
   ans <- module(
     label,
     server = srv_variable_browser,
     ui = ui_variable_browser,
-    datanames = "all",
+    datanames = datanames,
     server_args = list(
-      datasets_selected = datasets_selected,
+      datanames = datanames,
       parent_dataname = parent_dataname,
       ggplot2_args = ggplot2_args
     ),
@@ -194,7 +208,7 @@ srv_variable_browser <- function(id,
                                  data,
                                  reporter,
                                  filter_panel_api,
-                                 datasets_selected, parent_dataname, ggplot2_args) {
+                                 datanames, parent_dataname, ggplot2_args) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -212,18 +226,10 @@ srv_variable_browser <- function(id,
 
     varname_numeric_as_factor <- reactiveValues()
 
-    datanames <- isolate(names(data()))
     datanames <- Filter(function(name) {
       is.data.frame(isolate(data())[[name]])
     }, datanames)
 
-    checkmate::assert_character(datasets_selected)
-    checkmate::assert_subset(datasets_selected, datanames)
-    if (!identical(datasets_selected, character(0))) {
-      checkmate::assert_subset(datasets_selected, datanames)
-      datanames <- datasets_selected
-    }
-
     output$ui_variable_browser <- renderUI({
       ns <- session$ns
       do.call(

R/zzz.R

@@ -6,4 +6,5 @@
 ### global variables
 ggplot_themes <- c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void")
 
+#' @importFrom lifecycle deprecated
 interactive <- NULL