add .test argument

R/argument_convention.R

@@ -43,6 +43,7 @@
 #' @param plot_width (`list`)\cr list of integers to set the default, minimum,
 #'   and maximum plot width.
 #' @param filter_panel_api (`FilterPanelAPI`)\cr object describing the actual filter panel API.
+#' @param .test (`flag`)\cr whether to display the internal structure of the plot for testing purposes.
 #'
 #' @name module_arguments
 #' @keywords internal

R/barplot.R

@@ -34,29 +34,33 @@ tm_g_barplot <- function(label,
                            Max = matrixStats::colMaxs
                          ),
                          pre_output = NULL,
-                         post_output = NULL) {
+                         post_output = NULL,
+                         .test = FALSE) {
   logger::log_info("Initializing tm_g_barplot")
   assert_string(label)
   assert_string(mae_name)
   assert_character(exclude_assays)
   assert_summary_funs(summary_funs)
   assert_tag(pre_output, null.ok = TRUE)
   assert_tag(post_output, null.ok = TRUE)
+  assert_flag(.test)
 
   module(
     label = label,
     server = srv_g_barplot,
     server_args = list(
       mae_name = mae_name,
       exclude_assays = exclude_assays,
-      summary_funs = summary_funs
+      summary_funs = summary_funs,
+      .test = .test
     ),
     ui = ui_g_barplot,
     ui_args = list(
       mae_name = mae_name,
       summary_funs = summary_funs,
       pre_output = pre_output,
-      post_output = post_output
+      post_output = post_output,
+      .test = .test
     ),
     datanames = mae_name
   )
@@ -69,7 +73,8 @@ ui_g_barplot <- function(id,
                          mae_name,
                          summary_funs,
                          pre_output,
-                         post_output) {
+                         post_output,
+                         .test = FALSE) {
   ns <- NS(id)
   teal.widgets::standard_layout(
     encoding = div(
@@ -101,7 +106,10 @@ ui_g_barplot <- function(id,
         )
       )
     ),
-    output = teal.widgets::plot_with_settings_ui(ns("plot")),
+    output = div(
+      if (.test) verbatimTextOutput(ns("table")) else NULL,
+      teal.widgets::plot_with_settings_ui(ns("plot"))
+    ),
     pre_output = pre_output,
     post_output = post_output
   )
@@ -116,11 +124,13 @@ srv_g_barplot <- function(id,
                           reporter,
                           mae_name,
                           exclude_assays,
-                          summary_funs) {
+                          summary_funs,
+                          .test = FALSE) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   assert_class(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(shiny::isolate(data()), "teal_data")
+  assert_flag(.test)
   moduleServer(id, function(input, output, session) {
     output$experiment_ui <- renderUI({
       experimentSpecInput(session$ns("experiment"), data, mae_name)
@@ -189,6 +199,13 @@ srv_g_barplot <- function(id,
       plot_r = plot_r
     )
 
+    if (.test) {
+      table_r <- reactive({
+        str(layer_data(plot_r()))
+      })
+      output$table <- renderPrint(table_r())
+    }
+
     ### REPORTER
     if (with_reporter) {
       card_fun <- function(comment, label) {
@@ -230,6 +247,7 @@ srv_g_barplot <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
+
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
@@ -246,14 +264,15 @@ srv_g_barplot <- function(id,
 #' if (interactive()) {
 #'   sample_tm_g_barplot()
 #' }
-sample_tm_g_barplot <- function() {
+sample_tm_g_barplot <- function(.test = FALSE) {
   data <- teal.data::teal_data(MAE = hermes::multi_assay_experiment)
   app <- teal::init(
     data = data,
     modules = teal::modules(
       tm_g_barplot(
         label = "barplot",
-        mae_name = "MAE"
+        mae_name = "MAE",
+        .test = .test
       )
     )
   )

tests/testthat/_snaps/barplot.md

@@ -0,0 +1,23 @@
+# barplot module works as expected in the test app
+
+    Code
+      cat(res)
+    Output
+      'data.frame':	3 obs. of  16 variables:
+       $ y          : num  1 3 1
+       $ count      : num  1 3 1
+       $ prop       : num  1 1 1
+       $ x          : 'mapped_discrete' num  1 2 3
+       $ flipped_aes: logi  FALSE FALSE FALSE
+       $ PANEL      : Factor w/ 2 levels "1","2": 1 1 2
+       $ group      : int  1 2 3
+       $ ymin       : num  0 0 0
+       $ ymax       : num  1 3 1
+       $ xmin       : 'mapped_discrete' num  0.55 1.55 2.55
+       $ xmax       : 'mapped_discrete' num  1.45 2.45 3.45
+       $ colour     : logi  NA NA NA
+       $ fill       : chr  "grey35" "grey35" "grey35"
+       $ linewidth  : num  0.5 0.5 0.5
+       $ linetype   : num  1 1 1
+       $ alpha      : logi  NA NA NA
+

tests/testthat/barplot/app.R

@@ -1,3 +1,3 @@
 library(teal.modules.hermes)
 
-sample_tm_g_barplot()
+sample_tm_g_barplot(.test = TRUE)

tests/testthat/test-barplot.R

@@ -46,7 +46,7 @@ test_that("barplot module works as expected in the test app", {
   expect_null(res)
 
   # check initial message
-  res <- app$get_value(output = ns("plot-plot_out_main"))
+  res <- app$get_value(output = ns("table"))
   expect_equal(res$message, "please select at least one gene")
 
   # Set values
@@ -73,7 +73,7 @@ test_that("barplot module works as expected in the test app", {
   app$set_inputs(!!ns("percentiles") := c(0.1, 0.1))
   app$wait_for_idle()
 
-  res <- app$get_value(output = ns("plot-plot_out_main"))
+  res <- app$get_value(output = ns("table"))
   expect_equal(
     res$message,
     "please select two different quantiles - if you want only 2 groups, choose one quantile as 0 or 1"
@@ -89,7 +89,11 @@ test_that("barplot module works as expected in the test app", {
   )
 
   app$wait_for_idle()
-  app$expect_select_screenshot(ns("plot-plot_out_main"))
+
+  res <- app$get_value(output = ns("table"))
+  expect_snapshot(
+    cat(res)
+  )
 
   app$stop()
 })