From e12820cf41b4fd12cf3de587da6eb623ea1aab6c Mon Sep 17 00:00:00 2001 From: b_falquet <64274616+BFalquet@users.noreply.github.com> Date: Mon, 25 Mar 2024 20:40:20 +0100 Subject: [PATCH] 370 again integration test failures because of snapshot changes (#371) https://github.com/insightsengineering/teal.modules.hermes/issues/370 This is a prototype to replace the plot snapshot testing and avoid test failure due to minimal changes in the plotting. - introduce a test argument in the barplot module. If `TRUE`, the structure (`layer_data`) of the plot is rendered. - the snapshot test is now performed on the underlying data rather than on the plot itself thank you for your review and suggestions --------- Co-authored-by: benoit --- R/argument_convention.R | 1 + R/barplot.R | 35 ++- R/boxplot.R | 33 ++- R/forestplot.R | 37 ++- R/km.R | 40 ++- R/pca.R | 31 ++- R/quality.R | 37 ++- R/scatterplot.R | 29 +- R/volcanoplot.R | 28 +- man/module_arguments.Rd | 2 + man/tm_g_barplot.Rd | 19 +- man/tm_g_boxplot.Rd | 19 +- man/tm_g_forest_tte.Rd | 13 +- man/tm_g_km.Rd | 20 +- man/tm_g_pca.Rd | 19 +- man/tm_g_quality.Rd | 19 +- man/tm_g_scatterplot.Rd | 19 +- man/tm_g_volcanoplot.Rd | 12 +- tests/testthat/_snaps/barplot.md | 23 ++ tests/testthat/_snaps/boxplot.md | 28 ++ tests/testthat/_snaps/forest.md | 12 + tests/testthat/_snaps/km.md | 260 ++++++++++++++++++ tests/testthat/_snaps/pca.md | 110 ++++++++ tests/testthat/_snaps/quality.md | 111 ++++++++ tests/testthat/_snaps/scatterplot.md | 5 + tests/testthat/_snaps/volcanoplot.md | 10 + .../scatterplot/scatterplot-001.new.png | Bin 23094 -> 0 bytes tests/testthat/barplot/app.R | 2 +- tests/testthat/boxplot/app.R | 2 +- tests/testthat/forest_tte/app.R | 2 +- tests/testthat/km/app.R | 2 +- tests/testthat/pca/app.R | 2 +- tests/testthat/quality/app.R | 2 +- tests/testthat/scatterplot/app.R | 2 +- tests/testthat/test-barplot.R | 10 +- tests/testthat/test-boxplot.R | 5 +- tests/testthat/test-forest.R | 7 +- tests/testthat/test-km.R | 7 +- tests/testthat/test-pca.R | 46 +++- tests/testthat/test-quality.R | 17 +- tests/testthat/test-scatterplot.R | 9 +- tests/testthat/test-volcanoplot.R | 8 +- tests/testthat/volcanoplot/app.R | 2 +- 43 files changed, 958 insertions(+), 139 deletions(-) create mode 100644 tests/testthat/_snaps/barplot.md create mode 100644 tests/testthat/_snaps/boxplot.md create mode 100644 tests/testthat/_snaps/forest.md create mode 100644 tests/testthat/_snaps/km.md create mode 100644 tests/testthat/_snaps/pca.md create mode 100644 tests/testthat/_snaps/quality.md create mode 100644 tests/testthat/_snaps/scatterplot.md create mode 100644 tests/testthat/_snaps/volcanoplot.md delete mode 100644 tests/testthat/_snaps/windows-4.3/scatterplot/scatterplot-001.new.png diff --git a/R/argument_convention.R b/R/argument_convention.R index 11324bf2..ab1316ab 100644 --- a/R/argument_convention.R +++ b/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 diff --git a/R/barplot.R b/R/barplot.R index 11b5deb9..c204e596 100644 --- a/R/barplot.R +++ b/R/barplot.R @@ -34,7 +34,8 @@ tm_g_barplot <- function(label, Max = matrixStats::colMaxs ), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + .test = FALSE) { message("Initializing tm_g_barplot") assert_string(label) assert_string(mae_name) @@ -42,6 +43,7 @@ tm_g_barplot <- function(label, 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, @@ -49,14 +51,16 @@ tm_g_barplot <- function(label, 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 = tags$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 ) ) ) diff --git a/R/boxplot.R b/R/boxplot.R index 7eccbb6f..b275be4c 100644 --- a/R/boxplot.R +++ b/R/boxplot.R @@ -35,7 +35,8 @@ tm_g_boxplot <- function(label, Max = matrixStats::colMaxs ), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + .test = FALSE) { message("Initializing tm_g_boxplot") assert_string(label) assert_string(mae_name) @@ -43,6 +44,7 @@ tm_g_boxplot <- function(label, assert_summary_funs(summary_funs, null.ok = TRUE) assert_tag(pre_output, null.ok = TRUE) assert_tag(post_output, null.ok = TRUE) + assert_flag(.test) teal::module( label = label, @@ -50,14 +52,16 @@ tm_g_boxplot <- function(label, server_args = list( mae_name = mae_name, summary_funs = summary_funs, - exclude_assays = exclude_assays + exclude_assays = exclude_assays, + .test = .test ), ui = ui_g_boxplot, 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 ) @@ -70,7 +74,8 @@ ui_g_boxplot <- function(id, mae_name, summary_funs, pre_output, - post_output) { + post_output, + .test = FALSE) { ns <- NS(id) teal.widgets::standard_layout( encoding = tags$div( @@ -97,7 +102,10 @@ ui_g_boxplot <- 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 ) @@ -112,7 +120,8 @@ srv_g_boxplot <- 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") @@ -184,6 +193,13 @@ srv_g_boxplot <- 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) { @@ -247,14 +263,15 @@ srv_g_boxplot <- function(id, #' if (interactive()) { #' sample_tm_g_boxplot() #' } -sample_tm_g_boxplot <- function() { +sample_tm_g_boxplot <- function(.test = FALSE) { data <- teal.data::teal_data(MAE = hermes::multi_assay_experiment) app <- teal::init( data = data, modules = teal::modules( tm_g_boxplot( label = "boxplot", - mae_name = "MAE" + mae_name = "MAE", + .test = .test ) ) ) diff --git a/R/forestplot.R b/R/forestplot.R index 8374e4da..a76a86fc 100644 --- a/R/forestplot.R +++ b/R/forestplot.R @@ -53,7 +53,8 @@ tm_g_forest_tte <- function(label, pre_output = NULL, post_output = NULL, plot_height = c(600L, 200L, 2000L), - plot_width = c(1360L, 500L, 2000L)) { + plot_width = c(1360L, 500L, 2000L), + .test = FALSE) { message("Initializing tm_g_forest_tte") assert_string(label) assert_string(adtte_name) @@ -63,6 +64,7 @@ tm_g_forest_tte <- function(label, assert_summary_funs(summary_funs) assert_tag(pre_output, null.ok = TRUE) assert_tag(post_output, null.ok = TRUE) + assert_flag(.test) teal::module( label = label, @@ -74,7 +76,8 @@ tm_g_forest_tte <- function(label, exclude_assays = exclude_assays, summary_funs = summary_funs, plot_height = plot_height, - plot_width = plot_width + plot_width = plot_width, + .test = .test ), ui = ui_g_forest_tte, ui_args = list( @@ -82,7 +85,8 @@ tm_g_forest_tte <- function(label, mae_name = mae_name, summary_funs = summary_funs, pre_output = pre_output, - post_output = post_output + post_output = post_output, + .test = .test ), datanames = c(adtte_name, mae_name) ) @@ -96,7 +100,8 @@ ui_g_forest_tte <- function(id, mae_name, summary_funs, pre_output, - post_output) { + post_output, + .test = FALSE) { ns <- NS(id) teal.widgets::standard_layout( encoding = tags$div( @@ -120,7 +125,10 @@ ui_g_forest_tte <- 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 ) @@ -139,7 +147,8 @@ srv_g_forest_tte <- function(id, exclude_assays, summary_funs, plot_height, - plot_width) { + plot_width, + .test = FALSE) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") assert_class(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -217,8 +226,8 @@ srv_g_forest_tte <- function(id, }) forest_plot <- reactive({ - result <- result() - tern::g_forest(result) + res <- result() + tern::g_forest(res) }) pws <- teal.widgets::plot_with_settings_srv( @@ -228,6 +237,13 @@ srv_g_forest_tte <- function(id, width = plot_width ) + if (.test) { + table_r <- reactive({ + rtables::as_result_df(result()) + }) + output$table <- renderPrint(table_r()) + } + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -285,7 +301,7 @@ srv_g_forest_tte <- function(id, #' if (interactive()) { #' sample_tm_g_forest_tte() #' } -sample_tm_g_forest_tte <- function() { # nolint +sample_tm_g_forest_tte <- function(.test = FALSE) { # nolint data <- teal_data() data <- within(data, { ADTTE <- teal.modules.hermes::rADTTE %>% # nolint @@ -302,7 +318,8 @@ sample_tm_g_forest_tte <- function() { # nolint tm_g_forest_tte( label = "forest", adtte_name = "ADTTE", - mae_name = "MAE" + mae_name = "MAE", + .test = .test ) ) ) diff --git a/R/km.R b/R/km.R index b2ff88f6..95662064 100644 --- a/R/km.R +++ b/R/km.R @@ -56,7 +56,8 @@ tm_g_km <- function(label, Max = matrixStats::colMaxs ), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + .test = FALSE) { message("Initializing tm_g_km") assert_string(label) assert_string(adtte_name) @@ -75,7 +76,8 @@ tm_g_km <- function(label, mae_name = mae_name, adtte_vars = adtte_vars, exclude_assays = exclude_assays, - summary_funs = summary_funs + summary_funs = summary_funs, + .test = .test ), ui = ui_g_km, ui_args = list( @@ -83,7 +85,8 @@ tm_g_km <- function(label, mae_name = mae_name, summary_funs = summary_funs, pre_output = pre_output, - post_output = post_output + post_output = post_output, + .test = .test ), datanames = c(adtte_name, mae_name) ) @@ -97,7 +100,8 @@ ui_g_km <- function(id, mae_name, summary_funs, pre_output, - post_output) { + post_output, + .test = FALSE) { ns <- NS(id) teal.widgets::standard_layout( encoding = tags$div( @@ -127,7 +131,10 @@ ui_g_km <- 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 ) @@ -144,7 +151,8 @@ srv_g_km <- function(id, mae_name, adtte_vars, summary_funs, - exclude_assays) { + exclude_assays, + .test = FALSE) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") assert_class(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -199,7 +207,7 @@ srv_g_km <- function(id, probs = percentiles_without_borders ) - km_plot <- reactive({ + km_data <- reactive({ strata_var <- strata$sample_var() binned_adtte <- adtte$binned_adtte_subset() @@ -209,6 +217,15 @@ srv_g_km <- function(id, arm = adtte$gene_factor, strat = strata_var ) + + list(binned_adtte = binned_adtte, variables = variables) + }) + + km_plot <- reactive({ + km_data <- km_data() + + binned_adtte <- km_data$binned_adtte + variables <- km_data$variables tern::g_km(binned_adtte, variables = variables, annot_coxph = TRUE) }) @@ -219,6 +236,10 @@ srv_g_km <- function(id, plot_r = km_plot ) + if (.test) { + output$table <- renderPrint(km_data()) + } + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -276,7 +297,7 @@ srv_g_km <- function(id, #' if (interactive()) { #' sample_tm_g_km() #' } -sample_tm_g_km <- function() { # nolint +sample_tm_g_km <- function(.test = FALSE) { # nolint data <- teal_data() data <- within(data, { ADTTE <- teal.modules.hermes::rADTTE %>% # nolint @@ -291,7 +312,8 @@ sample_tm_g_km <- function() { # nolint tm_g_km( label = "kaplan-meier", adtte_name = "ADTTE", - mae_name = "MAE" + mae_name = "MAE", + .test = .test ) ) diff --git a/R/pca.R b/R/pca.R index a873a29e..8e465411 100644 --- a/R/pca.R +++ b/R/pca.R @@ -29,7 +29,8 @@ tm_g_pca <- function(label, mae_name, exclude_assays = character(), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + .test = FALSE) { message("Initializing tm_g_pca") assert_string(label) assert_string(mae_name) @@ -41,13 +42,15 @@ tm_g_pca <- function(label, server = srv_g_pca, server_args = list( mae_name = mae_name, - exclude_assays = exclude_assays + exclude_assays = exclude_assays, + .test = .test ), ui = ui_g_pca, ui_args = list( mae_name = mae_name, pre_output = pre_output, - post_output = post_output + post_output = post_output, + .test = .test ), datanames = mae_name ) @@ -59,7 +62,8 @@ tm_g_pca <- function(label, ui_g_pca <- function(id, mae_name, pre_output, - post_output) { + post_output, + .test = FALSE) { ns <- NS(id) tagList( @@ -120,7 +124,8 @@ ui_g_pca <- function(id, "PCA", column( width = 12, - tags$div( + if (.test) verbatimTextOutput(ns("test_pca")) else NULL, + div( class = "my-5", teal.widgets::plot_with_settings_ui(ns("plot_pca")) ), @@ -131,7 +136,8 @@ ui_g_pca <- function(id, "PC and Sample Correlation", column( width = 12, - tags$div( + if (.test) verbatimTextOutput(ns("test_cor")) else NULL, + div( class = "my-5", teal.widgets::plot_with_settings_ui(ns("plot_cor")) ), @@ -154,7 +160,8 @@ srv_g_pca <- function(id, filter_panel_api, reporter, mae_name, - exclude_assays) { + exclude_assays, + .test = FALSE) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") assert_class(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -354,6 +361,11 @@ srv_g_pca <- function(id, plot_r = plot_cor ) + if (.test) { + output$test_pca <- renderPrint(layer_data(plot_pca())) + output$test_cor <- renderPrint(show_matrix_cor()) + } + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -449,14 +461,15 @@ srv_g_pca <- function(id, #' if (interactive()) { #' sample_tm_g_pca() #' } -sample_tm_g_pca <- function() { +sample_tm_g_pca <- function(.test = FALSE) { data <- teal.data::teal_data(MAE = hermes::multi_assay_experiment) app <- teal::init( data = data, modules = teal::modules( tm_g_pca( label = "pca", - mae_name = "MAE" + mae_name = "MAE", + .test = .test ) ) ) diff --git a/R/quality.R b/R/quality.R index 8c5dc805..41be5d3f 100644 --- a/R/quality.R +++ b/R/quality.R @@ -83,7 +83,8 @@ tm_g_quality <- function(label, mae_name, exclude_assays = character(), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + .test = FALSE) { assert_string(label) assert_string(mae_name) assert_character(exclude_assays, any.missing = FALSE) @@ -95,13 +96,15 @@ tm_g_quality <- function(label, server = srv_g_quality, server_args = list( mae_name = mae_name, - exclude_assays = exclude_assays + exclude_assays = exclude_assays, + .test = .test ), ui = ui_g_quality, ui_args = list( mae_name = mae_name, pre_output = pre_output, - post_output = post_output + post_output = post_output, + .test = .test ), datanames = mae_name ) @@ -113,7 +116,8 @@ tm_g_quality <- function(label, ui_g_quality <- function(id, mae_name, pre_output, - post_output) { + post_output, + .test = FALSE) { ns <- NS(id) teal.widgets::standard_layout( encoding = tags$div( @@ -182,7 +186,10 @@ ui_g_quality <- 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 ) @@ -196,7 +203,8 @@ srv_g_quality <- function(id, filter_panel_api, reporter, mae_name, - exclude_assays) { + exclude_assays, + .test = FALSE) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") assert_class(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -352,6 +360,18 @@ srv_g_quality <- function(id, plot_r = plot_r ) + if (.test) { + table <- reactive({ + plot_type <- input$plot_type + if (plot_type == "Correlation Heatmap") { + object_final() + } else { + layer_data(plot_r()) + } + }) + output$table <- renderPrint(table()) + } + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -418,14 +438,15 @@ srv_g_quality <- function(id, #' if (interactive()) { #' sample_tm_g_quality() #' } -sample_tm_g_quality <- function() { +sample_tm_g_quality <- function(.test = FALSE) { data <- teal.data::teal_data(MAE = hermes::multi_assay_experiment) app <- teal::init( data = data, modules = teal::modules( tm_g_quality( label = "quality", - mae_name = "MAE" + mae_name = "MAE", + .test = .test ) ) ) diff --git a/R/scatterplot.R b/R/scatterplot.R index 6a09a89e..a4c16951 100644 --- a/R/scatterplot.R +++ b/R/scatterplot.R @@ -34,7 +34,8 @@ tm_g_scatterplot <- function(label, Max = matrixStats::colMaxs ), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + .test = FALSE) { message("Initializing tm_g_scatterplot") assert_string(label) assert_string(mae_name) @@ -49,14 +50,16 @@ tm_g_scatterplot <- function(label, server_args = list( mae_name = mae_name, summary_funs = summary_funs, - exclude_assays = exclude_assays + exclude_assays = exclude_assays, + .test = .test ), ui = ui_g_scatterplot, 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 +72,8 @@ ui_g_scatterplot <- function(id, mae_name, summary_funs, pre_output, - post_output) { + post_output, + .test = FALSE) { ns <- NS(id) smooth_method_choices <- c( @@ -100,7 +104,10 @@ ui_g_scatterplot <- 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 ) @@ -115,7 +122,8 @@ srv_g_scatterplot <- 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") @@ -184,6 +192,10 @@ srv_g_scatterplot <- function(id, plot_r = plot_r ) + if (.test) { + output$table <- renderPrint(plot_r()) + } + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -245,14 +257,15 @@ srv_g_scatterplot <- function(id, #' if (interactive()) { #' sample_tm_g_scatterplot() #' } -sample_tm_g_scatterplot <- function() { +sample_tm_g_scatterplot <- function(.test = FALSE) { data <- teal.data::teal_data(MAE = hermes::multi_assay_experiment) app <- teal::init( data = data, modules = teal::modules( tm_g_scatterplot( label = "scatterplot", - mae_name = "MAE" + mae_name = "MAE", + .test = .test ) ) ) diff --git a/R/volcanoplot.R b/R/volcanoplot.R index a15989ba..5a71ded7 100644 --- a/R/volcanoplot.R +++ b/R/volcanoplot.R @@ -29,7 +29,8 @@ tm_g_volcanoplot <- function(label, mae_name, exclude_assays = character(), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + .test = FALSE) { message("Initializing tm_g_volcanoplot") assert_string(label) assert_string(mae_name) @@ -42,13 +43,15 @@ tm_g_volcanoplot <- function(label, server = srv_g_volcanoplot, server_args = list( mae_name = mae_name, - exclude_assays = exclude_assays + exclude_assays = exclude_assays, + .test = .test ), ui = ui_g_volcanoplot, ui_args = list( mae_name = mae_name, pre_output = pre_output, - post_output = post_output + post_output = post_output, + .test = .test ), datanames = mae_name ) @@ -60,11 +63,13 @@ tm_g_volcanoplot <- function(label, ui_g_volcanoplot <- function(id, mae_name, pre_output, - post_output) { + post_output, + .test = FALSE) { ns <- NS(id) teal.widgets::standard_layout( - output = tags$div( + output = div( + if (.test) verbatimTextOutput(ns("test")) else NULL, teal.widgets::plot_with_settings_ui(ns("plot")), DT::DTOutput(ns("table")) ), @@ -103,7 +108,8 @@ srv_g_volcanoplot <- function(id, filter_panel_api, reporter, mae_name, - exclude_assays) { + exclude_assays, + .test = FALSE) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") assert_class(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -205,6 +211,11 @@ srv_g_volcanoplot <- function(id, ) }) + if (.test) { + output$test <- renderPrint(layer_data(plot_r())) + } + + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -266,14 +277,15 @@ srv_g_volcanoplot <- function(id, #' if (interactive()) { #' sample_tm_g_volcanoplot() #' } -sample_tm_g_volcanoplot <- function() { +sample_tm_g_volcanoplot <- function(.test = FALSE) { data <- teal.data::teal_data(MAE = hermes::multi_assay_experiment) app <- teal::init( data = data, modules = teal::modules( tm_g_volcanoplot( label = "volcanoplot", - mae_name = "MAE" + mae_name = "MAE", + .test = .test ) ) ) diff --git a/man/module_arguments.Rd b/man/module_arguments.Rd index 465c1ed0..b0a8f65b 100644 --- a/man/module_arguments.Rd +++ b/man/module_arguments.Rd @@ -58,6 +58,8 @@ and maximum plot height.} and maximum plot width.} \item{filter_panel_api}{(\code{FilterPanelAPI})\cr object describing the actual filter panel API.} + +\item{.test}{(\code{flag})\cr whether to display the internal structure of the plot for testing purposes.} } \description{ The documentation to this function lists all the conventional arguments in diff --git a/man/tm_g_barplot.Rd b/man/tm_g_barplot.Rd index eddfa0e0..d807fc42 100644 --- a/man/tm_g_barplot.Rd +++ b/man/tm_g_barplot.Rd @@ -14,10 +14,18 @@ tm_g_barplot( summary_funs = list(Mean = colMeans, Median = matrixStats::colMedians, Max = matrixStats::colMaxs), pre_output = NULL, - post_output = NULL + post_output = NULL, + .test = FALSE ) -ui_g_barplot(id, mae_name, summary_funs, pre_output, post_output) +ui_g_barplot( + id, + mae_name, + summary_funs, + pre_output, + post_output, + .test = FALSE +) srv_g_barplot( id, @@ -26,10 +34,11 @@ srv_g_barplot( reporter, mae_name, exclude_assays, - summary_funs + summary_funs, + .test = FALSE ) -sample_tm_g_barplot() +sample_tm_g_barplot(.test = FALSE) } \arguments{ \item{label}{(\code{string})\cr @@ -52,6 +61,8 @@ placed before the output to put the output into context (for example a title).} placed after the output to put the output into context (for example the \code{\link[shiny:helpText]{shiny::helpText()}} elements can be useful).} +\item{.test}{(\code{flag})\cr whether to display the internal structure of the plot for testing purposes.} + \item{id}{(\code{string}) the shiny module id.} \item{data}{(\code{reactive})\cr diff --git a/man/tm_g_boxplot.Rd b/man/tm_g_boxplot.Rd index a5a4dff0..026b5a3f 100644 --- a/man/tm_g_boxplot.Rd +++ b/man/tm_g_boxplot.Rd @@ -14,10 +14,18 @@ tm_g_boxplot( summary_funs = list(None = NULL, Mean = colMeans, Median = matrixStats::colMedians, Max = matrixStats::colMaxs), pre_output = NULL, - post_output = NULL + post_output = NULL, + .test = FALSE ) -ui_g_boxplot(id, mae_name, summary_funs, pre_output, post_output) +ui_g_boxplot( + id, + mae_name, + summary_funs, + pre_output, + post_output, + .test = FALSE +) srv_g_boxplot( id, @@ -26,10 +34,11 @@ srv_g_boxplot( reporter, mae_name, exclude_assays, - summary_funs + summary_funs, + .test = FALSE ) -sample_tm_g_boxplot() +sample_tm_g_boxplot(.test = FALSE) } \arguments{ \item{label}{(\code{string})\cr @@ -52,6 +61,8 @@ placed before the output to put the output into context (for example a title).} placed after the output to put the output into context (for example the \code{\link[shiny:helpText]{shiny::helpText()}} elements can be useful).} +\item{.test}{(\code{flag})\cr whether to display the internal structure of the plot for testing purposes.} + \item{id}{(\code{string}) the shiny module id.} \item{data}{(\code{reactive})\cr diff --git a/man/tm_g_forest_tte.Rd b/man/tm_g_forest_tte.Rd index f28a15a8..556368cf 100644 --- a/man/tm_g_forest_tte.Rd +++ b/man/tm_g_forest_tte.Rd @@ -19,7 +19,8 @@ tm_g_forest_tte( pre_output = NULL, post_output = NULL, plot_height = c(600L, 200L, 2000L), - plot_width = c(1360L, 500L, 2000L) + plot_width = c(1360L, 500L, 2000L), + .test = FALSE ) ui_g_forest_tte( @@ -28,7 +29,8 @@ ui_g_forest_tte( mae_name, summary_funs, pre_output, - post_output + post_output, + .test = FALSE ) srv_g_forest_tte( @@ -42,10 +44,11 @@ srv_g_forest_tte( exclude_assays, summary_funs, plot_height, - plot_width + plot_width, + .test = FALSE ) -sample_tm_g_forest_tte() +sample_tm_g_forest_tte(.test = FALSE) } \arguments{ \item{label}{(\code{string})\cr @@ -90,6 +93,8 @@ and maximum plot height.} \item{plot_width}{(\code{list})\cr list of integers to set the default, minimum, and maximum plot width.} +\item{.test}{(\code{flag})\cr whether to display the internal structure of the plot for testing purposes.} + \item{id}{(\code{string}) the shiny module id.} \item{data}{(\code{reactive})\cr diff --git a/man/tm_g_km.Rd b/man/tm_g_km.Rd index acd0392b..76f52305 100644 --- a/man/tm_g_km.Rd +++ b/man/tm_g_km.Rd @@ -17,10 +17,19 @@ tm_g_km( summary_funs = list(Mean = colMeans, Median = matrixStats::colMedians, Max = matrixStats::colMaxs), pre_output = NULL, - post_output = NULL + post_output = NULL, + .test = FALSE ) -ui_g_km(id, adtte_name, mae_name, summary_funs, pre_output, post_output) +ui_g_km( + id, + adtte_name, + mae_name, + summary_funs, + pre_output, + post_output, + .test = FALSE +) srv_g_km( id, @@ -31,10 +40,11 @@ srv_g_km( mae_name, adtte_vars, summary_funs, - exclude_assays + exclude_assays, + .test = FALSE ) -sample_tm_g_km() +sample_tm_g_km(.test = FALSE) } \arguments{ \item{label}{(\code{string})\cr @@ -73,6 +83,8 @@ placed before the output to put the output into context (for example a title).} placed after the output to put the output into context (for example the \code{\link[shiny:helpText]{shiny::helpText()}} elements can be useful).} +\item{.test}{(\code{flag})\cr whether to display the internal structure of the plot for testing purposes.} + \item{id}{(\code{string}) the shiny module id.} \item{data}{(\code{reactive})\cr diff --git a/man/tm_g_pca.Rd b/man/tm_g_pca.Rd index 7eae7ac1..01ed0ddc 100644 --- a/man/tm_g_pca.Rd +++ b/man/tm_g_pca.Rd @@ -12,14 +12,23 @@ tm_g_pca( mae_name, exclude_assays = character(), pre_output = NULL, - post_output = NULL + post_output = NULL, + .test = FALSE ) -ui_g_pca(id, mae_name, pre_output, post_output) +ui_g_pca(id, mae_name, pre_output, post_output, .test = FALSE) -srv_g_pca(id, data, filter_panel_api, reporter, mae_name, exclude_assays) +srv_g_pca( + id, + data, + filter_panel_api, + reporter, + mae_name, + exclude_assays, + .test = FALSE +) -sample_tm_g_pca() +sample_tm_g_pca(.test = FALSE) } \arguments{ \item{label}{(\code{string})\cr @@ -38,6 +47,8 @@ placed before the output to put the output into context (for example a title).} placed after the output to put the output into context (for example the \code{\link[shiny:helpText]{shiny::helpText()}} elements can be useful).} +\item{.test}{(\code{flag})\cr whether to display the internal structure of the plot for testing purposes.} + \item{id}{(\code{string}) the shiny module id.} \item{data}{(\code{reactive})\cr diff --git a/man/tm_g_quality.Rd b/man/tm_g_quality.Rd index 09851bd3..b42fe09f 100644 --- a/man/tm_g_quality.Rd +++ b/man/tm_g_quality.Rd @@ -12,14 +12,23 @@ tm_g_quality( mae_name, exclude_assays = character(), pre_output = NULL, - post_output = NULL + post_output = NULL, + .test = FALSE ) -ui_g_quality(id, mae_name, pre_output, post_output) +ui_g_quality(id, mae_name, pre_output, post_output, .test = FALSE) -srv_g_quality(id, data, filter_panel_api, reporter, mae_name, exclude_assays) +srv_g_quality( + id, + data, + filter_panel_api, + reporter, + mae_name, + exclude_assays, + .test = FALSE +) -sample_tm_g_quality() +sample_tm_g_quality(.test = FALSE) } \arguments{ \item{label}{(\code{string})\cr @@ -38,6 +47,8 @@ placed before the output to put the output into context (for example a title).} placed after the output to put the output into context (for example the \code{\link[shiny:helpText]{shiny::helpText()}} elements can be useful).} +\item{.test}{(\code{flag})\cr whether to display the internal structure of the plot for testing purposes.} + \item{id}{(\code{string}) the shiny module id.} \item{data}{(\code{reactive})\cr diff --git a/man/tm_g_scatterplot.Rd b/man/tm_g_scatterplot.Rd index f49e3db2..f6cb038a 100644 --- a/man/tm_g_scatterplot.Rd +++ b/man/tm_g_scatterplot.Rd @@ -14,10 +14,18 @@ tm_g_scatterplot( summary_funs = list(Mean = colMeans, Median = matrixStats::colMedians, Max = matrixStats::colMaxs), pre_output = NULL, - post_output = NULL + post_output = NULL, + .test = FALSE ) -ui_g_scatterplot(id, mae_name, summary_funs, pre_output, post_output) +ui_g_scatterplot( + id, + mae_name, + summary_funs, + pre_output, + post_output, + .test = FALSE +) srv_g_scatterplot( id, @@ -26,10 +34,11 @@ srv_g_scatterplot( reporter, mae_name, exclude_assays, - summary_funs + summary_funs, + .test = FALSE ) -sample_tm_g_scatterplot() +sample_tm_g_scatterplot(.test = FALSE) } \arguments{ \item{label}{(\code{string})\cr @@ -52,6 +61,8 @@ placed before the output to put the output into context (for example a title).} placed after the output to put the output into context (for example the \code{\link[shiny:helpText]{shiny::helpText()}} elements can be useful).} +\item{.test}{(\code{flag})\cr whether to display the internal structure of the plot for testing purposes.} + \item{id}{(\code{string}) the shiny module id.} \item{data}{(\code{reactive})\cr diff --git a/man/tm_g_volcanoplot.Rd b/man/tm_g_volcanoplot.Rd index 295180aa..340b8863 100644 --- a/man/tm_g_volcanoplot.Rd +++ b/man/tm_g_volcanoplot.Rd @@ -12,10 +12,11 @@ tm_g_volcanoplot( mae_name, exclude_assays = character(), pre_output = NULL, - post_output = NULL + post_output = NULL, + .test = FALSE ) -ui_g_volcanoplot(id, mae_name, pre_output, post_output) +ui_g_volcanoplot(id, mae_name, pre_output, post_output, .test = FALSE) srv_g_volcanoplot( id, @@ -23,10 +24,11 @@ srv_g_volcanoplot( filter_panel_api, reporter, mae_name, - exclude_assays + exclude_assays, + .test = FALSE ) -sample_tm_g_volcanoplot() +sample_tm_g_volcanoplot(.test = FALSE) } \arguments{ \item{label}{(\code{string})\cr @@ -45,6 +47,8 @@ placed before the output to put the output into context (for example a title).} placed after the output to put the output into context (for example the \code{\link[shiny:helpText]{shiny::helpText()}} elements can be useful).} +\item{.test}{(\code{flag})\cr whether to display the internal structure of the plot for testing purposes.} + \item{id}{(\code{string}) the shiny module id.} \item{data}{(\code{reactive})\cr diff --git a/tests/testthat/_snaps/barplot.md b/tests/testthat/_snaps/barplot.md new file mode 100644 index 00000000..1340fd5c --- /dev/null +++ b/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 + diff --git a/tests/testthat/_snaps/boxplot.md b/tests/testthat/_snaps/boxplot.md new file mode 100644 index 00000000..ab184a4f --- /dev/null +++ b/tests/testthat/_snaps/boxplot.md @@ -0,0 +1,28 @@ +# boxplot module works as expected in the test app + + Code + cat(res) + Output + 'data.frame': 512 obs. of 21 variables: + $ fill : chr "#F8766D" "#F8766D" "#F8766D" "#F8766D" ... + $ x : 'mapped_discrete' num 1 1 1 1 1 1 1 1 1 1 ... + $ density : num 0.000161 0.000161 0.000161 0.00016 0.00016 ... + $ scaled : num 0.492 0.492 0.492 0.492 0.492 ... + $ ndensity : num 0.492 0.492 0.492 0.492 0.492 ... + $ count : num 0.000642 0.000642 0.000642 0.000642 0.000641 ... + $ n : int 4 4 4 4 4 4 4 4 4 4 ... + $ y : num 650 659 667 676 684 ... + $ PANEL : Factor w/ 1 level "1": 1 1 1 1 1 1 1 1 1 1 ... + $ group : int 1 1 1 1 1 1 1 1 1 1 ... + $ violinwidth: num 0.492 0.492 0.492 0.492 0.492 ... + $ flipped_aes: logi FALSE FALSE FALSE FALSE FALSE FALSE ... + $ width : num 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 ... + $ xmin : 'mapped_discrete' num 0.55 0.55 0.55 0.55 0.55 0.55 0.55 0.55 0.55 0.55 ... + $ xmax : 'mapped_discrete' num 1.45 1.45 1.45 1.45 1.45 1.45 1.45 1.45 1.45 1.45 ... + $ ymax : num 650 659 667 676 684 ... + $ weight : num 1 1 1 1 1 1 1 1 1 1 ... + $ colour : chr "grey20" "grey20" "grey20" "grey20" ... + $ linewidth : num 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 ... + $ alpha : logi NA NA NA NA NA NA ... + $ linetype : chr "solid" "solid" "solid" "solid" ... + diff --git a/tests/testthat/_snaps/forest.md b/tests/testthat/_snaps/forest.md new file mode 100644 index 00000000..48d05924 --- /dev/null +++ b/tests/testthat/_snaps/forest.md @@ -0,0 +1,12 @@ +# forest_tte module works as expected in the test app + + Code + cat(res) + Output + spl_var_1 spl_value_1 avar_name row_name label_name row_num + 1 row_type content All Patients All Patients 1 + is_group_summary node_class V1 V2 V3 V4 V5 V6 V7 + 1 TRUE ContentRow 6 5 3 420.3845.... 4 3 248.5370.... + V8 V9 + 1 5.693846.... 0.587431.... + diff --git a/tests/testthat/_snaps/km.md b/tests/testthat/_snaps/km.md new file mode 100644 index 00000000..32ea74b0 --- /dev/null +++ b/tests/testthat/_snaps/km.md @@ -0,0 +1,260 @@ +# km module works as expected in the test app + + Code + cat(res) + Output + $binned_adtte + USUBJID low_depth_flag tech_failure_flag Filename + 3 AB12345-CHN-1-id-307 FALSE FALSE eset + 9 AB12345-CHN-15-id-201 FALSE FALSE eset + 11 AB12345-CHN-4-id-73 FALSE FALSE eset + 18 AB12345-CHN-7-id-28 FALSE FALSE eset + 24 AB12345-NGA-11-id-173 TRUE FALSE eset + 30 AB12345-PAK-11-id-268 FALSE FALSE eset + 34 AB12345-RUS-1-id-52 FALSE FALSE eset + 39 AB12345-USA-1-id-261 FALSE FALSE eset + 41 AB12345-USA-1-id-45 FALSE FALSE eset + AGEGRP AGE18 STDDRS + 3 12 - <18 years < 18 DEATH + 9 >= 18 years >= 18 DEATH + 11 6 - <12 years < 18 DEATH + 18 12 - <18 years < 18 + 24 6 - <12 years < 18 DEATH + 30 >= 18 years >= 18 WITHDRAWAL BY SUBJECT + 34 6 - <12 years < 18 DEATH + 39 12 - <18 years < 18 + 41 >= 18 years >= 18 DEATH + STDDRSD STDSSDT TRTDRS + 3 DEATH DUE TO PROGRESSION OF DISEASE 07/24/2016 PROGRESSIVE DISEASE + 9 DEATH DUE TO PROGRESSION OF DISEASE 08/12/2016 PROGRESSIVE DISEASE + 11 DEATH DUE TO PROGRESSION OF DISEASE 04/19/2016 PROGRESSIVE DISEASE + 18 PROGRESSIVE DISEASE + 24 DEATH DUE TO PROGRESSION OF DISEASE 09/11/2016 PROGRESSIVE DISEASE + 30 WITHDRAWAL BY SUBJECT 07/05/2016 WITHDRAWAL BY SUBJECT + 34 DEATH DUE TO PROGRESSION OF DISEASE 10/23/2016 PROGRESSIVE DISEASE + 39 PROGRESSIVE DISEASE + 41 DEATH DUE TO PROGRESSION OF DISEASE 01/08/2016 PROGRESSIVE DISEASE + TRTDRSD BHDCIRC BHDCIRCU ADAFL BLANP BKPS BLKS BTANNER + 3 PROGRESSION OF DISEASE NA Y NA 80 80 NA + 9 PROGRESSION OF DISEASE NA Y NA 90 90 NA + 11 PROGRESSION OF DISEASE NA Y 70 NA 70 NA + 18 PROGRESSION OF DISEASE NA Y NA 90 90 NA + 24 PROGRESSION OF DISEASE NA Y NA 100 100 NA + 30 WITHDRAWAL BY SUBJECT NA Y 70 NA 70 NA + 34 PROGRESSION OF DISEASE NA Y 100 NA 100 NA + 39 PROGRESSION OF DISEASE NA Y NA 90 90 NA + 41 PROGRESSION OF DISEASE NA Y NA 90 90 NA + FRPST DURIDX DURSAF DURSUR LNTHRPY AENCIFL STUDYID + 3 POST-MENARCHAL 61.66735 1.6755647 5.1581109 5 NA AB12345 + 9 10.84189 0.9856263 3.0554415 4 NA AB12345 + 11 45.66735 1.6755647 3.1540041 10 NA AB12345 + 18 POST-MENARCHAL 19.54825 1.7412731 9.6919918 4 NA AB12345 + 24 99.28542 3.5811088 6.3408624 7 NA AB12345 + 30 16.09856 0.9856263 0.6899384 2 NA AB12345 + 34 PRE-MENARCHAL NA 1.6755647 10.9404517 3 NA AB12345 + 39 41.62628 1.6755647 18.8583162 3 NA AB12345 + 41 45.73306 0.6570842 2.2997947 2 NA AB12345 + RFSTDTC RFENDTC RFXSTDTC RFXENDTC + 3 2016-03-10T14:05 2016-03-31T15:49 2016-03-10T14:05 2016-03-31T15:49 + 9 2016-05-31T14:10 2016-05-31T14:10 2016-05-31T14:10 2016-05-31T14:10 + 11 2016-01-25T14:15 2016-02-15T10:40 2016-01-25T14:15 2016-02-15T10:40 + 18 2016-12-06T13:09 2016-12-29T15:46 2016-12-06T13:09 2016-12-29T15:46 + 24 2016-03-21T15:40 2016-06-08T18:00 2016-03-21T15:40 2016-06-08T18:00 + 30 2016-06-15T12:45 2016-06-15T12:45 2016-06-15T12:45 2016-06-15T12:45 + 34 2015-12-01T12:25 2015-12-22T14:10 2015-12-01T12:25 2015-12-22T14:10 + 39 2016-02-08T12:37 2016-02-29T14:15 2016-02-08T12:37 2016-02-29T14:15 + 41 2015-11-05T11:00 2015-11-05T11:00 2015-11-05T11:00 2015-11-05T11:00 + RFICDTC RFPENDTC DTHDTC DTHFL SITEID INVID AGE AGEU SEX + 3 2016-02-18 2016-07-24 2016-07-24 Y 283495 223804 12 YEARS F + 9 2016-05-11 2016-08-12 2016-08-12 Y 282087 468105 27 YEARS F + 11 2016-01-14 2016-04-19 2016-04-19 Y 280959 20842 10 YEARS F + 18 2016-11-28 282703 301818 17 YEARS M + 24 2016-03-02 2016-09-11 2016-09-11 Y 283497 241874 7 YEARS F + 30 2016-06-14 2016-07-05 283662 244110 19 YEARS F + 34 2015-11-25 2016-10-23 2016-10-23 Y 283971 235545 11 YEARS F + 39 2016-02-01 281049 457179 16 YEARS F + 41 2015-10-30 2016-01-08 2016-01-08 Y 283971 235545 19 YEARS F + RACE ETHNIC ARMCD ARM ACTARMCD + 3 WHITE NOT HISPANIC OR LATINO COH3 COHORT 3 COH3 + 9 UNKNOWN NOT REPORTED COH9E COHORT 9E COH9E + 11 UNKNOWN NOT REPORTED COH3 COHORT 3 COH3 + 18 UNKNOWN NOT REPORTED COH2 COHORT 2 COH2 + 24 BLACK OR AFRICAN AMERICAN HISPANIC OR LATINO COH6 COHORT 6 COH6 + 30 ASIAN HISPANIC OR LATINO COH6 COHORT 6 COH6 + 34 WHITE NOT HISPANIC OR LATINO COH7A COHORT 7A COH7A + 39 ASIAN NOT HISPANIC OR LATINO COH1 COHORT 1 COH1 + 41 UNKNOWN HISPANIC OR LATINO COH6 COHORT 6 COH6 + ACTARM COUNTRY DMDTC DMDY BAGE BAGEU BWT BWTU BHT BHTU BBMI + 3 COHORT 3 CHN 2016-02-18 -21 12 YEARS 50.0 kg 157 cm 20.28480 + 9 COHORT 9 CHN 2016-05-25 -6 27 YEARS 61.6 kg 173 cm 20.58204 + 11 COHORT 3 CHN 2016-01-14 -11 10 YEARS 29.4 kg 148 cm 13.42221 + 18 COHORT 2 CHN 2016-11-28 -8 17 YEARS 38.2 kg 151 cm 16.75365 + 24 COHORT 6 NGA 2016-03-02 -19 7 YEARS 53.9 kg 176 cm 17.40057 + 30 COHORT 6 PAK 2016-06-14 -1 19 YEARS 51.0 kg 152 cm 22.07410 + 34 COHORT 7 RUS 2015-11-25 -6 11 YEARS 36.2 kg 130 cm 21.42012 + 39 COHORT 1 USA 2016-02-01 -7 16 YEARS 104.7 kg 172 cm 35.39075 + 41 COHORT 6 USA 2015-10-30 -6 19 YEARS 57.0 kg 172 cm 19.26717 + ITTFL SAFFL INFCODT RANDDT TRTSDTC TRTSDTM + 3 Y Y 2016-02-18 2016-03-09 2016-03-10T14:05 2016-03-10 14:05:00 + 9 Y Y 2016-05-11 2016-05-31 2016-05-31T14:10 2016-05-31 14:10:00 + 11 Y Y 2016-01-14 2016-01-22 2016-01-25T14:15 2016-01-25 14:15:00 + 18 Y Y 2016-11-28 2016-12-02 2016-12-06T13:09 2016-12-06 13:09:00 + 24 Y Y 2016-03-02 2016-03-21 2016-03-21T15:40 2016-03-21 15:40:00 + 30 Y Y 2016-06-14 2016-06-15 2016-06-15T12:45 2016-06-15 12:45:00 + 34 Y Y 2015-11-25 2015-12-01 2015-12-01T12:25 2015-12-01 12:25:00 + 39 Y Y 2016-02-01 2016-02-03 2016-02-08T12:37 2016-02-08 12:37:00 + 41 Y Y 2015-10-30 2015-11-05 2015-11-05T11:00 2015-11-05 11:00:00 + TRTSTMF TRTEDTM TRTETMF TRTDUR DISCSTUD DISCDEAT DISCAE DISTRTFL + 3 S 2016-03-31 16:55:59 S 22 Y Y N Y + 9 S 2016-05-31 15:10:59 S 1 Y Y N Y + 11 S 2016-02-15 11:10:59 S 22 Y Y N Y + 18 S 2016-12-29 16:19:59 S 24 N N N Y + 24 S 2016-06-08 18:30:59 S 80 Y Y N Y + 30 S 2016-06-15 13:45:59 S 1 Y N N Y + 34 S 2015-12-22 14:40:59 S 22 Y Y N Y + 39 S 2016-02-29 14:48:59 S 22 N N N Y + 41 S 2015-11-05 12:00:59 S 1 Y Y N Y + AEWITHFL ALIVDT + 3 N 2016-07-24 + 9 N 2016-08-12 + 11 N 2016-04-19 + 18 N 2017-09-19 + 24 N 2016-09-11 + 30 N 2016-07-05 + 34 N 2016-10-23 + 39 N 2017-08-28 + 41 N 2016-01-08 + COHORT + 3 Cohort 3 (NEUROBLASTOMA) + 9 Cohort 9 (OTHER TUMOR TYPES WITH DOCUMENTED PD-L1 EXPRESSION) + 11 Cohort 3 (NEUROBLASTOMA) + 18 Cohort 2 (HODGKIN LYMPHOMA) + 24 Cohort 6 (OSTEOSARCOMA) + 30 Cohort 6 (OSTEOSARCOMA) + 34 Cohort 7 (RHABDOMYOSARCOMA ) + 39 Cohort 1 (EWING SARCOMA) + 41 Cohort 6 (OSTEOSARCOMA) + TTYPE + 3 NEUROBLASTOMA + 9 GERM CELL TUMOR - YOLK SAC TUMOR (ENDODERMAL SINUS TUMOR) WITH DOCUMENTED PD-L1 EXPRESSION + 11 NEUROBLASTOMA + 18 HODGKIN LYMPHOMA + 24 OSTEOSARCOMA + 30 OSTEOSARCOMA + 34 RHABDOMYOSARCOMA - ALVEOLAR + 39 EWING SARCOMA + 41 OSTEOSARCOMA + STDSSDY SUBJID Mean.ABCF2..ABO. INVNAM TRT01P + 3 137 AB12345-CHN-1-id-307 7.673103 Dr. CHN-1 Doe B: Placebo + 9 74 AB12345-CHN-15-id-201 7.433943 Dr. CHN-15 Doe C: Combination + 11 86 AB12345-CHN-4-id-73 7.856089 Dr. CHN-4 Doe A: Drug X + 18 NA AB12345-CHN-7-id-28 7.454552 Dr. CHN-7 Doe B: Placebo + 24 175 AB12345-NGA-11-id-173 7.702519 Dr. NGA-11 Doe C: Combination + 30 21 AB12345-PAK-11-id-268 7.324474 Dr. PAK-11 Doe A: Drug X + 34 328 AB12345-RUS-1-id-52 7.410471 Dr. RUS-1 Doe A: Drug X + 39 NA AB12345-USA-1-id-261 7.662349 Dr. USA-1 Doe B: Placebo + 41 65 AB12345-USA-1-id-45 7.780904 Dr. USA-1 Doe A: Drug X + TRT01A TRT02P TRT02A REGION1 STRATA1 STRATA2 + 3 B: Placebo B: Placebo C: Combination Asia C S1 + 9 C: Combination B: Placebo C: Combination Asia C S2 + 11 A: Drug X B: Placebo C: Combination Asia A S1 + 18 B: Placebo B: Placebo B: Placebo Asia C S2 + 24 C: Combination B: Placebo A: Drug X Africa C S2 + 30 A: Drug X B: Placebo A: Drug X Asia C S2 + 34 A: Drug X B: Placebo C: Combination Eurasia C S2 + 39 B: Placebo B: Placebo B: Placebo North America C S1 + 41 A: Drug X A: Drug X A: Drug X North America C S1 + BMRKR1 BMRKR2 BMEASIFL BEP01FL TRT01SDTM TRT01EDTM + 3 4.5749910 LOW Y N 2019-03-11 08:01:26 2021-02-18 02:48:40 + 9 6.9067988 MEDIUM Y N 2019-03-05 15:24:07 2021-02-18 22:06:48 + 11 2.8631240 MEDIUM Y Y 2019-03-17 14:18:17 2021-02-14 13:35:43 + 18 11.1444470 MEDIUM N N 2019-03-11 09:11:52 2021-03-10 21:11:52 + 24 4.9972257 LOW Y Y 2019-03-10 09:35:30 2021-03-09 21:35:30 + 30 2.8201408 MEDIUM N N 2019-03-21 23:53:53 2021-03-21 11:53:53 + 34 7.2063482 HIGH N N 2019-03-18 09:38:55 2021-02-13 06:30:28 + 39 2.8551642 HIGH Y N 2019-03-06 17:21:21 2021-03-06 05:21:21 + 41 0.4635604 LOW N N 2019-03-06 06:32:29 2021-03-05 18:32:29 + TRT02SDTM TRT02EDTM AP01SDTM + 3 2021-02-18 02:48:40 2022-02-18 08:48:40 2019-03-11 08:01:26 + 9 2021-02-18 22:06:48 2022-02-19 04:06:48 2019-03-05 15:24:07 + 11 2021-02-14 13:35:43 2022-02-14 19:35:43 2019-03-17 14:18:17 + 18 2021-03-10 21:11:52 2022-03-11 03:11:52 2019-03-11 09:11:52 + 24 2021-03-09 21:35:30 2022-03-10 03:35:30 2019-03-10 09:35:30 + 30 2021-03-21 11:53:53 2022-03-21 17:53:53 2019-03-21 23:53:53 + 34 2021-02-13 06:30:28 2022-02-13 12:30:28 2019-03-18 09:38:55 + 39 2021-03-06 05:21:21 2022-03-06 11:21:21 2019-03-06 17:21:21 + 41 2021-03-05 18:32:29 2022-03-06 00:32:29 2019-03-06 06:32:29 + AP01EDTM AP02SDTM AP02EDTM EOSSTT + 3 2021-02-18 02:48:40 2021-02-18 02:48:40 2022-02-18 08:48:40 DISCONTINUED + 9 2021-02-18 22:06:48 2021-02-18 22:06:48 2022-02-19 04:06:48 DISCONTINUED + 11 2021-02-14 13:35:43 2021-02-14 13:35:43 2022-02-14 19:35:43 DISCONTINUED + 18 2021-03-10 21:11:52 2021-03-10 21:11:52 2022-03-11 03:11:52 COMPLETED + 24 2021-03-09 21:35:30 2021-03-09 21:35:30 2022-03-10 03:35:30 COMPLETED + 30 2021-03-21 11:53:53 2021-03-21 11:53:53 2022-03-21 17:53:53 COMPLETED + 34 2021-02-13 06:30:28 2021-02-13 06:30:28 2022-02-13 12:30:28 DISCONTINUED + 39 2021-03-06 05:21:21 2021-03-06 05:21:21 2022-03-06 11:21:21 COMPLETED + 41 2021-03-05 18:32:29 2021-03-05 18:32:29 2022-03-06 00:32:29 COMPLETED + EOTSTT EOSDT EOSDY DCSREAS DTHDT + 3 DISCONTINUED 2022-02-18 1076 DEATH 2022-04-06 + 9 DISCONTINUED 2022-02-19 1082 DEATH 2022-02-22 + 11 DISCONTINUED 2022-02-14 1066 LACK OF EFFICACY + 18 COMPLETED 2022-03-11 1096 + 24 COMPLETED 2022-03-10 1096 + 30 COMPLETED 2022-03-21 1096 + 34 DISCONTINUED 2022-02-13 1064 DEATH 2022-02-20 + 39 COMPLETED 2022-03-06 1096 + 41 COMPLETED 2022-03-06 1096 + DTHCAUS DTHCAT LDDTHELD LDDTHGR1 LSTALVDT DTHADY + 3 LOST TO FOLLOW UP OTHER 47 >30 2022-04-06 1121 + 9 ADVERSE EVENT ADVERSE EVENT 3 <=30 2022-02-22 1084 + 11 NA 2022-03-07 NA + 18 NA 2022-03-31 NA + 24 NA 2022-03-30 NA + 30 NA 2022-04-02 NA + 34 DISEASE PROGRESSION PROGRESSIVE DISEASE 7 <=30 2022-02-20 1069 + 39 NA 2022-03-30 NA + 41 NA 2022-03-30 NA + ADTHAUT ASEQ TTESEQ PARAM PARAMCD AVAL AVALU + 3 4 4 Progression Free Survival PFS 239.08590 DAYS + 9 Yes 2 2 Progression Free Survival PFS 248.53707 DAYS + 11 3 3 Progression Free Survival PFS 420.38459 DAYS + 18 3 3 Progression Free Survival PFS 30.04978 DAYS + 24 2 2 Progression Free Survival PFS 382.86110 DAYS + 30 1 1 Progression Free Survival PFS 326.40156 DAYS + 34 Yes 1 1 Progression Free Survival PFS 45.07870 DAYS + 39 2 2 Progression Free Survival PFS 899.41424 DAYS + 41 3 3 Progression Free Survival PFS 131.76520 DAYS + ADTM ADY CNSR EVNTDESC + 3 2022-02-16 08:01:26 1073 1 Last Tumor Assessment + 9 2020-04-05 15:24:07 397 0 Disease Progression + 11 2020-09-20 14:18:17 553 0 Death + 18 2020-10-02 09:11:52 571 1 Last Date Known To Be Alive + 24 2021-09-04 09:35:30 909 0 Disease Progression + 30 2019-12-14 23:53:53 268 1 Last Tumor Assessment + 34 2019-11-14 09:38:55 241 0 Disease Progression + 39 2020-07-15 17:21:21 497 0 Death + 41 2020-06-28 06:32:29 480 0 Death + CNSDTDSC lgTMATRSK is_event gene_factor + 3 Clinical Cut Off NA FALSE (50%,100%] + 9 NA TRUE [0%,50%] + 11 NA TRUE (50%,100%] + 18 Clinical Cut Off NA FALSE [0%,50%] + 24 NA TRUE (50%,100%] + 30 End of AE Reporting Period NA FALSE [0%,50%] + 34 NA TRUE [0%,50%] + 39 NA TRUE [0%,50%] + 41 NA TRUE (50%,100%] + + $variables + $variables$tte + [1] "AVAL" + + $variables$is_event + [1] "is_event" + + $variables$arm + [1] "gene_factor" + + $variables$strat + NULL + diff --git a/tests/testthat/_snaps/pca.md b/tests/testthat/_snaps/pca.md new file mode 100644 index 00000000..a3bee8c6 --- /dev/null +++ b/tests/testthat/_snaps/pca.md @@ -0,0 +1,110 @@ +# pca module works as expected in the test app + + Code + cat(res) + Output + x y PANEL group shape colour size fill alpha stroke + 1 -0.27038787 -0.3961520 1 -1 19 black 1.5 NA NA 0.5 + 2 -0.01264326 -0.5281983 1 -1 19 black 1.5 NA NA 0.5 + 3 0.02108020 0.4483209 1 -1 19 black 1.5 NA NA 0.5 + 4 -0.45723243 0.3957750 1 -1 19 black 1.5 NA NA 0.5 + 5 0.71918335 0.0802544 1 -1 19 black 1.5 NA NA 0.5 + +--- + + Code + cat(res) + Output + low_depth_flag AGE18 STDDRS STDDRSD TRTDRS TRTDRSD BLANP BLKS FRPST DURIDX + PC1 0.001 0.114 0.230 0.230 0.114 0.114 0.001 0.001 0.327 0.029 + PC2 0.314 0.245 0.018 0.018 0.245 0.245 0.390 0.314 0.245 0.206 + PC3 0.532 0.115 0.001 0.001 0.115 0.115 0.994 0.532 0.197 0.761 + PC4 0.153 0.526 0.751 0.751 0.526 0.526 0.181 0.153 0.231 0.004 + DURSAF DURSUR LNTHRPY DTHFL SITEID INVID AGE SEX ETHNIC COUNTRY DMDY + PC1 0.070 0.177 0.936 0.230 0.667 0.497 0.000 0.083 0.000 0.001 0.029 + PC2 0.114 0.357 0.014 0.018 0.137 0.021 0.147 0.890 0.436 0.314 0.178 + PC3 0.392 0.046 0.027 0.001 0.059 0.367 0.419 0.013 0.227 0.532 0.546 + PC4 0.424 0.420 0.023 0.751 0.137 0.116 0.434 0.014 0.337 0.153 0.247 + BAGE BWT BHT BBMI TRTDUR DISCSTUD DISCDEAT AEWITHFL STDSSDY + PC1 0.000 0.104 0.114 0.131 0.070 0.230 0.230 0.114 0.921 + PC2 0.147 0.744 0.745 0.655 0.114 0.018 0.018 0.245 0.019 + PC3 0.419 0.018 0.013 0.182 0.392 0.001 0.001 0.115 0.322 + PC4 0.434 0.134 0.128 0.032 0.424 0.751 0.751 0.526 0.913 + +--- + + Code + cat(res) + Output + NULL + +--- + + Code + cat(res) + Output + x y PANEL group shape colour size fill alpha stroke + 1 -0.68789565 0.04912578 1 -1 19 black 1.5 NA NA 0.5 + 2 -0.37824954 0.19209841 1 -1 19 black 1.5 NA NA 0.5 + 3 0.07502276 -0.31568702 1 -1 19 black 1.5 NA NA 0.5 + 4 0.33995282 -0.26532014 1 -1 19 black 1.5 NA NA 0.5 + 5 0.29004708 0.25038379 1 -1 19 black 1.5 NA NA 0.5 + 6 0.08718694 0.09422278 1 -1 19 black 1.5 NA NA 0.5 + 7 0.15015883 0.07932206 1 -1 19 black 1.5 NA NA 0.5 + 8 -0.05952522 -0.58893592 1 -1 19 black 1.5 NA NA 0.5 + 9 0.18330198 0.50479025 1 -1 19 black 1.5 NA NA 0.5 + +--- + + Code + cat(res) + Output + colour x y PANEL group shape size fill alpha stroke + 1 #F8766D -0.08263642 0.6615253 1 1 19 1.5 NA NA 0.5 + 2 #F8766D -0.53157947 -0.4023279 1 1 19 1.5 NA NA 0.5 + 3 #F8766D 0.61421589 -0.2591974 1 1 19 1.5 NA NA 0.5 + +--- + + Code + cat(res) + Output + colour x y PANEL group shape size fill alpha stroke + 1 #00BFC4 -0.3939882 0.32024986 1 2 19 1.5 NA NA 0.5 + 2 #F8766D -0.1255252 0.50888177 1 1 19 1.5 NA NA 0.5 + 3 #F8766D 0.1611973 -0.32722537 1 1 19 1.5 NA NA 0.5 + 4 #F8766D -0.3398973 -0.57145897 1 1 19 1.5 NA NA 0.5 + 5 #F8766D 0.6982134 0.06955271 1 1 19 1.5 NA NA 0.5 + +--- + + Code + cat(res) + Output + colour x y PANEL group shape size fill alpha stroke + 1 #00BFC4 -0.41921977 0.41965983 1 2 19 1.5 NA NA 0.5 + 2 #00BFC4 -0.26002371 -0.20051106 1 2 19 1.5 NA NA 0.5 + 3 #F8766D -0.02075864 -0.03308131 1 1 19 1.5 NA NA 0.5 + 4 #F8766D 0.08391280 -0.38171401 1 1 19 1.5 NA NA 0.5 + 5 #F8766D 0.56237459 0.46597929 1 1 19 1.5 NA NA 0.5 + 6 #F8766D -0.35360914 0.33020146 1 1 19 1.5 NA NA 0.5 + 7 #F8766D 0.42405052 0.02619397 1 1 19 1.5 NA NA 0.5 + 8 #F8766D 0.08327651 -0.34886025 1 1 19 1.5 NA NA 0.5 + 9 #00BFC4 -0.10000316 -0.27786790 1 2 19 1.5 NA NA 0.5 + +--- + + Code + cat(res) + Output + colour x y PANEL group shape size fill alpha stroke + 1 #00BFC4 -0.41921977 0.41965983 1 2 19 1.5 NA NA 0.5 + 2 #00BFC4 -0.26002371 -0.20051106 1 2 19 1.5 NA NA 0.5 + 3 #F8766D -0.02075864 -0.03308131 1 1 19 1.5 NA NA 0.5 + 4 #F8766D 0.08391280 -0.38171401 1 1 19 1.5 NA NA 0.5 + 5 #F8766D 0.56237459 0.46597929 1 1 19 1.5 NA NA 0.5 + 6 #F8766D -0.35360914 0.33020146 1 1 19 1.5 NA NA 0.5 + 7 #F8766D 0.42405052 0.02619397 1 1 19 1.5 NA NA 0.5 + 8 #F8766D 0.08327651 -0.34886025 1 1 19 1.5 NA NA 0.5 + 9 #00BFC4 -0.10000316 -0.27786790 1 2 19 1.5 NA NA 0.5 + diff --git a/tests/testthat/_snaps/quality.md b/tests/testthat/_snaps/quality.md new file mode 100644 index 00000000..d4e51c85 --- /dev/null +++ b/tests/testthat/_snaps/quality.md @@ -0,0 +1,111 @@ +# quality module works as expected in the test app + + Code + res + Output + $message + [1] "Please change gene filters to ensure that there are at least 2 genes" + + $call + [1] "NULL" + + $type + [1] "shiny.silent.error" "validation" + + +--- + + Code + cat(res) + Output + y count x xmin xmax density ncount ndensity flipped_aes + 1 1 1 1781977 1772292 1791661 8.604677e-06 1 1 FALSE + 2 0 0 1801346 1791661 1811031 0.000000e+00 0 0 FALSE + 3 0 0 1820715 1811031 1830400 0.000000e+00 0 0 FALSE + 4 1 1 1840084 1830400 1849769 8.604677e-06 1 1 FALSE + 5 1 1 1859454 1849769 1869138 8.604677e-06 1 1 FALSE + 6 0 0 1878823 1869138 1888508 0.000000e+00 0 0 FALSE + 7 0 0 1898192 1888508 1907877 0.000000e+00 0 0 FALSE + 8 0 0 1917562 1907877 1927246 0.000000e+00 0 0 FALSE + 9 0 0 1936931 1927246 1946616 0.000000e+00 0 0 FALSE + 10 0 0 1956300 1946616 1965985 0.000000e+00 0 0 FALSE + 11 1 1 1975670 1965985 1985354 8.604677e-06 1 1 FALSE + 12 0 0 1995039 1985354 2004724 0.000000e+00 0 0 FALSE + 13 0 0 2014408 2004724 2024093 0.000000e+00 0 0 FALSE + 14 0 0 2033778 2024093 2043462 0.000000e+00 0 0 FALSE + 15 0 0 2053147 2043462 2062832 0.000000e+00 0 0 FALSE + 16 0 0 2072516 2062832 2082201 0.000000e+00 0 0 FALSE + 17 0 0 2091886 2082201 2101570 0.000000e+00 0 0 FALSE + 18 0 0 2111255 2101570 2120939 0.000000e+00 0 0 FALSE + 19 1 1 2130624 2120939 2140309 8.604677e-06 1 1 FALSE + 20 0 0 2149993 2140309 2159678 0.000000e+00 0 0 FALSE + 21 0 0 2169363 2159678 2179047 0.000000e+00 0 0 FALSE + 22 0 0 2188732 2179047 2198417 0.000000e+00 0 0 FALSE + 23 0 0 2208101 2198417 2217786 0.000000e+00 0 0 FALSE + 24 0 0 2227471 2217786 2237155 0.000000e+00 0 0 FALSE + 25 0 0 2246840 2237155 2256525 0.000000e+00 0 0 FALSE + 26 0 0 2266209 2256525 2275894 0.000000e+00 0 0 FALSE + 27 0 0 2285579 2275894 2295263 0.000000e+00 0 0 FALSE + 28 0 0 2304948 2295263 2314633 0.000000e+00 0 0 FALSE + 29 0 0 2324317 2314633 2334002 0.000000e+00 0 0 FALSE + 30 1 1 2343687 2334002 2353371 8.604677e-06 1 1 FALSE + PANEL group ymin ymax colour fill linewidth linetype alpha + 1 1 -1 0 1 NA darkgrey 0.5 1 NA + 2 1 -1 0 0 NA darkgrey 0.5 1 NA + 3 1 -1 0 0 NA darkgrey 0.5 1 NA + 4 1 -1 0 1 NA darkgrey 0.5 1 NA + 5 1 -1 0 1 NA darkgrey 0.5 1 NA + 6 1 -1 0 0 NA darkgrey 0.5 1 NA + 7 1 -1 0 0 NA darkgrey 0.5 1 NA + 8 1 -1 0 0 NA darkgrey 0.5 1 NA + 9 1 -1 0 0 NA darkgrey 0.5 1 NA + 10 1 -1 0 0 NA darkgrey 0.5 1 NA + 11 1 -1 0 1 NA darkgrey 0.5 1 NA + 12 1 -1 0 0 NA darkgrey 0.5 1 NA + 13 1 -1 0 0 NA darkgrey 0.5 1 NA + 14 1 -1 0 0 NA darkgrey 0.5 1 NA + 15 1 -1 0 0 NA darkgrey 0.5 1 NA + 16 1 -1 0 0 NA darkgrey 0.5 1 NA + 17 1 -1 0 0 NA darkgrey 0.5 1 NA + 18 1 -1 0 0 NA darkgrey 0.5 1 NA + 19 1 -1 0 1 NA darkgrey 0.5 1 NA + 20 1 -1 0 0 NA darkgrey 0.5 1 NA + 21 1 -1 0 0 NA darkgrey 0.5 1 NA + 22 1 -1 0 0 NA darkgrey 0.5 1 NA + 23 1 -1 0 0 NA darkgrey 0.5 1 NA + 24 1 -1 0 0 NA darkgrey 0.5 1 NA + 25 1 -1 0 0 NA darkgrey 0.5 1 NA + 26 1 -1 0 0 NA darkgrey 0.5 1 NA + 27 1 -1 0 0 NA darkgrey 0.5 1 NA + 28 1 -1 0 0 NA darkgrey 0.5 1 NA + 29 1 -1 0 0 NA darkgrey 0.5 1 NA + 30 1 -1 0 1 NA darkgrey 0.5 1 NA + +--- + + Code + cat(res) + Output + x y PANEL group flipped_aes ymin ymax xmin xmax colour fill + 1 1 17.72389 1 1 FALSE 0 17.72389 0.55 1.45 NA grey35 + 2 2 14.37759 1 2 FALSE 0 14.37759 1.55 2.45 NA grey35 + 3 3 14.20068 1 3 FALSE 0 14.20068 2.55 3.45 NA grey35 + 4 4 14.17412 1 4 FALSE 0 14.17412 3.55 4.45 NA grey35 + 5 5 14.01385 1 5 FALSE 0 14.01385 4.55 5.45 NA grey35 + 6 6 13.44916 1 6 FALSE 0 13.44916 5.55 6.45 NA grey35 + 7 7 13.27510 1 7 FALSE 0 13.27510 6.55 7.45 NA grey35 + 8 8 13.17301 1 8 FALSE 0 13.17301 7.55 8.45 NA grey35 + 9 9 13.03098 1 9 FALSE 0 13.03098 8.55 9.45 NA grey35 + 10 10 12.93251 1 10 FALSE 0 12.93251 9.55 10.45 NA grey35 + linewidth linetype alpha + 1 0.5 1 NA + 2 0.5 1 NA + 3 0.5 1 NA + 4 0.5 1 NA + 5 0.5 1 NA + 6 0.5 1 NA + 7 0.5 1 NA + 8 0.5 1 NA + 9 0.5 1 NA + 10 0.5 1 NA + diff --git a/tests/testthat/_snaps/scatterplot.md b/tests/testthat/_snaps/scatterplot.md new file mode 100644 index 00000000..7695afd4 --- /dev/null +++ b/tests/testthat/_snaps/scatterplot.md @@ -0,0 +1,5 @@ +# scatterplot module works as expected in the test app + + Code + cat(res) + diff --git a/tests/testthat/_snaps/volcanoplot.md b/tests/testthat/_snaps/volcanoplot.md new file mode 100644 index 00000000..293332dc --- /dev/null +++ b/tests/testthat/_snaps/volcanoplot.md @@ -0,0 +1,10 @@ +# volcanoplot module works as expected in the test app + + Code + cat(res) + +--- + + Code + cat(res) + diff --git a/tests/testthat/_snaps/windows-4.3/scatterplot/scatterplot-001.new.png b/tests/testthat/_snaps/windows-4.3/scatterplot/scatterplot-001.new.png deleted file mode 100644 index b2e5fc47346c7e3b33c701543e6847a2519bef0f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 23094 zcmcG$Wmwf;@CSGS36XATP`afr*R+%yCN?}~y1euKMq z`4jwrb5fQRg_I7FZb2ZFkoV$mRo%bs&U+-2sx=88UVPK8Z}2?defs`QJ5D>!C;v~q z&EXFCimZ$%^fy_$BNRUzV&$+2->|tiF@Abtiffu6hpkA-tVGHDG~jcL4{b`$#eU%; z#rQbq`wz79V=nbYxr@Umhc92I6mFL++^4I(#CeJ=E-s#+dBnxae}*cwsB!y{JG^wf zs2hktH@@=kIkShQFuRw6Y_w_lzcv}iZ3TS^0$PlQYlT|VjCF0@&R_wGjv#|t0;cFD zxFmZgZ~_)A}dRiYnP_+oit-^PMT z@ZkH~dDp3RIhk9ctBbikkWlZl$bkd=y>-UB%f7O?Hyyt^9F{O#P^RD#7rcb!&+g4< zD$um3sb{|7yC05n9>pOdJlL?Ni<~3P-R4O`AQ8T9!b9I0deH?B41~USQP}en7lzO7 zeyXdTXvnpcT<+o34Sk*P`5MKUG>Br+n_Mh0G?XXrnGAu=b)L+@Yl;jnZ{l1dhD6W7 z?kTv3vmPDxo2#-FYhISOgg=-~Z}$8j>IL4wJ%i}^b<4E~exs5R7f&1e{C*6=O!lwr zI??X5=b6J;iorXTMPfYK&4|$ysU-8|2|C;Hr0TBVG#1iwH*V*%_s%AZC znqe;vHZ}wGjt?AoecAZ1JxE~(Gh<`NQp3)M`W+Dzd=buW8WtLgXY}}RdkhUVwen|} zygyO?e;JU4c^;BzHhwQ18X79`T>bw=0@INIg{q0^>8Cx8+dj|5vnP@{OejB3Ee(I| zd-=7`biOpq;#Vaz6A{(y_;^NYmd4~D(vR#M>ANof1&h{ zxsk39eUAts_slPyl;oN@;v`~4)0+9b%BNXng`e)e@>JJzD~Ck(Bu07V_GGwcLdRb3 zx^l027K3-*85cuvmz~t(U#v^LRhEP2^;VwaY9z1mLZip#&JF_Pc8$%i?JY8y>UDHR z+o5sqC@s0~rID`lpLbF@%9rOgEs;@CQKO4bsd!TCuP#@kSFd-!$cmghQFQ2 zss`L$EK-C}`0}j}riH9V31aB!>6P1(1c_#zF21=%3znfI$o^q?HMb!g!tb=cbT(>sc~quN9|`o%*SlIgwV)rdt~`NFt6p2wrX+iM@sf;Y6vPPK`A+@t%Ny zz!V)!2~q#=N(j$UU)$8=(;J`=Y}D#V`tQWUY-7?zZ|jI#E-=@!_d{j>Q06rU3YB3h z?W>e8P$zc;C!1My*C-3Fa9P@Hn;+k?;8SxMd|0SsQ9jn`z8fAh9ODQ7pP8KvxxI*$ zda~tQUuaDh6^|ntDz_eR&43d|nKsBsrde=ZX`Z_NJqFd2k9FTho$|fW zl%gIlQKwEmDyn?n?p4Cmvq@xrEaH$G!-|wJB9a*IdA@yix;|X!-PClUS`}@= zCyD}AGjnnb!pga7E(EKMamifBM+lWyvM4t}C5I`X`@aFhfM@p-Z z-q=R+hih>3rza$>X{%rXwTwV#uRsV0mGhuVM#1flRyZ60H=MBTlrQXCwL!l@WaLhI zCM?N9j^K`2d~+n}>8DH#m6MaJ-O5cdmdpP~nrK#lKApg%u>u`n4YZxDT?uDWO%D$ZrFV!A-t7#-J!*NlX<<}&3*MOK zw@1_Y|K`7&`_?{kYdyq=(lZl5|3y4wYs6~Ut0p<0b5anx-poF0CZ*1LqgY=|9cgD> zPebm>5!~{?6uowgwzDs)jJ;0J&ois4au$-L#Z@(!x$~*35pHi4{@+|jmgc)|AbYs zkp`JP@F6?cbkdRq=PiCyJdmNGE))!AP8f9bH+YTHW1t@i50Re|2{ZWCL@s%-w^V@a z8_pT^Jff-kmJqU3oyYw1Ro0M(thlNHnik_M0vn3ZrGneZ0cW)AQfJ`T!+O2hnHh&6 z{*9$kd)clj0+OxbR)Yt!f&)Zc?D6MfiTzO1s^E-;J@wokAD*CWk?+K(izx+K&k2S26B3m7C5I9diX{e*C*fS~88Aay--qxe z|5c*j**KqDK%e$FAeJtR4yErUf^rq#7=&ihF>qwgcZY=}wwSK$&#plr2W2A_&C&Lp z)K;>MH-BP0~STl3^YsLk zrSt+^R6o*FDBjvj|0wC}hO6X!A<$jC#g78#O!rdVIg&CbEL1d#N+!*LG+y0R;A1ow znysmsh0wO)jC+m2`CiU9HW~5A5b%Kei5LP!>F5vZR&1}IMFJDQ3+!5UXDJ*Hak06{ z!O^W8tsp_X_F~>jR_cvcxF)af2i5o|Fk^F5f-fmku-*63-M9`j8`Lzq;9JkTq|ZAN z1eCS*`^Cf~gQ#RkE^kP%O;6xWbZmF)T}roCZ8=K)bCVHf;TCkdtrA0tpNS>%9R9Q3 z*X}^xOJ%h+(LiVL->Y%xxYh%BiJJ(hT=7<-yLFi0o2?&ul03HN?3}a>chG|}fU%TJ zjCz&(ob16N(b29~bWI)ez|;3k#Lb&DwZM=cOaPkU`&snq;r)LG_|G6Z3LlxKqXoHt z@?VC95(6`ZK#C@;bA-oy+)BN_uPn>%(o=pAa3D22k}ka!7moyJ1mf@4xF$cF!ohEF zo?fx`6@JPpOJ|VvLko}&E0`G$a(`7#0`=Nkvd7;^;mDa{8;GIFLIUXLlooM;Ig0WA zRF<1+=WO7WX;^+NyXjN57W4M%fTy;IHvCj&|41|Fc?kW=l>_zWr6a|~GuvWlZk+;V zRc{MYv{2p!`sGEky+NT&BGjyl3d{)2=U_J_(QSq_R_BYDs)Z3@&{l(^kWuFZbHl!x zYZyR#$qA3$(H5msXvugko3Rwcd}H=MUp8LM!6`I&Q}eD2P7hS&5JHPI`@j(z_VUzf z5Z23eWz0$FsZ^NH@YN`P0B4&Gz9>I?8Wu#+AXn31t8-WFnzpJ2r6^fOF`>3XLz_n8 zdGM(za2NH0i}TT6vt(E4!KXxwVL~b1H0G8O&!!No4)CB7G?$Q{{`)-uZJvQ;`jRT` zOISV}kTjVPS}Bs*TrkDi^w;z^cDFd!HHRt5-@-F(OQldfD-$u0Eym7VL3A4T86MCnNu!fhtG!nuxULZKh)WHEGA|$pu2P@v~BsPaTcV*ovB1F^1u<7v3qgd^!@ed+C;)vW9I2GM@q`GO=P zMaZN;*7e!>Y8`Pnmgv?IhxC3x_A-Zi301Mx}G3n(=u1Ty_+nrJ;!JXNuly2c|cOUdbuMsqw} z!k$?IVSt;3Q+GaQkrK})Ja9l?-^;P15p>eF&D%%&Y2DiCT9c}`&_`=RP22<&?xg`_ zL2o^H_grO1qYu9IABSD9?{8q(N?)jE-w5mGyhtNt=R(#|C^VpX22lY3?=J+5GJRW7 z;NBfC^hH2nA@x<_VAp?Y-782@7nuG*zQi6s0xn_qm7RyAcs3C*k0(YWapn;f`=^;z z^EfG_c}G}(HalZ%v6|io;Op6q*Y3q%V|c>*JC+0~$5pxMflv}%tom)^MMauLi6hDC z>~zL(TyIQjzJCpAms4O|IUD#09C@TVFqGxN=y|({ z>x&*wS`d-KgwqB#_jyvc(biwo^&>LO*yh15epE_kRrdH4AmBr7SZTAAfF(f)2#Thj z?(xj5oKc+qOIeXy-HPp9Ll{+(7611l*akuK*Btt^EiH0h_&Z19Xj-@)aMDL5;G{7R zY|vYuO+SZwrX>fD+c@ve2OO^i6&QkI)oa|kl!w2Y1Wq-SO0d7=AWl<<^z@etmRL3L zqLxD9T*Mrvl6CKx<`}E9rzN~p9FSgn(7L$mEd1}(*;Cu&MUG<+ui+pToEj51ACbE1 zpyFJqU|2<&-`$S8dBM%iWO_!##iC!!Lej6NWncBG^u?ML4~nR$j|s(GzP~vryD+mgRt`a@g3KbRmu<|(hDs1Fj7u<#adDXS;}t&~DqL<- zY_v(W1Y}1G*DoYhJr#3f&+Xb{(kJ)#oz^|<4#rjr9e*g5=)VQ=V^>o1Da|ebkC%N4 zzMpJs=BpQyxaiCJYSW)7|Ez@P6&m@RT}Bi^rynt~ClG4k{0F2Behz`S?r^~19=ecJ zp%o{9>b{DQZI@7Ni$M5Lif_;6B7zY;9I+I`zg4gM3_Fsw*tB4uHoCyx>FBFk7G62z za7Yr#Gfr0~CA6?7Ca0chFhNh}#?b3utmI+BSSb=D^i=eVHA}0j|0F>QcMAbEu@4bc z)h$li$&7|H&vnCv6j?*xgJ$$26Qs4?jO~Y*A2Njf;5Bf$YSC0OE*n8M0!-!2Wv=7E z4FL2U8h!H;^22_7pd4BT2U%}2Z!I-i!iDK_PQ7&$zeQACnEHUP76VPx&FE2i_dY5l zRDfb-E=~j;vMDcBtUs)lADS?!PVIp_~<(68h{SZM8PJ?%-bn`(rm{ zz}n{4IA2}a7a8lmIFKLlV*xpsLJYA)_)PtT-5%?C%I~joMND^GSis|ltfB$z6+|{W z*H4sFW@K0U)|80f3bC8gVOp@3t~KgCo)jL6iMCC0R|2|5agiM7UcU>m4RQ=l@<_8K zOfJXZ~Uz#OP44lzUnly+jsY)0Zj#@s^-&1ZQ^o3E{Yr*c2bc(~m-0=a;R zo3B<;H+{;6?ob*fo@=Uz{_NnP#O{EyaNFBkN!mI??HSNdv%!%X7>^U~|#!o=bI z?oTpyd_1_jz`Dt*JHlFJU&*ZPkKM=y_cKb0mV*(+jV97?+>fj1@6XGmENQq63AC$I z5hblVfNdDk$fzplPnGOX#IP9#wn_O8tRqf153G3bmYB|_g;UKAkmF}97b{53oz)PL z`|yX`G(X5}#d9EjvEJ@nB!57dC~-#wF}~M9lbc>y6*&?I%S^6Oj}I|k!q}; zWuEgsS#(_T5a}jtx$N>Za2@0@Wnh;jBbqffk*nzpXRQL@t18NxaMf4yuZH-5-Lldo}G)on#<$y=0G0#fGlY8gb(zndUt5UFo? z4k7?Jh|`CE4s9GwId@5x4!|n#><{C%W9D^fB8*#hkL3r+Zn@rXtzjX~d{rZ6ZD>L) zny?&sc^KJ&!{=Fs_Y!&0o&e}}&M(TK729AqXh10rmRFwM@lI=Z$kyZtWvvkM~}yZ*Tt_HR+up??kcuhW7+9EuDf6{3qAXdVqr z?i);y6t#3Z`tqF90i^g$22;6fw+oASE*l=F+$pJnKs5AR@MXtHPl;037c5-#=5wr4 z)diwam8GQ^{)~=h?UKT>Q&FF>ute#7(4c&6cH8a&XA}^Rk}@M>tQ1ud+} zu8(BNH}nF0cGRd)DR1`^Ac4zt#lMOSE$Zq9` zk5p3cP5%AvRy_v8TFix%i2KEx9=Q7hCG;BMtp&`MMgzDFA0^Sy?FHn8JGHadif2CF zwZp#^L7HJqK_rsmb_qF|-3Z?IdMv{@@4G9bkGuJBdSqW59RlR|>NbYrlhjN29>o13cOpaQiF9_L%f9z&WF(mt~-26KVz|@Wz&|q(L`q} z2OEI|U3>L7mlG;T`sI#pyq6C17LL}HpEm>vxKGXkfjSwXOV!4$zGtn>^8CyQA`AVw zmZB(`x8(WPciJFhgC=I%o2y(fT2mfrf8TJ>?6r0A{rh(@-w^J4DB+OrU+c+1JF8dh75v~Sj;Rk*FQct_a%C=e)!Mj#BF(xeK;PZ zb7WlQ9(kZ>NL5(jj|E!y_MC>zv18;-SHL2scLkp&!cQFkK7wq*j^?aYO|__ zND7PGdR1xHm#)@CTVHmJ*;RSB-@o@Zd-%x)7qN0Dc6RdfT6mvNzRN&}TTX=p3bLyx zrH#kZ-lu;g`5tahWYn1dI5e)|B{8LTR~Amu3C{hXLnG4r){puV`pHL`%WBX^yN4p( zRYx#tku9u@EcuE3;M6=}?>oPSDRN^3Ms@b)3?5jJY3sG0mn?t$KlB4^UgZEOM zvM$yPxZ?w2Y!Z$qAX`J;pnyt8*6DwS8zQH?B)jj>@mptf#C|~(FYTF@9zt=bPLnI0 z$7JT8jjhQSu>6ij`-VtDcR>g(QMs^5uksRC7wIoeJBaVDQ=B7X;5|Py(8jT*VtvKs zls528NvqkLe@O5^2$nf_Kc6<=@!`i4Wox!wp}XKkfMCow`Ey3^nzS-v6$>IO{UIlltb`=xD1GmBd;eGVYZtNq3k`Nq>x8NR#Iu?p|2V^0H|pxzb{cHoKz z%WVzI$e^{CB9*!!nxI62_;r$P$Bm`|I(Fw`BV!cj!-lLT^>|hX#Gbzw1VSQO<_2uH@m6NK@TBy6S#@>}@)nCs zd+c*XCdO9OpkYhigZ8$zU6)6znS=L!BiXBzxMj;=DuDWwP`n$}J7`+0-!i@^AB-1b zeUQdP`<}h7wsJv;`jeq6=B%l%R36d+fiAgEUv&hv+cBk>U4)HMeaLetV->{x~&mwiR_ z-x|w%f#Winc=vlDqwr!)vGt4=k+rD`zi8t97uyQQv&jbDdv9(Nr)O*Q2f6_YVXWNm4}mr=L0s3z6*`RF!%;8&=BxKAqX zu#xAP?Uz(?R@OH~a;Z9WN`_W!iojD(1VN4RlB=J&+hgeb=&{sa$D&!TD*4yhVJ&Pv zSvWnS@GlOyQwEAY+@VhEl539b-8at#DC7uF`*RZtVl0(-498}25zQi%Hsn1AmkdZI znHg-govV!7cE1T+?TLf8E*z$sot|B65p1q%|I-C$%{qihFEOPnOX5Vj6pWmDIG2Vk z1$W!Rc40h(=F)IEGV;k~gOb=V!tp-1xaNZ+NIsqaLM*G}OTg|$%txW0x=Y|ri?F2Z zfwS{?8P(Fby+3wS!gjjMS^0PWm4p~jZ$sNh!BgX7XN=%O?<@ttD?=R0MK( zu|%OLgt==|Qq23Y?+Y&18#sKXHO@_JMVW{jrEh;>mnpcO!Gg&%pRA&RIUn;M`CIX# z%u;tygtUkpLnn?pIIme1g8R#2l5ztPz5uq}gu)9mZXuw(6P@Sq&gkW2hIN=sA|465 zov5Pfp@ytdAUmVg_jMIgBVxNe)S?CPFC&fVJi6g945Z|9L(ht|z)AkQYyfV$SG?AX znplKC%fH`SFSq7(uk*FqKj8GtwbaAiWZcjkjU#+LYi4FN27tmtuAAa&giY}4y73d| zx8dj#gq2@yHLDTkZXIyP!|l~OH@qW;5Zc2kgy-dNJM`S?M{*;bHU^nNU8`UR28I`|eJ2LmibzrN$8fXNEo!GrSnwmcjUvEt zBe_vKi}Z$rp8P98gH88SVJ3_Z)49epX;R2^rZNf4V%3?Ar%_=$`<4>aEF;F#mj`8M z#vzuveGDK~i)Xuwe^9eWmYb+on zs&ZUfb_raV*AQu34SOco7%=it?Ud;KCUci4+yC52=2vxi7=dJi3vQ$hX=J$%9?X8uWNS&_@fJt0h;KlZ@RDDU^Of?NWWM zK9HOHmWHI2gkS;lwYPF49{#GfukMoI8!^0wDBv~cPpU+tW5X){vomz4>=Pjf_%SkU zcp^B5_z+Ik2RlG{@bHAhuCtb*VP%j8Dcx_Zvnb;C=;j4WH-W>sAK&HQb4$}#XjAM! zAD84ZmT0A4y(ss5^5Tnz^LsuFN*eYGgiU>e>8qx7<5{>-tpLrR_v0o32{!b680EP- zD^1ZZ%z7mz?~*z{1r;4NAHDu{U@Mwxd+FyU_r%mWFyp54r%-db1}gIJp&v~ph|{r= z7ugVirI)m@k#T39X;#U1ATu#h80~W7N87W!iAzZGU1+7lLl!}#Hl3y;(JUx#ZFH0S z?KRxF6MulH@iFul3gv;%>7ZK}JeKTeZq@fCWe9Hqbb{>hyoXyDJF- z!rYb67`?iov}O~8d?8cx!GHq6-gQJA%P_~1Gy7^2C&%(BjKi`EbfJ4IJa8*g$IY@+ z<$Yl=EDA%EC0Fr}(~H#cbtJ2wERzr)UXDRH?^Ih9LFcHvH(2QP1DHNYLH745#WPuE zeI<`V<^yK=#VvXWyM*&S2oOv4v6Hd87jpM(SWC;C)t4$XT;}d-T$vAc{p_o`r>Cqx z5H#4vb;;|j{V_(rH74jWa+2>TsaXj3xtJ#e@fGiriznn&zyeTpFA6e`#8E-qNvf%dpjWLXv`3*IFp6;35{v?-HR`QKmO7U#FP|x!?`=_<2hwilnXEC zT1Zv~W($9B$8N}z-qFSNfJp*gS7-``vQ_}5hUJv6RdaDh<@fvX^f}?_*otr`Gu#xz zFI+1^(=%RXnPEEQQ6|&c7iojZ1SCBNY3+pP*u5LI?*-67JtLD6v3$G}o`8A0!aYad zwYPLHu@`@?&^`+@!Di&zbXvD~Va6^jjl#11nSII|$6q%|7ji2i=h82%;B&FX(ydR& zuz)zkItoK3ZOUX3!V>}W12-u-U20j~RWoXl3#SA>H_>H#32N$}Nf^Cm1m&g80j1mZ zBX`TS95Gj!)p)V57S_kw?>-&*{#XK9Z($=ygG?FjCd~L?+hCfYvn@wqpuZ*v;znjn&RiqeSz@>^BZ>8IniPYEzJ zGi(B~BN7})m%=8qYS)ZvJjc10KHtUh*=4*$TVSz#a#@`@GG(j_r{4MY)r-S>RIqWXPJ@bL94^3WHs5pK8f3A5DJBK`L!3dJf8spCQeS_NWHaB5m6Vh21q+ zLH({O^D#bd)9Z`%*7atVt|DZ75o-63dvgaQj}Y!Hch-hu9*R=-7B~$TUrP zFr7Dj6#=KtxWAM~w4hggwT7KkO3n_g?SFUIw7z2c<~)ATNvo^yEaypSOWAX_<~{kr zX_E$KR-tP9Y#OYv!j706#T5QQ+jG4td1JYY!-%t%(}OCAHoL9vnOay4t^zfSp`hKE z%j=4-B}2$eF1JfjABs0eDG?9P#BlgrGgRjdG>CmZ9aVkHm)(=&$;D6e-Dt7LxH@31 zU4oxGTPlM1Z)DV?!{`Smc8z&9O^!tkv0mqk*x&q|nADvuEv%tO*(wc3Im53E-=q7A zGdO>+2c^jqLd*rzZ}NFZe^nIT+CRL6818*-S!ur6FWUa5pTQiSt+*4JR;@8q9k6&y z6J`A{^~FZtaQ&B%uj9GrZs)y*GPoi$Id5?HeW53dyh~_bIRLF9RN?JU4<^VP-#eyc zE=y&#jlbNjBlB@N@QQuVy4qJh3;_dn)@`r-qTwJ>Q!gTSH`Xqym- z_r^S$nPoyaCfD+^eX_<1O*{*hvIP`g@U~}4e9soYD(+c}4whOz|GHtfsT<_)j@apdtL$qC#9@h?tahigfih%v zu2S|Wl()V1KEcLv&sZJW;dw~v2@xL$7mfuP`)tXFj1-C>y~Yp$jKe9R3nZ^iJ4+OblXBHQ zq#t!tu2Xak6#&UJ-xcvRR`>d6A`p_#MmRMuIovaigLJ#7b<1~7c4xyrD|CgHef3IM z_NhaS_~#Sga*xiu)w%en2G&>5n~nkkPV6l^B(1rAY4Z5GOY>sPj4w`RSiFSi2z^Zu zfqvyyUkXYinu$5Px1ca1(wu84J#0jjW-w4gtSpT}6)%h=H@3tlKONl#^H8$hbR8Loyb{x&=&Lhy&9 zdXn{r-bP2yuh})c^Wjh5D8X~x%FvghJ!s#Qc zqd--9`YH%ZI+`L(9ApuWd)VhrG+7P;OOH8{|EqK*wXn=rWV~NJ^03t$V{vTf-cPCu zU0%BMxrvds^&}mD#>nSMI*&zKKn#EIa-7~MNk1LqD$?(Eo z;hZ9zUKZ9+mIgGJoU)qIofu{6wE5dJ% zU3G55kW(mCog>OccnA}6I(V4Eg zPpxv8-AA28`xZy9Ylc@E47OQ(wy02F1v4w9G@`?gYQfDS;SJ?a6-%VhH2^#a!cKSl z6t5xy-hhG?+M6uC=_N&=)tTv0-v z7FL>UQ;6aexQO$yjSZk!9Q)$pgOmEC*-;bzp+cj7QjR>-Dw0Y@6^?1!P|v_;qkje= zT!5k7V0rBrzDC$`xp`wghXRxX9QypujT>104tdcQB0f$Ir+LO8^27SoZo+QX8gXel zNe@8l2-Cp(4ZThs?BMbQgi*$&!34R#6?N`hpKVGh4@1nel5ZwaY-VkPMRrbn_zaWK z(n2g%0jE@r5=Djy18tg}wdnEy6K(GD4Q^tIOAFQSl-Q1%mZ=DUV@aeWU^Ksc__tFp ze_)MDyV}-t+TR0q&%@gO)hwQqLwBqtX|2qsai&OZa9XIHvNbb>8=J=V@85lXX{z!( zz$-lhY{#Vc-<_>>1^^Svfz=s;2{cJFXV%&d32{3+q~E~IE#KSq;zkVaKc3nBf=JxFP0TYYd$J`w{ez4 zo(@HJ)M}tii+{*Cty+CQ*j1Po{wxTd+~-sY#<9BW=4}p`t~5`&A9C~`-{EdN%8c?j zNO5<`3~N?>aDoD9n`_;OZ}z?hWOC>hI09Q>#Cj&`5tu+@?RqD4L7*sk>1jq($9EuzM3EL(qyr&*{^s7$TZ`i8#o zO#b^W9yVxU*|r+Qqu`2 zu4SjB;@M>8#n@`C)~pg_Ajon=#l(hTa@BzRX$t7scG6j*nrSZ%A_YvPluwaun?$SC zPXIT?6Q(>KMZ)7nbyGWWzuPB_qaf55~2G61YjZsuw@7vZr3j3c4QzJO}m1bN^6G18qkNk0;2pNib zR*C;B4wZd6^ETJz|GCMZGRWFTaVkmD6RyL3F*K;cunm0PJV=t8tomvOeE0~EK!Q>` z50OFNV-3IY^cbMiS>Fd8)5_`8^o&qO@Ir|LJk_9!cl&O!vUP3O=bv~FmjW>-PH)9k zpM#HyWay8b;3}CpCm^>RG~XPCh}>qLK3pt#v2jJ7V9?(hyA+xR zVX?m;fEdmt^FT;1#qms~#mEwy`@(C!JX^{1)pJm50W{m_oDF*gJUbdfifngC5t(l32oj|C!`IC{mV-Lt-H3OYif>+}ke)7jE&n_|n{Xi$ zMfvxU-)zIe(()~J>>D8QM{lYp)UlzXH!4EplB`K80(9DEFjh1uwVaX`QUn?ig^E)H zx;xX2Ie6?k#^-7+sp8@O#{PIi$F9!ozoJVpsHv3O>TE@7oWU5~r90dnXoaE^f~EaE zOI6zWLdfCKnKLnwMEi1rDGP`EvC5)jTshHg)~vyCW!pk94pEYELUczFnrh2Jkm%cK z{>E+DH4`HAi#M~?RDe%wLeyv8&Lwx29U*eLga9DyHJ3Oy{%2vWCfe_>#Z}SQsJs9p zG+!7|X)uAuZljfsniy%L4=8QH*ODV4t)69dH*q5XFdo&vdKHNUID*Vp*k_CHj9T{B z7%&?|1vZFXj-(0=&pWfD6fvYlWzx!80+&mqzee8-PYm1N($slM5FtPMAd4rB(gfTK zFAYIf_kW*z^LG<-TH6jMhJ+n6-RD2ECx&AP2vxe-+XucYNM@QUO+L?Y+AL|=9|5Bk zM&{44uEYrn;MJ&3OemhDW1^w7YQaFlR?FXwd3`bG1d5BFbnKh(qgI!67OxX$m|mdP z-bc<_yUCY*<<{)N2@;(y%2)uIo6X%_Knc61TCRSbL zSbE+5X2F*@VWX^1K&^6qCX60!TdB_zA!CX{1`p%KJ!@&S-v49PZBJpKslWCY} z=5Dl=wRO=96BTNTrwvZ4?S5!`&Th=$#!1J0Q|U<&H+Q1vY2P~R9VolLBKJOQb6*Z3 zEFa{VMZ3PRZ#qlNn0$xlu1}LTG~Qg749;;`(Y03?lz{lQ^Rr>p7M!s>1r0AXaVo=i z^9C^TycmNQIUxW0U3O47%-YrzG*M^8giaV~y^~+2LQM*%ZK$rQTE1C)Xs$1!LXFiV z%RAg81|GcKANX2{d{(Lf{ESf1AlQdc;NgGq19!wFS|K32yxdBc;2G6dBWF*#lztN@sl7xE3ZL}~!b;|MqV+wm%%F;uTADJ6?%K-B zC|%zUg)f~b60Z141Kx{hwIV&`clo6I2f&7E4?rdlHBa}D=&Hg-Ojjd4=>h#yT**Mk z=IdROxvdHGea^;5GhQF}z5vN(B+zzJw0#{4&!WC6oya7N4YMsTphhd}Y4+W~B0v|9 z)9`D;mWR6o$3O1~3+jcl-b75e(~*PrrDbK;UYOBLxh?weUY!gBDQj=`8}6D}vlR0u zTj^Mfr0_7zLU#Z4#qn-Np8=2Q?CgB$qX&EjOr~#8vGd)^;cj3MEqxh_&SP?XTR-D& zVWa77=k!+t6m|iO4S{NS3+xnEI&2r@87JwvwgHj?A_T@zC?8kXS&kCiSM-P!4^S%$ zPymRbJ##lEL3zck<%UeXSTg|e8Nr(|u5T_AS|FA4b%yCBDm#WZb=ERahxGSxv>cjY z;a0B?!&KaXWo32I6R_#)&P?np_+8_|G-b~BW{(~ZwXigregr(muwgr+e>7=AT^Irt zDQvkOFFORbK%Qu31h@dAZf?9oLMO6wfV$#-GRS+BO>rl+mwLlJn1_Q`PkFyOXJkW$OO(%ngitnQe_;!9MRN%Ul zZjp2xr^}M~rv|0xc`hkiwQ+(ZyaimeBK=KvJ*Wj!J+Q_~UAnv$&%`0Yg7$rRV;whh z;$cm=19MG5Ky7xXDoAcyR{0)xRhe;z=6AbF@%-1{80W$7@^J$QTi+l*SZ{6eS`-pt z=a{)NG;aDTOmM#zf%C)fR&a-Z@j0K)<8n*P#~!yTE#`$1fz?Oo1x*)yF7#lpX3DXL ztitomO6cS_=Li=%U5587a7E4(y+ke79!wa-B+~3!H_mdPzqvV-7u@>{D~&uOV5XN_ zJhG0jFw+t<_yJ4EbgnuY3~>{6u*Z`djB#0{=H7C+Bm7Z~QHGHnJU)^l=N7o0#+Ye2 zkUoeqlCuaOyh0j)W?H6x#l8%JE3;P-f@f0J;}-;UU@x`;SUXNU437ZnF*5<^If3<6 zRpwa|%Z`1{El49RxhBuwsXxAvWZ7R;?hhZL%3&5U)hN*p^4hOMuKY0A4$LA_Md9^$ z4X+)*4ad2YfB!xKjA27t65+_eoJBmWGGlC>Q#)jqAu=<6YJ@xrG)1XrBTY z43^>n4O9YvIkUz~SW{E8`fE(SBkNs+!%-LED)1)$;6l7z=dEy9ZjaUHRoWc4it`UR zad3$QKHf;tF)a}bp3{7&6PQ0Iz*VGPyA?2=!MHA&5{fuF@8PR(F&+cb%a>0mtt(sc zu+<6*qh55dJ8Wi#tfZKyA032;isq`zFnO}12d^WsU?WmYO1>;qE=i4Ol1?mojU9vx z0u|}1RJt^lC}hrB1WY9h5ULcaR(e3Yq$fuBH^X3EJK}1E-=G_Z#LjXr`#VXd4zDryRFO&8)7DLFYt&CX%}H>P5R zR<%&9dPxmN!G+PYloG6X6ef1!%xGlrh=B$(qJL{QVfxnI4{oAESTNl8ObgQc@2^@V z$UM6(Q9TAm30VlD>Sl2qK(2Ps>Y++A<{;g$lCP^>p$d}8$@E+>S-)oaDNL)X&wCsL z2PO(0`xmJFg?-4;nd4DdZ^aoEbt5Oo2Ueke`M2VLID&HpYyUtGhCO*NtQC~N4CeoD zpt6%AI-}MQ@S7kmi^Y`o>SvtWk0N=36@)34*o&N4^WMKbKtcD*CwgzNv@m^%fo_Bu zKEPr@AVlj$t|HR=4ZP4Y2yu=BfM+TAsMWR7N;jtHib{P9x`KL<0h}$2W-WUIx|NhW(uI>d-m`#a_4~{}XbtvHse1@GA zXiE8qTV|mCo<`8H6AFs~!TWuDVi0pTZVkYc5zyOmCB7yvv|y#6T>pTr#CNzV{SP-m zhG`w9f%HIOyjRe@rE~8@cr?7IQR!gg|Efdx%j&zqWiJamTcv3_ox?=ce?RE56k)Q9 zuWcHaeTBu|K_KPROUIZN(bPrHCke0t?D2xG|1=h~%UV}t{a}Q)Msx-9B>Ys%S0WoR~_?8>}Y6bwJQM@;5ig z%*Q@_=wRpZ`kuXfW@l}!;)^k!@p_Ew&)>g4Pf4q4ktMQ~a(Xale1wt)Kt~@ab0c61 zVZquiOB?nDcI$UabHdL-AS&KmyY0c4Aj+6Pd`fiWPFih?d3E6n+AAMhN*{C7w4PpG zz`I5DqG3TG&!=F27XZrqQ@P-+eXcLKLqK?`S!4J8>uR?93rAAqI$il`{_Zc&16_6| z+Ny0AqrbnGhV1pO`;S`-WL`}@uWS}XYK7lrKK2L$XJf;ob3TlD-bI}>keQcfKH|rg zBktuTC?F_URKLGW6bwft{ti&@_V)HRx3)n02K}mmhCE7uCUdaqs{#;djsPAU*qf}x zTio}t+g^s?0s+A?zp4oE?AQ@qBlGim=ffcVT}9OZusWm*vv|&8C&pb!|JujgeB(pM zTQzt09(5n@zndKS0zDS)Xe1du_WDjBch}#YegFN1juoq`w@-SofJBMD{rJYzrEX!= zV2|Rxhbp;X=z&HKLWb~Jfr8QgTpb?>oE;9^kSh%mCAjUEaPeSt>ZSk%QaxEbT4^S& z4)(*Q10RJohEVv95mKqAQ#>*Kmt;VTVd)iJJ_VqOqNimByBA#P#TtFvFnk62>Sh`Pa6}L-->mgN@0)SIf99HJvx8 z0||&)nBn5Fv0ALU(d@`AbHH*=k25J(&65FJcL3?Rt6rU$_J_wbP&+8ofkjo^8>Q7j zQ2L)a<*W8x&(rBFfj|O~A8@Xu#)Y&>!M@~SoUTF z$c_UQc=TkL7(cVVx_pC6U^DV)Gx^D(0WsFXVAjrdhY30 zwWZPPnNXa`k99wUMorxXJHQjK&lNRx9BJW?x5PirqFTxzzXax*x)-QSVDjNx{g_WA z)wn^RMY7l2m#w51_?Sl6Koj7KL5pDQaHI6Z!+!u6b}LklcJKMBLHREEcTvp0Ae_IW|M$)`PtRO&_?llL*kxQ<~kO(EL|Msa*^DF~Nv&gmC%|%?vwW7GH32d&X9EQZv6oXxe;LjcefkK}YoQNcmm(IN7 z60XuEc*A(1SGAPy(t$2m0Jn{I=rm4ezh?}>fX9u%``Wo}s6kNw&dC^HTZC3vmlx@7H$rn(_*LNIS4aDM79A++?_o3b3C6&K%#HllPFG24B2$Z+@ znFoMpRwf_^J#L`cJ-UrcjxQ=umsO*?g*@dyC%Bu-lq3EUCmp>I8pEqji=NqNZM% zvu?~WZoV zcZ6c!2blE`gEeE5weGt2V4B1WG>JM#SW5)BU*LLZU>}c0Y2jWxBqxAhf#5J6w!|fe z0#64l83W2-KSSBFBkEi^l=5McFo0G~IU1dB?SNJo+8zeJmYNF*P*}ht|6k|%?iPSR z*q4uEdF%PUD%6@q`si_Sfep(JJxan+*>X+#9`wO< z!Qk1Wxp6qRjx_mB_lsB|h&{%Kuq73_Uwj#xzF!1wvyUPuHip+h^=X(8e^@sg5Mz%+ zz@9TlN5fxi#SNYf$Kt=pKol2uft_@Is#?Zq7uo+&%aw;i*?#}YQX-TJ*(FPoUb|## zY-P=ob);k&(MEPcDc`qYY=!K-l5FF(4B3)ptXZ;6V~-GHNg7g^?|FKE-#>oW_wTRk za$V2d*Yn)ZxzBw+=RWuOobw4l+$O{VvOYumF+u(VUMAV<1nX%~2YRUJ=hN9alSRJ zB&-F<%F9dYb9-GTSY!S_tJsBMr?}y$j zNO3VxZ2V7e1L1Sdc}+#%(Fo@83E^vLXR{k!5pK64D8i1^hs^(HT8A^!!z@Eas6)|x z@%x@WL0SJwW+E2OXX|F6RB#M;{|(Qw9aeTyXT*<{&cxn8&-G@v4Cfg)?5J2;Zh2q4%^21)F7i&y%PnQGt*RIFm>2%C z{J4tL!bX2q5RJUVU*PH?n}M~?y`*I7l;&D*8P~qp~8U~hb76CJun_W zBf=L`P-mrk{6_N7A#`?eu?gb)84v>w5c{CUWm|yJ375Xn- z8>$rzC+#)J7$1}0SOP?s9t!2;=kKq)DfZl0y0+*4S#c%}4UNv8Yj)fg z`A_=|A*y>6Qi~1ooTyhGO+YK-T`j*$YmXK@$4wnBhUkYO9$erPT$HJu^lnzvbri}- z>q-=Ut~;yNr=I!U0||Kun~zVe+B-PJgVpYK>v~I&yWZ;c&Al4KF+M)7qX`5)9QXYE zl0xx@$Nu9#3knJ%{1U1imQ$IL;vJaETMt zzyNCDcW(`Hyl{Y!b63;9oS$|xQRaXb4hQGAC**_hs~ zcFeKjy&ru$|Eulu&sIXSl3n(PLuJ~i?LW;5rj>>0q6`b%V#)3|Q0y^r%nS!(`A9j5 zR34j@YfGFw?r((H6xE^I3q-Q(&ZlW(HXV|7j+jeCc*QFTcV3$>9lLV+?F`)y;K}|G z3rDlzFae=vlJ*R8%MT5T;o+=TgpU41Wr^X3_!^ zJn&DSx!aO!R{m_9g&KQeVxddY^_+r(&oJ+TOG_Hbrs z&Nfttt`6OYl|`=ekF_SdXZ>ht-V;8DZfDqYqs047N~TPo0E?Z7_VUrkxG2fsvf@aY zz9YXIif5Cp>+S?j(;A3!m;;K8Fod`;HnWbndR>x9OnNl^{*h!z!aC7Ra>kzV^iiI&K%)%fq5m4BUBNX987 z-|NJm?K~Rqi&DthVTArdOtV6>6H`zXViWaHUx(8cUYy_cbBO9S(HSY zqz2Jly}JAi3v+hk!7}Z4+i^RakDiNmEuYg~7lldi^)u$+p=*|J?X;qgXb&JwCaWE$ z4K_)m{^4^v@RnchZMyCFIRQtZ`hF%vQ<}&thPiW+T6B5*upx#KkIEsYr}GDoh;Sf8O1|oc`w4bdA@lwpW2<@F)$Y${41K2`_efA@xi5{kz9s zWQAqCQ8qH;{ypOfB$e3{7lp&p;^ZvUJQN!qUNqBI042nY`TE>%rSmvC#WfH3hri-t zuSF$1HOw`<1(Zqhtx_4L4x?c*+~q%a!7Y!!&=MplfXnJ5P&@AmP#Yw#N5hGN7>fNC zqA?L%Yo?bu{npMT;BqebNX4W%ndR5g!#5zEoaN&dn$)A3K#8c>wPvR zCdO_wYPt8Fm9#k7w|J%5PY@Jjkw2Ke0h<<>kfv6~k%&3Hb_Ued{i1BBaPdeP6e{Up z846_!pW*+e@uK1q!v%{IT=8;l!#8y1hh7yUxU01u>+yC`AD(abOUh%R{0){*> zX-sl9&oj%ic5p}|hN|Ml>@>L<85sc}F0bUI^L{L9?(2(7=y>T|YHPAOQ**1sJ18?R zB4ST>no7y5(5Ex1c!9RkpS5bCKP&ndDuzPazpZKducX7a`+J$RdkezrT%*m6jBvzI z_|@9ldT(u7k62l0y`zAixj^w6-rls)SXfw)18CX$Bk6SqFz#V1y(nCMayR-XCvOAZ zb_gzq$H#B>WN8V*Wtqo-#CnHhmhE`k*804Ozkk(GDAP4Sw_cT$oLO=nbm>Yu?MC0- zxyF+tQR}~|3{DAh8O15AoThv;b-fo18q9;Q90t>qAZ`Rpze!f#1i?ykjglWbMyFN~ zi5^gq2oJeIzKA(6+12tY1p+(UAcf-L3xPs3G?&)IiWFh0`xnLWB4dD5+P}GT4G}-X ze$isYw`O_PA)NbcY!?vY)QO2J3Ywa?DsPSRVJQWd^Esk81m(4Mz9$0LV-NwiOdtf6wep5;ueI6N`Ym4`#S3c@nxi;95%B>h zMxS(2>Kyu%3uR>O^7y;}65(c2A< zYXKODRG$fq^+}N)LMT7TF)9;M*Nq*`q)*z!de4twtb&9`uH5MqT-C?=7hH<+EE^xP zG~1YJd?=CDoqD|u??~fmf}U=gW~jNcK6((iOe8OElq`Dt{r~~qPfcZa%&))7%geh( zomvkglbr9iQUQC#Lu)JV^^GNpC7C95dEfQu>U#?bfq>X{|M(Fg<(h`0ESj%i(r|{W zI-_h8UTwAUBN-gGhx8rGQ(wk{sKx!CrInOzlnX9b zt3~7S(tI(UzT-7Jr>qh<1XQyD3e^F?GLBkfc}i}prlw|)OwQB8aeH8~Uka9K*%pGb zPH&5Ler;0WTPdQh=VLTFGdz9F7ecYYjVJx<_+O0YqXh{ael}(rc22i%mmCuiP;BM( zSs6R)^L6TcV%O~Zjpfnq8ei&rSQt&R&U)oTqM)Ps%;26Pr-q3T+K|mPp3;|KHP@Ti z&ZM*nhm8RV9iKumM=LM#^r@0MXT-U#DqOHCXr8DK?uHCCXX|2nSNOkNRsX<{_6OaU zFyvh6Gi)rhs_zv%KG<6eL64iiL$?=|=@W2ya+Pe{mGU5LCk z(^fc<+3j{Twk_{1q-w3yZ(iAf!r%VSr@05Jdb6~gV0qMi+X}f#V@L%ftoSn zEcW9C&&^frJm$Z33397slLtP2Oz~SD$%U`hY+P$(XebvWn+J=Z{lEdK#11S}&P5FF z$10CCF)F?WO)q@;kOSyK?f2!XN$Ctzn=z1q=+ePOqtUv5Oh8%&I|oPSy1K8wKNTwA z(?;B)KRjS&`wlsmD%<6D5!oNW-Ry%he_uHDz0S?mGt=6s0F|rcEe{}hT%9iR;`BFu z0tTF#KeA1;G>E^gjEmTt2+^+&7b~eFNB-1>t@H`$FT9XO0SU*G zJU#&fh70OozU4P{v*3-T4`09jjpVaKtX7JQ4CqQYM{oA}o(qQCDhL zk(~;*7xmtOy1@1CEr-p%4B0qcmf>crBOuQC9@O8FpPW%B8PVUDam=W9Txf1MTC&*v cr}48Et-@HiOv3LS5J96Z>Y3^i&{rS)8%1Z0mH+?% diff --git a/tests/testthat/barplot/app.R b/tests/testthat/barplot/app.R index 9c00725d..2a3ea592 100644 --- a/tests/testthat/barplot/app.R +++ b/tests/testthat/barplot/app.R @@ -1,3 +1,3 @@ library(teal.modules.hermes) -sample_tm_g_barplot() +sample_tm_g_barplot(.test = TRUE) diff --git a/tests/testthat/boxplot/app.R b/tests/testthat/boxplot/app.R index f1e1cb33..89798ff9 100644 --- a/tests/testthat/boxplot/app.R +++ b/tests/testthat/boxplot/app.R @@ -1,3 +1,3 @@ library(teal.modules.hermes) -sample_tm_g_boxplot() +sample_tm_g_boxplot(.test = TRUE) diff --git a/tests/testthat/forest_tte/app.R b/tests/testthat/forest_tte/app.R index f31aa02f..8c054fe5 100644 --- a/tests/testthat/forest_tte/app.R +++ b/tests/testthat/forest_tte/app.R @@ -1,3 +1,3 @@ library(teal.modules.hermes) -sample_tm_g_forest_tte() +sample_tm_g_forest_tte(.test = TRUE) diff --git a/tests/testthat/km/app.R b/tests/testthat/km/app.R index 57255a74..848febef 100644 --- a/tests/testthat/km/app.R +++ b/tests/testthat/km/app.R @@ -1,3 +1,3 @@ library(teal.modules.hermes) -sample_tm_g_km() +sample_tm_g_km(.test = TRUE) diff --git a/tests/testthat/pca/app.R b/tests/testthat/pca/app.R index dca1c9bb..29699a8d 100644 --- a/tests/testthat/pca/app.R +++ b/tests/testthat/pca/app.R @@ -1,3 +1,3 @@ library(teal.modules.hermes) -sample_tm_g_pca() +sample_tm_g_pca(.test = TRUE) diff --git a/tests/testthat/quality/app.R b/tests/testthat/quality/app.R index 34536280..0ea3f3ec 100644 --- a/tests/testthat/quality/app.R +++ b/tests/testthat/quality/app.R @@ -1,3 +1,3 @@ library(teal.modules.hermes) -sample_tm_g_quality() +sample_tm_g_quality(.test = TRUE) diff --git a/tests/testthat/scatterplot/app.R b/tests/testthat/scatterplot/app.R index e1b1071f..1b94a15a 100644 --- a/tests/testthat/scatterplot/app.R +++ b/tests/testthat/scatterplot/app.R @@ -1,3 +1,3 @@ library(teal.modules.hermes) -sample_tm_g_scatterplot() +sample_tm_g_scatterplot(.test = TRUE) diff --git a/tests/testthat/test-barplot.R b/tests/testthat/test-barplot.R index 7f29ccb7..436eb420 100644 --- a/tests/testthat/test-barplot.R +++ b/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() }) diff --git a/tests/testthat/test-boxplot.R b/tests/testthat/test-boxplot.R index 81533782..12fe891b 100644 --- a/tests/testthat/test-boxplot.R +++ b/tests/testthat/test-boxplot.R @@ -45,7 +45,7 @@ test_that("boxplot 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") # Do a couple of updates to obtain a plot. @@ -59,7 +59,8 @@ test_that("boxplot 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() }) diff --git a/tests/testthat/test-forest.R b/tests/testthat/test-forest.R index f9b666f0..9a17519c 100644 --- a/tests/testthat/test-forest.R +++ b/tests/testthat/test-forest.R @@ -39,7 +39,7 @@ test_that("forest_tte module works as expected in the test app", { res <- app$get_value(input = ns("experiment-name")) expect_identical(res, "hd1") - res <- app$get_value(output = ns("plot-plot_out_main")) + res <- app$get_value(output = ns("table")) expect_identical( res$message, "No assays eligible for this experiment, please make sure to add normalized assays" @@ -61,7 +61,10 @@ test_that("forest_tte module works as expected in the test app", { app$set_inputs(!!ns("adtte-paramcd") := "PFS") 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() }) diff --git a/tests/testthat/test-km.R b/tests/testthat/test-km.R index 38e1d47f..6d7cdd8c 100644 --- a/tests/testthat/test-km.R +++ b/tests/testthat/test-km.R @@ -55,12 +55,15 @@ test_that("km module works as expected in the test app", { app$wait_for_idle() # Choose an endpoint. - res <- app$get_value(output = ns("plot-plot_out_main")) + res <- app$get_value(output = ns("table")) expect_identical(res$message, "please select an endpoint") app$set_inputs(!!ns("adtte-paramcd") := "PFS") 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() }) diff --git a/tests/testthat/test-pca.R b/tests/testthat/test-pca.R index 4de07abb..8fe6205b 100644 --- a/tests/testthat/test-pca.R +++ b/tests/testthat/test-pca.R @@ -56,7 +56,10 @@ test_that("pca module works as expected in the test app", { res <- app$get_value(input = ns("show_matrix")) expect_true(res) - app$expect_select_screenshot(ns("plot_pca-plot_main")) # 1 + res <- app$get_value(output = ns("test_pca")) + expect_snapshot( + cat(res) + ) # Add a gene filter and deselect everything and check that it does not crash. app$set_inputs(!!ns2("add-MAE-hd1-row_to_add") := "symbol") @@ -66,7 +69,7 @@ test_that("pca module works as expected in the test app", { app$set_inputs(!!ns2("active-MAE-hd1-MAE_symbol_hd1_subset-inputs-selection_open") := FALSE, allow_no_input_binding_ = TRUE) app$wait_for_idle() - res <- app$get_value(output = ns("plot_pca-plot_main")) + res <- app$get_value(output = ns("test_pca")) expect_match(res$message, "No genes or samples included in this experiment, please adjust filters") # Remove filters @@ -88,8 +91,10 @@ test_that("pca module works as expected in the test app", { res <- app$get_value(input = ns("show_matrix")) expect_true(res) - app$expect_select_screenshot(ns("plot_cor-plot_main")) # 2 - app$expect_select_screenshot(ns("table_cor")) # 3 + res <- app$get_value(output = ns("test_cor")) + expect_snapshot( + cat(res) + ) # Now update experiment name, assay name, cluster & matrix option on correlation tab. app$set_inputs(!!ns("experiment-name") := "hd2") @@ -98,7 +103,10 @@ test_that("pca module works as expected in the test app", { app$set_inputs(!!ns("show_matrix") := FALSE) app$wait_for_idle() - app$expect_select_screenshot(ns("plot_cor-plot_main")) # 4 + res <- app$get_value(output = ns("test_cor")) + expect_snapshot( + cat(res) + ) # Now go back to pca tab and update experiment, assay name, variance % option, # label option and matrix option. @@ -110,8 +118,10 @@ test_that("pca module works as expected in the test app", { app$set_inputs(!!ns("label") := FALSE) app$wait_for_idle() - app$expect_select_screenshot(ns("plot_pca-plot_main")) - app$expect_select_screenshot(ns("table_pca")) + res <- app$get_value(output = ns("test_pca")) + expect_snapshot( + cat(res) + ) # Update experiment / assay (ensure xvar and yvar revert back to PC1 and PC2, assay to counts) # and add color for pca. @@ -165,7 +175,10 @@ test_that("pca module works as expected in the test app", { res <- app$get_value(input = ns("y_var")) expect_identical(res, "2") - app$expect_select_screenshot(ns("plot_pca-plot_main")) + res <- app$get_value(output = ns("test_pca")) + expect_snapshot( + cat(res) + ) # Update to cor tab. app$set_inputs(!!ns2("active-MAE-subjects-MAE_SEX-inputs-selection_open") := TRUE, allow_no_input_binding_ = TRUE) @@ -173,7 +186,7 @@ test_that("pca module works as expected in the test app", { app$set_inputs(!!ns2("active-MAE-subjects-MAE_SEX-inputs-selection_open") := FALSE, allow_no_input_binding_ = TRUE) app$wait_for_idle() - res <- app$get_value(output = ns("plot_pca-plot_main")) + res <- app$get_value(output = ns("test_pca")) expect_identical(res$message, "Sample size is too small. PCA needs more than 2 samples.") # Remove filter. @@ -184,7 +197,10 @@ test_that("pca module works as expected in the test app", { res <- app$wait_for_value(input = ns("n_top")) expect_identical(res, 500L) - app$expect_select_screenshot(ns("plot_pca-plot_main")) + res <- app$get_value(output = ns("test_pca")) + expect_snapshot( + cat(res) + ) # Change the number of top genes. app$set_inputs(!!ns("n_top") := 777L) @@ -199,12 +215,18 @@ test_that("pca module works as expected in the test app", { # Increase number of top genes to maximum. app$set_inputs(!!ns("n_top") := 2500L) app$wait_for_idle() - app$expect_select_screenshot(ns("plot_pca-plot_main")) + res <- app$get_value(output = ns("test_pca")) + expect_snapshot( + cat(res) + ) # Switch off gene filtering and check that table is still the same. app$set_inputs(!!ns("filter_top") := FALSE) app$wait_for_idle() - app$expect_select_screenshot(ns("plot_pca-plot_main")) + res <- app$get_value(output = ns("test_pca")) + expect_snapshot( + cat(res) + ) # Go back to first experiment and check that n_top stayed the same. app$set_inputs(!!ns("experiment-name") := "hd1") diff --git a/tests/testthat/test-quality.R b/tests/testthat/test-quality.R index f8847ab8..e51968b1 100644 --- a/tests/testthat/test-quality.R +++ b/tests/testthat/test-quality.R @@ -45,11 +45,14 @@ test_that("quality module works as expected in the test app", { # Check that warning message for at least 2 genes works as expected. app$set_inputs(!!ns("min_cpm") := 54356) - res <- app$wait_for_value(output = ns("plot-plot_out_main")) + res <- app$wait_for_value(output = ns("table")) expect_identical(res$message, "Please change gene filters to ensure that there are at least 2 genes") # Initial plot. - app$expect_select_screenshot(ns("plot-plot_out_main")) + res <- app$get_value(output = ns("table")) + expect_snapshot( + res + ) # Choose another experiment. app$set_inputs(!!ns("experiment-name") := "hd3") @@ -63,13 +66,19 @@ test_that("quality module works as expected in the test app", { expect_identical(res, 1777260L) # Final histogram plot. - app$expect_select_screenshot(ns("plot-plot_out_main")) + res <- app$get_value(output = ns("table")) + expect_snapshot( + cat(res) + ) # Change to another plot type so that we can choose another assay. app$set_inputs(!!ns("plot_type") := "Top Genes Plot") app$set_inputs(!!ns("assay-name") := "cpm") app$wait_for_idle(timeout = 30000) - app$expect_select_screenshot(ns("plot-plot_out_main")) + res <- app$get_value(output = ns("table")) + expect_snapshot( + cat(res) + ) app$stop() }) diff --git a/tests/testthat/test-scatterplot.R b/tests/testthat/test-scatterplot.R index beab64fb..9495d235 100644 --- a/tests/testthat/test-scatterplot.R +++ b/tests/testthat/test-scatterplot.R @@ -40,7 +40,7 @@ test_that("scatterplot module works as expected in the test app", { res <- app$get_value(input = ns("experiment-name")) expect_identical(res, "hd1") - res <- app$get_value(output = ns("plot-plot_out_main")) + res <- app$get_value(output = ns("table")) expect_identical(res$message, "No assays eligible for this experiment, please make sure to add normalized assays") # Choose another experiment. @@ -55,7 +55,7 @@ test_that("scatterplot module works as expected in the test app", { res <- app$get_value(input = ns("y_spec-genes")) expect_null(res) - res <- app$get_value(output = ns("plot-plot_out_main")) + res <- app$get_value(output = ns("table")) expect_identical(res$message, "please select at least one gene") # Set one gene each. @@ -90,7 +90,10 @@ test_that("scatterplot module works as expected in the test app", { app$set_inputs(!!ns("facet_var-sample_var") := "AGE18") 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() }) diff --git a/tests/testthat/test-volcanoplot.R b/tests/testthat/test-volcanoplot.R index 7bcca117..c394f88c 100644 --- a/tests/testthat/test-volcanoplot.R +++ b/tests/testthat/test-volcanoplot.R @@ -39,19 +39,21 @@ test_that("volcanoplot 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("test")) expect_identical(res$message, "Please select a group variable") # Select an initial group variable. app$set_inputs(!!ns("compare_group-sample_var") := "AGE18") app$wait_for_idle() - app$expect_select_screenshot(ns("plot-plot_out_main")) + res <- app$get_value(output = ns("test")) + expect_snapshot(cat(res)) # Now change the log2_fc_thresh and check that the plot is updated accordingly. app$set_inputs(!!ns("log2_fc_thresh") := 8) - app$expect_select_screenshot(ns("plot-plot_out_main")) + res <- app$get_value(output = ns("test")) + expect_snapshot(cat(res)) app$stop() }) diff --git a/tests/testthat/volcanoplot/app.R b/tests/testthat/volcanoplot/app.R index cffb3523..2b544400 100644 --- a/tests/testthat/volcanoplot/app.R +++ b/tests/testthat/volcanoplot/app.R @@ -1,3 +1,3 @@ library(teal.modules.hermes) -sample_tm_g_volcanoplot() +sample_tm_g_volcanoplot(.test = TRUE)