feat: added a formatting function for the output of data_extract_srv

NAMESPACE

@@ -39,6 +39,7 @@ export(data_merge_module)
 export(data_merge_srv)
 export(datanames_input)
 export(filter_spec)
+export(format_data_extract)
 export(get_anl_relabel_call)
 export(get_dataset_prefixed_col_names)
 export(get_extract_datanames)
@@ -59,4 +60,5 @@ export(variable_choices)
 import(shiny)
 importFrom(formatters,var_labels)
 importFrom(formatters,var_relabel)
+importFrom(lifecycle,badge)
 importFrom(magrittr,"%>%")

R/data_extract_module.R

@@ -358,7 +358,6 @@ data_extract_srv <- function(id, datasets, data_extract_spec) {
         return(reactive(NULL))
       }
       check_data_extract_spec(data_extract_spec = data_extract_spec)
-
       res <- tryCatch(
         check_data_extract_spec_react(datasets, data_extract_spec),
         error = function(e) shiny::reactive(shiny::validate(e$message))

R/format_data_extract.R

@@ -0,0 +1,71 @@
+#' @title Formatting data extracts
+#' @description Returns a human-readable string representation of an extracted `data_extract_spec` object.
+#'
+#' @details
+#' This function formats the output of [`data_extract_srv`]. See the example for more information.
+#'
+#' @param data_extract `list` the list output of `data_extract_srv`
+#' @return `character(1)` the string representation
+#' @examples
+#' simple_des <- data_extract_spec(
+#'   dataname = "iris",
+#'   filter = filter_spec(vars = "Petal.Length", choices = c("1.4", "1.5")),
+#'   select = select_spec(choices = c("Petal.Length", "Species"))
+#' )
+#'
+#' sample_filtered_data <- {
+#'   # create TealData
+#'   data <- teal.data::teal_data(teal.data::dataset("iris", iris))
+#'
+#'   # covert TealData to FilteredData
+#'   datasets <- teal.slice:::filtered_data_new(data)
+#'   teal.slice:::filtered_data_set(data, datasets)
+#'   datasets
+#' }
+#'
+#' if (interactive()) {
+#'   shiny::shinyApp(
+#'     ui = shiny::fluidPage(
+#'       data_extract_ui(
+#'         id = "extract",
+#'         label = "data extract ui",
+#'         data_extract_spec = simple_des,
+#'         is_single_dataset = TRUE
+#'       ),
+#'       shiny::verbatimTextOutput("formatted_extract")
+#'     ),
+#'     server = function(input, output, session) {
+#'       extracted_input <- data_extract_srv(
+#'         id = "extract",
+#'         datasets = sample_filtered_data,
+#'         data_extract_spec = simple_des
+#'       )
+#'       output$formatted_extract <- shiny::renderPrint({
+#'         format_data_extract(extracted_input())
+#'       })
+#'     }
+#'   )
+#' }
+#' @export
+#'
+format_data_extract <- function(data_extract) {
+  checkmate::assert_list(data_extract)
+  required_names <- c("select", "filters", "dataname")
+  if (!checkmate::test_subset(required_names, choices = names(data_extract))) {
+    stop(sprintf("data_extract must be a named list with names: %s", paste0(required_names, collapse = " ")))
+  }
+
+  out <- sprintf("<Data Extract for dataset: %s>", data_extract$dataname)
+  out <- c(out, "Filters:")
+  for (filter in data_extract$filters) {
+    filtering_columns <- paste0(filter$columns, collapse = " ")
+    selected_values <- paste0(filter$selected, collapse = " ")
+    out <- c(out, sprintf("  Columns: %s Selected: %s", filtering_columns, selected_values))
+  }
+
+  out <- c(out, "Selected columns:")
+  selected_columns <- paste0(data_extract$select, collapse = " ")
+  out <- c(out, sprintf("  %s", selected_columns))
+
+  paste0(out, collapse = "\n")
+}

R/teal.transform-package.R

@@ -5,4 +5,5 @@
 #' @import shiny
 #' @importFrom magrittr %>%
 #' @importFrom formatters var_relabel var_labels
+#' @importFrom lifecycle badge
 NULL

_pkgdown.yml

@@ -52,3 +52,6 @@ reference:
       - is_single_dataset
       - list_extract_spec
       - merge_datasets
+  - title: Human-readable formatting of a data extract object
+    contents:
+      - format_data_extract

tests/testthat/test-format_data_extract.R

@@ -0,0 +1,57 @@
+required_names <- c("select", "filters", "dataname")
+
+testthat::test_that("format_data_extract is a function that accepts a list", {
+  data_extract_fake <- as.list(stats::setNames(nm = required_names))
+  data_extract_fake$filters <- list()
+  testthat::expect_error(format_data_extract(data_extract_fake), regexp = NA)
+})
+
+testthat::test_that("format_data_extract asserts its argument has required names", {
+  testthat::expect_error(
+    format_data_extract(list()),
+    regexp = "data_extract must be a named list with names: select filters dataname"
+  )
+})
+
+testthat::test_that("format_data_extract returns a string representation of the extracted data", {
+  data_extract_fake <- as.list(stats::setNames(nm = required_names))
+  data_extract_fake$dataname <- "test dataname"
+  data_extract_fake$filters <- list(list(columns = c("ColA", "ColB"), selected = "ColB"))
+  data_extract_fake$select <- c("ColC", "ColD")
+  data_extract_fake
+
+  testthat::expect_equal(
+    format_data_extract(data_extract_fake),
+    paste(
+      "<Data Extract for dataset: test dataname>",
+      "Filters:",
+      "  Columns: ColA ColB Selected: ColB",
+      "Selected columns:",
+      "  ColC ColD",
+      sep = "\n"
+    )
+  )
+})
+
+testthat::test_that("format_data_extract integrates with data_extract_srv", {
+  sample_filtered_data <- {
+    data <- teal.data::teal_data(teal.data::dataset("iris", iris))
+    datasets <- teal.slice:::filtered_data_new(data)
+    teal.slice:::filtered_data_set(data, datasets)
+    datasets
+  }
+
+  simple_des <- data_extract_spec(
+    dataname = "iris",
+    filter = filter_spec(vars = "Petal.Length", choices = c("1.4", "1.5")),
+    select = select_spec(choices = c("Petal.Length", "Species"))
+  )
+
+  shiny::testServer(
+    data_extract_srv,
+    args = list(data_extract_spec = simple_des, datasets = sample_filtered_data),
+    expr = {
+      testthat::expect_error(format_data_extract(session$returned()), regexp = NA)
+    }
+  )
+})

vignettes/data-extract.Rmd

@@ -18,12 +18,12 @@ knitr::opts_chunk$set(
 )
 ```
 
-There are times when an app developer wants to showcase more than just one fixed slice of their dataset in their 
-custom module. Relinquishing control of the application to a user demands the developer gives their users a degree 
-of freedom. In case of analyzing data, `teal` allows app developers to open up their applications to users, letting them 
-decide exactly what app data to analyze in the module. 
+There are times when an app developer wants to showcase more than just one fixed slice of their dataset in their
+custom module. Relinquishing control of the application to a user demands the developer gives their users a degree
+of freedom. In case of analyzing data, `teal` allows app developers to open up their applications to users, letting them
+decide exactly what app data to analyze in the module.
 
-A lot of `teal` modules use `data_extract_spec` objects and modules to tackle user input. You can find many examples in 
+A lot of `teal` modules use `data_extract_spec` objects and modules to tackle user input. You can find many examples in
 e.g. `teal.modules.general` and `teal.modules.clinical`.
 
 
@@ -34,9 +34,9 @@ e.g. `teal.modules.general` and `teal.modules.clinical`.
 
 #### Example module
 
-In order to showcase different initialization options of `data_extract_spec`, first we define a `shiny` module which 
-uses `data_extract_ui` and `data_extract_srv` designed to handle `data_extract_spec` objects. The module creates a UI 
-component for single `data_extract_spec` and prints list of values returned from `data_extract_srv` module. Please see 
+In order to showcase different initialization options of `data_extract_spec`, first we define a `shiny` module which
+uses `data_extract_ui` and `data_extract_srv` designed to handle `data_extract_spec` objects. The module creates a UI
+component for single `data_extract_spec` and prints list of values returned from `data_extract_srv` module. Please see
 package documentation for more information about `data_extract_ui` and `data_extract_srv`.
 
 ```{r}
@@ -54,16 +54,22 @@ extract_ui <- function(id, data_extract) {
 extract_srv <- function(id, datasets, data_extract) {
   moduleServer(id, function(input, output, session) {
     reactive_extract_input <- data_extract_srv("data_extract", datasets, data_extract)
-    output$output <- renderPrint(reactive_extract_input())
+    s <- reactive({
+      str(reactive_extract_input())
+      reactive_extract_input()
+    })
+    output$output <- renderPrint({
+      s()
+    })
   })
 }
 ```
 
 
 #### Example data
 
-`teal.transform` functions depend on a `FilteredData` object from the `teal.slice` package. Normally, `FilteredData` is created 
-automatically by `teal::init`, but for example purposes we define a wrapper function to initialize the necessary object. 
+`teal.transform` functions depend on a `FilteredData` object from the `teal.slice` package. Normally, `FilteredData` is created
+automatically by `teal::init`, but for example purposes we define a wrapper function to initialize the necessary object.
 
 ```{r}
 sample_filtered_data <- function() {
@@ -82,8 +88,8 @@ datasets <- sample_filtered_data()
 ```
 
 Consider the following example, where we create two UI elements, one to filter on a specific level from `SEX` variable,
-and a second one to select a variable from `c("BMRKR1", "AGE")`. `data_extract_spec` object is handed over to the shiny 
-app and gives instructions to generate UI components. 
+and a second one to select a variable from `c("BMRKR1", "AGE")`. `data_extract_spec` object is handed over to the shiny
+app and gives instructions to generate UI components.
 
 ```{r}
 simple_des <- data_extract_spec(