From 32985d9e48604155ff96a383d60d80d41861e926 Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Wed, 10 Jun 2026 17:12:33 +0200 Subject: [PATCH 1/9] add shinytest2 tests for importQFeatures --- .Rbuildignore | 1 + .gitignore | 2 + DESCRIPTION | 3 +- tests/testthat.R | 5 +- .../test-shinytest2-importQFeatures.R | 95 +++++++++++++++++++ 5 files changed, 101 insertions(+), 5 deletions(-) create mode 100644 tests/testthat/test-shinytest2-importQFeatures.R diff --git a/.Rbuildignore b/.Rbuildignore index d0b72e8..1dd9b07 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -9,3 +9,4 @@ ^doc$ ^Meta$ ^\.lintr$ +_\.new\.png$ diff --git a/.gitignore b/.gitignore index 3a87515..105e080 100644 --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,5 @@ docs /Meta/ TODO .vscode/settings.json +# {shinytest2}: Ignore new debug snapshots for `$expect_values()` +*_.new.png diff --git a/DESCRIPTION b/DESCRIPTION index 1b46c67..0dc1028 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,7 +46,8 @@ Depends: Suggests: knitr, BiocStyle, - testthat (>= 3.0.0) + testthat (>= 3.0.0), + shinytest2 Roxygen: list(markdown = TRUE) VignetteBuilder: knitr Config/testthat/edition: 3 diff --git a/tests/testthat.R b/tests/testthat.R index 1a06905..7d25b5b 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1 @@ -library(testthat) -library(QFeaturesGUI) - -test_check("QFeaturesGUI") +shinytest2::test_app() diff --git a/tests/testthat/test-shinytest2-importQFeatures.R b/tests/testthat/test-shinytest2-importQFeatures.R new file mode 100644 index 0000000..3b422d5 --- /dev/null +++ b/tests/testthat/test-shinytest2-importQFeatures.R @@ -0,0 +1,95 @@ +library(shinytest2) + +test_that("{shinytest2}: twoTable_importQFeatures", { + testthat::skip_on_cran() + + data("inputTable", package = "QFeaturesGUI") + data("sampleTable", package = "QFeaturesGUI") + + appObject <- QFeaturesGUI::importQFeatures( + colData = sampleTable, + assayData = inputTable + ) + + app <- AppDriver$new( + appObject, + name = "twoTable_importQFeatures", + height = 1080, + width = 1619 + ) + + app$wait_for_idle() + + app$set_inputs(`readqfeatures-run_col` = "Raw.file") + app$set_inputs(`readqfeatures-removeEmptyCols` = TRUE) + app$set_inputs(`readqfeatures-singlecell` = TRUE) + app$click("readqfeatures-convert") + + app$wait_for_idle() + + download <- app$get_download("readqfeatures-downloadQFeatures") + testthat::expect_true(file.exists(download)) + testthat::expect_setequal( + utils::unzip(download, list = TRUE)$Name, + c( + "importQFeatures_QFeatures_object.rds", + "importQFeatures_sessionInfo.html", + "importQFeatures_script.R" + ) + ) + + extract_dir <- tempfile("qfeatures-download-") + dir.create(extract_dir) + utils::unzip( + download, + files = "importQFeatures_QFeatures_object.rds", + exdir = extract_dir + ) + + exported <- readRDS(file.path( + extract_dir, + "importQFeatures_QFeatures_object.rds" + )) + + expected <- QFeatures::readQFeatures( + assayData = inputTable, + colData = sampleTable, + runCol = "Raw.file", + quantCols = NULL, + removeEmptyCols = TRUE, + verbose = FALSE + ) + expected <- QFeatures::zeroIsNA(expected, i = seq_along(expected)) + for (i in seq_along(expected)) { + expected[[i]] <- QFeatures::logTransform(expected[[i]], base = 2) + } + expected <- QFeatures::setQFeaturesType(expected, type = "scp") + names(expected) <- paste0(names(expected), "_initial_import") + + ordered_col_data <- function(object) { + col_data <- as.data.frame(SummarizedExperiment::colData(object)) + col_data[order(rownames(col_data)), , drop = FALSE] + } + + testthat::expect_equal( + QFeatures::getQFeaturesType(exported), + QFeatures::getQFeaturesType(expected) + ) + testthat::expect_setequal(names(exported), names(expected)) + testthat::expect_equal(ordered_col_data(exported), ordered_col_data(expected)) + + for (assay_name in sort(names(expected))) { + testthat::expect_equal( + SummarizedExperiment::assay(exported[[assay_name]]), + SummarizedExperiment::assay(expected[[assay_name]]) + ) + testthat::expect_equal( + as.data.frame(SummarizedExperiment::rowData(exported[[assay_name]])), + as.data.frame(SummarizedExperiment::rowData(expected[[assay_name]])) + ) + testthat::expect_equal( + as.data.frame(SummarizedExperiment::colData(exported[[assay_name]])), + as.data.frame(SummarizedExperiment::colData(expected[[assay_name]])) + ) + } +}) From 12239cc29cc5f4257a5e7a467e4dda39f18f3dd2 Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Thu, 11 Jun 2026 10:56:34 +0200 Subject: [PATCH 2/9] uniform names for importQFeatures_script --- R/code_generator_importQFeatures.R | 1 + .../test-shinytest2-importQFeatures.R | 58 +++++++++++++------ 2 files changed, 40 insertions(+), 19 deletions(-) diff --git a/R/code_generator_importQFeatures.R b/R/code_generator_importQFeatures.R index 5e4fa1a..6d893e7 100644 --- a/R/code_generator_importQFeatures.R +++ b/R/code_generator_importQFeatures.R @@ -56,6 +56,7 @@ code_generator_read_qfeatures <- function(input_table, sample_table, qfeatures, if (singlcelldata) { codeLines <- c(codeLines, "\nqfeatures <- setQFeaturesType(\n\tqfeatures,\n\ttype = 'scp'\n)") } + codeLines <- c(codeLines, "\nnames(qfeatures) <- paste0(\n\tnames(qfeatures),\n\t'_initial_import'\n)") codeLines } diff --git a/tests/testthat/test-shinytest2-importQFeatures.R b/tests/testthat/test-shinytest2-importQFeatures.R index 3b422d5..349c560 100644 --- a/tests/testthat/test-shinytest2-importQFeatures.R +++ b/tests/testthat/test-shinytest2-importQFeatures.R @@ -42,7 +42,10 @@ test_that("{shinytest2}: twoTable_importQFeatures", { dir.create(extract_dir) utils::unzip( download, - files = "importQFeatures_QFeatures_object.rds", + files = c( + "importQFeatures_QFeatures_object.rds", + "importQFeatures_script.R" + ), exdir = extract_dir ) @@ -71,25 +74,42 @@ test_that("{shinytest2}: twoTable_importQFeatures", { col_data[order(rownames(col_data)), , drop = FALSE] } - testthat::expect_equal( - QFeatures::getQFeaturesType(exported), - QFeatures::getQFeaturesType(expected) - ) - testthat::expect_setequal(names(exported), names(expected)) - testthat::expect_equal(ordered_col_data(exported), ordered_col_data(expected)) - - for (assay_name in sort(names(expected))) { - testthat::expect_equal( - SummarizedExperiment::assay(exported[[assay_name]]), - SummarizedExperiment::assay(expected[[assay_name]]) - ) - testthat::expect_equal( - as.data.frame(SummarizedExperiment::rowData(exported[[assay_name]])), - as.data.frame(SummarizedExperiment::rowData(expected[[assay_name]])) - ) + expect_qfeatures_equal <- function(actual, expected) { testthat::expect_equal( - as.data.frame(SummarizedExperiment::colData(exported[[assay_name]])), - as.data.frame(SummarizedExperiment::colData(expected[[assay_name]])) + QFeatures::getQFeaturesType(actual), + QFeatures::getQFeaturesType(expected) ) + testthat::expect_setequal(names(actual), names(expected)) + testthat::expect_equal(ordered_col_data(actual), ordered_col_data(expected)) + + for (assay_name in sort(names(expected))) { + testthat::expect_equal( + SummarizedExperiment::assay(actual[[assay_name]]), + SummarizedExperiment::assay(expected[[assay_name]]) + ) + testthat::expect_equal( + as.data.frame(SummarizedExperiment::rowData(actual[[assay_name]])), + as.data.frame(SummarizedExperiment::rowData(expected[[assay_name]])) + ) + testthat::expect_equal( + as.data.frame(SummarizedExperiment::colData(actual[[assay_name]])), + as.data.frame(SummarizedExperiment::colData(expected[[assay_name]])) + ) + } } + + expect_qfeatures_equal(exported, expected) + + script_env <- new.env(parent = globalenv()) + script_env$dataFrame1 <- inputTable + script_env$dataFrame2 <- sampleTable + suppressPackageStartupMessages(source( + file.path(extract_dir, "importQFeatures_script.R"), + local = script_env + )) + + testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) + script_qfeatures <- script_env$qfeatures + + expect_qfeatures_equal(script_qfeatures, exported) }) From 73a9e31fa074e56da698ffd6487b45154b1b7e2d Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Thu, 11 Jun 2026 11:08:04 +0200 Subject: [PATCH 3/9] add shinytest for the single set case --- .../test-shinytest2-importQFeatures.R | 111 +++++++++++++++++- 1 file changed, 110 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-shinytest2-importQFeatures.R b/tests/testthat/test-shinytest2-importQFeatures.R index 349c560..ce75585 100644 --- a/tests/testthat/test-shinytest2-importQFeatures.R +++ b/tests/testthat/test-shinytest2-importQFeatures.R @@ -6,7 +6,7 @@ test_that("{shinytest2}: twoTable_importQFeatures", { data("inputTable", package = "QFeaturesGUI") data("sampleTable", package = "QFeaturesGUI") - appObject <- QFeaturesGUI::importQFeatures( + appObject <- importQFeatures( colData = sampleTable, assayData = inputTable ) @@ -113,3 +113,112 @@ test_that("{shinytest2}: twoTable_importQFeatures", { expect_qfeatures_equal(script_qfeatures, exported) }) + +test_that("{shinytest2}: oneTable_importQFeatures", { + testthat::skip_on_cran() + + data("inputTable", package = "QFeaturesGUI") + + appObject <- importQFeatures( + assayData = inputTable + ) + + app <- AppDriver$new( + appObject, + name = "oneTable_importQFeatures", + height = 1080, + width = 1619 + ) + + app$wait_for_idle() + + + app$set_inputs(`readqfeatures-quant_cols` = c("Reporter.intensity.1", "Reporter.intensity.2", "Reporter.intensity.16", "Reporter.intensity.15", "Reporter.intensity.14", "Reporter.intensity.13", "Reporter.intensity.12", "Reporter.intensity.11", "Reporter.intensity.10", "Reporter.intensity.9", "Reporter.intensity.8", "Reporter.intensity.7", "Reporter.intensity.6", "Reporter.intensity.5", "Reporter.intensity.4", "Reporter.intensity.3")) + app$set_inputs(`readqfeatures-run_col` = "Raw.file") + app$set_inputs(`readqfeatures-zero_as_NA` = FALSE) + app$set_inputs(`readqfeatures-logTransform` = FALSE) + app$set_inputs(`readqfeatures-removeEmptyCols` = TRUE) + app$click("readqfeatures-convert") + + app$wait_for_idle() + + download <- app$get_download("readqfeatures-downloadQFeatures") + testthat::expect_true(file.exists(download)) + testthat::expect_setequal( + utils::unzip(download, list = TRUE)$Name, + c( + "importQFeatures_QFeatures_object.rds", + "importQFeatures_sessionInfo.html", + "importQFeatures_script.R" + ) + ) + + extract_dir <- tempfile("qfeatures-download-") + dir.create(extract_dir) + utils::unzip( + download, + files = c( + "importQFeatures_QFeatures_object.rds", + "importQFeatures_script.R" + ), + exdir = extract_dir + ) + + exported <- readRDS(file.path( + extract_dir, + "importQFeatures_QFeatures_object.rds" + )) + + expected <- QFeatures::readQFeatures( + assayData = inputTable, + runCol = "Raw.file", + quantCols = c("Reporter.intensity.1", "Reporter.intensity.2", "Reporter.intensity.16", "Reporter.intensity.15", "Reporter.intensity.14", "Reporter.intensity.13", "Reporter.intensity.12", "Reporter.intensity.11", "Reporter.intensity.10", "Reporter.intensity.9", "Reporter.intensity.8", "Reporter.intensity.7", "Reporter.intensity.6", "Reporter.intensity.5", "Reporter.intensity.4", "Reporter.intensity.3"), + removeEmptyCols = TRUE, + verbose = FALSE + ) + names(expected) <- paste0(names(expected), "_initial_import") + + ordered_col_data <- function(object) { + col_data <- as.data.frame(SummarizedExperiment::colData(object)) + col_data[order(rownames(col_data)), , drop = FALSE] + } + + expect_qfeatures_equal <- function(actual, expected) { + testthat::expect_equal( + QFeatures::getQFeaturesType(actual), + QFeatures::getQFeaturesType(expected) + ) + testthat::expect_setequal(names(actual), names(expected)) + testthat::expect_equal(ordered_col_data(actual), ordered_col_data(expected)) + + for (assay_name in sort(names(expected))) { + testthat::expect_equal( + SummarizedExperiment::assay(actual[[assay_name]]), + SummarizedExperiment::assay(expected[[assay_name]]) + ) + testthat::expect_equal( + as.data.frame(SummarizedExperiment::rowData(actual[[assay_name]])), + as.data.frame(SummarizedExperiment::rowData(expected[[assay_name]])) + ) + testthat::expect_equal( + as.data.frame(SummarizedExperiment::colData(actual[[assay_name]])), + as.data.frame(SummarizedExperiment::colData(expected[[assay_name]])) + ) + } + } + + expect_qfeatures_equal(exported, expected) + + script_env <- new.env(parent = globalenv()) + script_env$dataFrame1 <- inputTable + script_env$dataFrame2 <- sampleTable + suppressPackageStartupMessages(source( + file.path(extract_dir, "importQFeatures_script.R"), + local = script_env + )) + + testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) + script_qfeatures <- script_env$qfeatures + + expect_qfeatures_equal(script_qfeatures, exported) +}) From dc95f71db9c60087f55c7fe1e65339a5a9b8258a Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Thu, 11 Jun 2026 17:14:04 +0200 Subject: [PATCH 4/9] first tentative to add processQFeatures shinytesting --- tests/testthat.R | 5 +- .../test-shinytest2-importQFeatures.R | 68 +-------- .../test-shinytest2-processQFeatures.R | 135 ++++++++++++++++++ 3 files changed, 143 insertions(+), 65 deletions(-) create mode 100644 tests/testthat/test-shinytest2-processQFeatures.R diff --git a/tests/testthat.R b/tests/testthat.R index 7d25b5b..1a06905 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1 +1,4 @@ -shinytest2::test_app() +library(testthat) +library(QFeaturesGUI) + +test_check("QFeaturesGUI") diff --git a/tests/testthat/test-shinytest2-importQFeatures.R b/tests/testthat/test-shinytest2-importQFeatures.R index ce75585..ef04b9c 100644 --- a/tests/testthat/test-shinytest2-importQFeatures.R +++ b/tests/testthat/test-shinytest2-importQFeatures.R @@ -69,37 +69,7 @@ test_that("{shinytest2}: twoTable_importQFeatures", { expected <- QFeatures::setQFeaturesType(expected, type = "scp") names(expected) <- paste0(names(expected), "_initial_import") - ordered_col_data <- function(object) { - col_data <- as.data.frame(SummarizedExperiment::colData(object)) - col_data[order(rownames(col_data)), , drop = FALSE] - } - - expect_qfeatures_equal <- function(actual, expected) { - testthat::expect_equal( - QFeatures::getQFeaturesType(actual), - QFeatures::getQFeaturesType(expected) - ) - testthat::expect_setequal(names(actual), names(expected)) - testthat::expect_equal(ordered_col_data(actual), ordered_col_data(expected)) - - for (assay_name in sort(names(expected))) { - testthat::expect_equal( - SummarizedExperiment::assay(actual[[assay_name]]), - SummarizedExperiment::assay(expected[[assay_name]]) - ) - testthat::expect_equal( - as.data.frame(SummarizedExperiment::rowData(actual[[assay_name]])), - as.data.frame(SummarizedExperiment::rowData(expected[[assay_name]])) - ) - testthat::expect_equal( - as.data.frame(SummarizedExperiment::colData(actual[[assay_name]])), - as.data.frame(SummarizedExperiment::colData(expected[[assay_name]])) - ) - } - } - - expect_qfeatures_equal(exported, expected) - + expect_identical(object = exported, expected = expected) script_env <- new.env(parent = globalenv()) script_env$dataFrame1 <- inputTable script_env$dataFrame2 <- sampleTable @@ -111,7 +81,7 @@ test_that("{shinytest2}: twoTable_importQFeatures", { testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) script_qfeatures <- script_env$qfeatures - expect_qfeatures_equal(script_qfeatures, exported) + expect_identical(object = script_qfeatures, expected = expected) }) test_that("{shinytest2}: oneTable_importQFeatures", { @@ -178,37 +148,7 @@ test_that("{shinytest2}: oneTable_importQFeatures", { ) names(expected) <- paste0(names(expected), "_initial_import") - ordered_col_data <- function(object) { - col_data <- as.data.frame(SummarizedExperiment::colData(object)) - col_data[order(rownames(col_data)), , drop = FALSE] - } - - expect_qfeatures_equal <- function(actual, expected) { - testthat::expect_equal( - QFeatures::getQFeaturesType(actual), - QFeatures::getQFeaturesType(expected) - ) - testthat::expect_setequal(names(actual), names(expected)) - testthat::expect_equal(ordered_col_data(actual), ordered_col_data(expected)) - - for (assay_name in sort(names(expected))) { - testthat::expect_equal( - SummarizedExperiment::assay(actual[[assay_name]]), - SummarizedExperiment::assay(expected[[assay_name]]) - ) - testthat::expect_equal( - as.data.frame(SummarizedExperiment::rowData(actual[[assay_name]])), - as.data.frame(SummarizedExperiment::rowData(expected[[assay_name]])) - ) - testthat::expect_equal( - as.data.frame(SummarizedExperiment::colData(actual[[assay_name]])), - as.data.frame(SummarizedExperiment::colData(expected[[assay_name]])) - ) - } - } - - expect_qfeatures_equal(exported, expected) - + expect_identical(object = exported, expected = expected) script_env <- new.env(parent = globalenv()) script_env$dataFrame1 <- inputTable script_env$dataFrame2 <- sampleTable @@ -220,5 +160,5 @@ test_that("{shinytest2}: oneTable_importQFeatures", { testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) script_qfeatures <- script_env$qfeatures - expect_qfeatures_equal(script_qfeatures, exported) + expect_identical(object = script_qfeatures, expected = expected) }) diff --git a/tests/testthat/test-shinytest2-processQFeatures.R b/tests/testthat/test-shinytest2-processQFeatures.R new file mode 100644 index 0000000..e258a81 --- /dev/null +++ b/tests/testthat/test-shinytest2-processQFeatures.R @@ -0,0 +1,135 @@ +library(shinytest2) + +test_that("{shinytest2} recording: processQFeatures", { + testthat::skip_on_cran() + + data("inputTable", package = "QFeaturesGUI") + data("sampleTable", package = "QFeaturesGUI") + qf <- QFeatures::readQFeatures( + assayData = inputTable, + colData = sampleTable, + runCol = "Raw.file", + quantCols = NULL, + removeEmptyCols = TRUE, + verbose = FALSE + ) + appObject <- QFeaturesGUI::processQFeatures(qf, prefilledSteps = c("zeroToNA", "logTransform", "sampleFiltering", "featureFiltering", "missingValuesFeatures", + "missingValuesSamples", "normalisation", "aggregation", "join", "aggregation")) + app <- AppDriver$new(appObject, + name = "processQFeatures", height = 1619, width = 1080) + wait_for_input <- function(id, timeout = 10000) { + app$wait_for_js( + sprintf( + "(() => { const el = document.getElementById('%s'); return !!(el && window.jQuery && window.jQuery(el).data('shinyInputBinding')); })()", + id + ), + timeout = timeout + ) + } + wait_for_step <- function(step_number, timeout = 30000) { + selector <- sprintf("a[data-value=\"step_%s\"]", step_number) + app$wait_for_js( + sprintf("document.querySelector('%s') !== null", selector), + timeout = timeout + ) + app$click(selector = selector) + } + + app$wait_for_js("document.getElementById('zeroToNA_1_v1-export') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_1\"]") + app$click("zeroToNA_1_v1-export") + app$wait_for_js("document.getElementById('logTransform_2_v1-apply_log_transform') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_2\"]") + app$set_inputs(`logTransform_2_v1-log_base` = "log2", wait_ = FALSE) + app$set_inputs(`logTransform_2_v1-color` = "NULL", wait_ = FALSE) + app$set_inputs(`logTransform_2_v1-pseudocount` = 0, wait_ = FALSE) + app$click("logTransform_2_v1-apply_log_transform") + app$click("logTransform_2_v1-export") + app$wait_for_js("document.getElementById('sampleFiltering_3_v1-add_box') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_3\"]") + app$click("sampleFiltering_3_v1-add_box") + wait_for_input("sampleFiltering_3_v1-filtering_1-annotation_selection") + app$set_inputs(`sampleFiltering_3_v1-filtering_1-annotation_selection` = "SampleType") + app$set_inputs(`sampleFiltering_3_v1-filtering_1-filter_operator` = "is_not_missing") + app$click("sampleFiltering_3_v1-add_box") + wait_for_input("sampleFiltering_3_v1-filtering_2-annotation_selection") + app$set_inputs(`sampleFiltering_3_v1-filtering_2-annotation_selection` = "SampleType") + wait_for_input("sampleFiltering_3_v1-filtering_2-filter_ui_samples") + app$set_inputs(`sampleFiltering_3_v1-filtering_2-filter_ui_samples` = c("Monocyte", + "Macrophage"), wait_ = FALSE) + app$click("sampleFiltering_3_v1-apply_filters") + app$click("sampleFiltering_3_v1-export") + app$wait_for_js("document.getElementById('featureFiltering_4_v1-add_box') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_4\"]") + app$click("featureFiltering_4_v1-add_box") + wait_for_input("featureFiltering_4_v1-filtering_1-annotation_selection") + app$set_inputs(`featureFiltering_4_v1-filtering_1-annotation_selection` = "Potential.contaminant") + app$set_inputs(`featureFiltering_4_v1-filtering_1-filter_operator` = "!=") + wait_for_input("featureFiltering_4_v1-filtering_1-filter_ui_features") + app$set_inputs(`featureFiltering_4_v1-filtering_1-filter_ui_features` = "+") + app$click("featureFiltering_4_v1-add_box") + wait_for_input("featureFiltering_4_v1-filtering_2-annotation_selection") + app$set_inputs(`featureFiltering_4_v1-filtering_2-annotation_selection` = "Reverse") + app$set_inputs(`featureFiltering_4_v1-filtering_2-filter_operator` = "is_not_missing") + app$set_inputs(`featureFiltering_4_v1-filtering_2-filter_operator` = "!=") + wait_for_input("featureFiltering_4_v1-filtering_2-filter_ui_features") + app$set_inputs(`featureFiltering_4_v1-filtering_2-filter_ui_features` = "+") + app$click("featureFiltering_4_v1-add_box") + wait_for_input("featureFiltering_4_v1-filtering_3-annotation_selection") + app$set_inputs(`featureFiltering_4_v1-filtering_3-annotation_selection` = "Length") + app$set_inputs(`featureFiltering_4_v1-filtering_3-filter_operator` = "<=") + wait_for_input("featureFiltering_4_v1-filtering_3-filter_ui_features") + app$set_inputs(`featureFiltering_4_v1-filtering_3-filter_ui_features` = 15) + app$click("featureFiltering_4_v1-apply_filters") + app$click("featureFiltering_4_v1-export") + app$wait_for_js("document.getElementById('missingValuesFeatures_5_v1-export') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_5\"]") + app$set_inputs(`missingValuesFeatures_5_v1-threshold_features` = 0.75) + app$click("missingValuesFeatures_5_v1-export") + app$wait_for_js("document.getElementById('missingValuesSamples_6_v1-export') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_6\"]") + app$set_inputs(`missingValuesSamples_6_v1-threshold_samples` = 0.5) + app$click("missingValuesSamples_6_v1-export") + app$wait_for_js("document.getElementById('normalisation_7_v1-apply_normalisation') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_7\"]") + app$set_inputs(`normalisation_7_v1-method` = "diff.median") + app$click("normalisation_7_v1-apply_normalisation") + app$click("normalisation_7_v1-export") + app$wait_for_js("document.getElementById('aggregation_8_v1-aggregate') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_8\"]") + app$set_inputs(`aggregation_8_v1-method` = "colMedians") + app$set_inputs(`aggregation_8_v1-fcol` = "Modified.sequence") + app$click("aggregation_8_v1-aggregate") + app$set_inputs(`aggregation_8_v1-features` = "_(Acetyl (Protein N-term))ATNFLAHEK_") + app$click("aggregation_8_v1-export") + wait_for_step(9) + app$wait_for_js("document.getElementById('join_9_v1-export') !== null", timeout = 30000) + app$set_inputs(`join_9_v1-feature_type` = "peptides") + app$click("join_9_v1-export") + wait_for_step(10) + app$wait_for_js("document.getElementById('aggregation_10_v1-aggregate') !== null", timeout = 30000) + app$set_inputs(`aggregation_10_v1-method` = "colMedians") + app$set_inputs(`aggregation_10_v1-fcol` = "Leading.razor.protein") + app$click("aggregation_10_v1-aggregate") + app$set_inputs(`aggregation_10_v1-features` = "P84090") + app$click("aggregation_10_v1-export") + app$click(selector = "a[data-value=\"summary_tab\"]") + app$wait_for_js( + "document.getElementById('summary_tab-download_qfeatures') !== null && document.getElementById('summary_tab-download_qfeatures').offsetParent !== null", + timeout = 10000 + ) + app$wait_for_js( + "document.getElementById('summary_tab-download_qfeatures').getAttribute('href') !== ''", + timeout = 10000 + ) + download <- app$get_download("summary_tab-download_qfeatures") + testthat::expect_true(file.exists(download)) + testthat::expect_setequal( + utils::unzip(download, list = TRUE)$Name, + c( + "processQFeatures_QFeatures_object.rds", + "processQFeatures_sessionInfo.html", + "processQFeatures_script.R" + ) + ) +}) From 870632da63f1660f5aec06b259efe721fb675086 Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Fri, 12 Jun 2026 13:44:48 +0200 Subject: [PATCH 5/9] add custom test for QFeatures identity --- tests/testthat/helper-qfeatures.R | 97 +++++++++++++++++++ .../test-shinytest2-importQFeatures.R | 9 +- 2 files changed, 101 insertions(+), 5 deletions(-) diff --git a/tests/testthat/helper-qfeatures.R b/tests/testthat/helper-qfeatures.R index 2725eda..8bec3b3 100644 --- a/tests/testthat/helper-qfeatures.R +++ b/tests/testthat/helper-qfeatures.R @@ -56,3 +56,100 @@ make_test_qfeatures <- function() { colData = sample_data ) } + +normalise_test_data_frame <- function(df, sort_rows = TRUE) { + df <- as.data.frame(df) + df[] <- lapply(df, function(x) { + if (is.factor(x)) { + as.character(x) + } else { + x + } + }) + if (sort_rows && !is.null(rownames(df))) { + df <- df[order(rownames(df)), , drop = FALSE] + } + df +} + +normalise_test_sample_map <- function(object) { + sample_map <- as.data.frame(MultiAssayExperiment::sampleMap(object)) + sample_map[] <- lapply(sample_map, as.character) + sample_map <- sample_map[do.call(order, sample_map), , drop = FALSE] + rownames(sample_map) <- NULL + sample_map +} + +expect_equal_data_frame_by_rowname <- function(object, expected) { + object <- normalise_test_data_frame(object) + expected <- normalise_test_data_frame(expected) + testthat::expect_setequal(rownames(object), rownames(expected)) + testthat::expect_setequal(colnames(object), colnames(expected)) + object <- object[rownames(expected), colnames(expected), drop = FALSE] + testthat::expect_equal(object, expected) +} + +expect_equal_summarized_experiment_assays <- function(object, expected) { + object_assays <- SummarizedExperiment::assays(object) + expected_assays <- SummarizedExperiment::assays(expected) + object_names <- names(object_assays) + expected_names <- names(expected_assays) + + if (is.null(object_names) && is.null(expected_names)) { + testthat::expect_equal(length(object_assays), length(expected_assays)) + for (i in seq_along(expected_assays)) { + testthat::expect_equal(object_assays[[i]], expected_assays[[i]]) + } + return(invisible(NULL)) + } + + if (is.null(object_names)) { + object_names <- as.character(seq_along(object_assays)) + } + if (is.null(expected_names)) { + expected_names <- as.character(seq_along(expected_assays)) + } + + testthat::expect_setequal(object_names, expected_names) + for (assay_name in expected_names) { + object_index <- match(assay_name, object_names) + expected_index <- match(assay_name, expected_names) + testthat::expect_equal( + object_assays[[object_index]], + expected_assays[[expected_index]] + ) + } + invisible(NULL) +} + +expect_qfeatures_equal <- function(object, expected) { + testthat::expect_s4_class(object, "QFeatures") + testthat::expect_s4_class(expected, "QFeatures") + testthat::expect_equal( + QFeatures::getQFeaturesType(object), + QFeatures::getQFeaturesType(expected) + ) + testthat::expect_setequal(names(object), names(expected)) + expect_equal_data_frame_by_rowname( + SummarizedExperiment::colData(object), + SummarizedExperiment::colData(expected) + ) + testthat::expect_equal( + normalise_test_sample_map(object), + normalise_test_sample_map(expected) + ) + for (assay_name in sort(names(expected))) { + object_assay <- object[[assay_name]] + expected_assay <- expected[[assay_name]] + + expect_equal_summarized_experiment_assays(object_assay, expected_assay) + expect_equal_data_frame_by_rowname( + SummarizedExperiment::rowData(object_assay), + SummarizedExperiment::rowData(expected_assay) + ) + expect_equal_data_frame_by_rowname( + SummarizedExperiment::colData(object_assay), + SummarizedExperiment::colData(expected_assay) + ) + } +} diff --git a/tests/testthat/test-shinytest2-importQFeatures.R b/tests/testthat/test-shinytest2-importQFeatures.R index ef04b9c..066296a 100644 --- a/tests/testthat/test-shinytest2-importQFeatures.R +++ b/tests/testthat/test-shinytest2-importQFeatures.R @@ -69,7 +69,7 @@ test_that("{shinytest2}: twoTable_importQFeatures", { expected <- QFeatures::setQFeaturesType(expected, type = "scp") names(expected) <- paste0(names(expected), "_initial_import") - expect_identical(object = exported, expected = expected) + expect_qfeatures_equal(object = exported, expected = expected) script_env <- new.env(parent = globalenv()) script_env$dataFrame1 <- inputTable script_env$dataFrame2 <- sampleTable @@ -81,7 +81,7 @@ test_that("{shinytest2}: twoTable_importQFeatures", { testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) script_qfeatures <- script_env$qfeatures - expect_identical(object = script_qfeatures, expected = expected) + expect_qfeatures_equal(object = script_qfeatures, expected = exported) }) test_that("{shinytest2}: oneTable_importQFeatures", { @@ -148,10 +148,9 @@ test_that("{shinytest2}: oneTable_importQFeatures", { ) names(expected) <- paste0(names(expected), "_initial_import") - expect_identical(object = exported, expected = expected) + expect_qfeatures_equal(object = exported, expected = expected) script_env <- new.env(parent = globalenv()) script_env$dataFrame1 <- inputTable - script_env$dataFrame2 <- sampleTable suppressPackageStartupMessages(source( file.path(extract_dir, "importQFeatures_script.R"), local = script_env @@ -160,5 +159,5 @@ test_that("{shinytest2}: oneTable_importQFeatures", { testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) script_qfeatures <- script_env$qfeatures - expect_identical(object = script_qfeatures, expected = expected) + expect_qfeatures_equal(object = script_qfeatures, expected = exported) }) From 8f50882986882b4279ca22308231267dd9483c95 Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Sun, 14 Jun 2026 20:49:43 +0200 Subject: [PATCH 6/9] =?UTF-8?q?add=20step=20shinytests=20for=20shinytest?= =?UTF-8?q?=20=C2=A7=20styler?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/build_process_server.R | 147 ++--- R/processQFeatures.R | 28 +- R/server_import_tab.R | 12 +- R/server_module_filtering_box.R | 34 +- R/server_module_filtering_tab.R | 12 +- R/utils_global.R | 30 +- R/utils_processQFeatures.R | 6 +- tests/testthat/helper-qfeatures.R | 4 +- .../test-shinytest2-importQFeatures.R | 310 +++++------ .../test-shinytest2-processQFeatures.R | 513 +++++++++++++----- 10 files changed, 681 insertions(+), 415 deletions(-) diff --git a/R/build_process_server.R b/R/build_process_server.R index 474c62a..1c95e82 100644 --- a/R/build_process_server.R +++ b/R/build_process_server.R @@ -152,84 +152,93 @@ build_process_server <- function(qfeatures, initial_sets, initial_steps, has_qfe )) } - shiny::observeEvent(input$startup_qfeatures_rds, { - uploaded_qfeatures(NULL) - upload_message(NULL) - startup_reading(TRUE) - datapath <- input$startup_qfeatures_rds$datapath + shiny::observeEvent(input$startup_qfeatures_rds, + { + uploaded_qfeatures(NULL) + upload_message(NULL) + startup_reading(TRUE) + datapath <- input$startup_qfeatures_rds$datapath - session$onFlushed(function() { - uploaded <- tryCatch( - check_qfeatures(datapath), - error = function(e) e - ) - startup_reading(FALSE) - if (inherits(uploaded, "error")) { - upload_message(paste( - "Could not load QFeatures object:", - conditionMessage(uploaded) - )) + session$onFlushed(function() { + uploaded <- tryCatch( + check_qfeatures(datapath), + error = function(e) e + ) + startup_reading(FALSE) + if (inherits(uploaded, "error")) { + upload_message(paste( + "Could not load QFeatures object:", + conditionMessage(uploaded) + )) + return(invisible(NULL)) + } + + uploaded_qfeatures(uploaded) + }, once = TRUE) + }, + ignoreInit = TRUE + ) + + shiny::observeEvent(input$startup_load_qfeatures, + { + uploaded <- uploaded_qfeatures() + if (is.null(uploaded)) { + upload_message( + "Upload a valid .rds file containing a QFeatures object." + ) return(invisible(NULL)) } - uploaded_qfeatures(uploaded) - }, once = TRUE) - }, ignoreInit = TRUE) - - shiny::observeEvent(input$startup_load_qfeatures, { - uploaded <- uploaded_qfeatures() - if (is.null(uploaded)) { - upload_message( - "Upload a valid .rds file containing a QFeatures object." + selected_sets <- input$startup_initial_sets + initial_idx <- tryCatch( + normalise_initial_sets(uploaded, selected_sets), + error = function(e) e ) - return(invisible(NULL)) - } - - selected_sets <- input$startup_initial_sets - initial_idx <- tryCatch( - normalise_initial_sets(uploaded, selected_sets), - error = function(e) e - ) - if (inherits(initial_idx, "error")) { - upload_message(conditionMessage(initial_idx)) - return(invisible(NULL)) - } + if (inherits(initial_idx, "error")) { + upload_message(conditionMessage(initial_idx)) + return(invisible(NULL)) + } - workflow_steps <- input[["workflow_config-workflow_list"]] - if (is.null(workflow_steps)) { - workflow_steps <- initial_steps - } + workflow_steps <- input[["workflow_config-workflow_list"]] + if (is.null(workflow_steps)) { + workflow_steps <- initial_steps + } - .qf$qfeatures <- format_qfeatures(uploaded, initial_idx) - global_rv$workflow_config <- workflow_steps - global_rv$code_lines <- list() - shiny::removeModal() + .qf$qfeatures <- format_qfeatures(uploaded, initial_idx) + global_rv$workflow_config <- workflow_steps + global_rv$code_lines <- list() + shiny::removeModal() - n_sets <- length(initial_idx) - n_steps <- length(workflow_steps) - shinyalert( - title = "QFeatures loaded", - text = paste0( - "Loaded QFeatures with ", n_sets, - " initial set", if (n_sets != 1) "s" else "", ".", - if (n_steps > 0) { - paste0( - "\nWorkflow pre-configured with ", n_steps, - " step", if (n_steps != 1) "s" else "", "." - ) - } else { - "" - } - ), - closeOnClickOutside = TRUE, - type = "success", - confirmButtonCol = "#3c8dbc" - ) - }, ignoreInit = TRUE) + n_sets <- length(initial_idx) + n_steps <- length(workflow_steps) + shinyalert( + title = "QFeatures loaded", + text = paste0( + "Loaded QFeatures with ", n_sets, + " initial set", if (n_sets != 1) "s" else "", ".", + if (n_steps > 0) { + paste0( + "\nWorkflow pre-configured with ", n_steps, + " step", if (n_steps != 1) "s" else "", "." + ) + } else { + "" + } + ), + closeOnClickOutside = TRUE, + type = "success", + confirmButtonCol = "#3c8dbc" + ) + }, + ignoreInit = TRUE + ) - shiny::observeEvent(input$startup_show_upload, { - show_startup_upload_modal() - }, ignoreInit = TRUE) + shiny::observeEvent(input$startup_show_upload, + { + show_startup_upload_modal() + }, + ignoreInit = TRUE + ) if (!has_qfeatures) { session$onFlushed(function() { diff --git a/R/processQFeatures.R b/R/processQFeatures.R index 334545a..f2c656d 100644 --- a/R/processQFeatures.R +++ b/R/processQFeatures.R @@ -68,21 +68,19 @@ #' if (interactive()) { #' shiny::runApp(app) #' } -processQFeatures <- function( - qfeatures = NULL, - initialSets = NULL, - prefilledSteps = c( - "sampleFiltering", - "featureFiltering", - "missingValuesFeatures", - "missingValuesSamples", - "normalisation", - "aggregation", - "join", - "aggregation" - ), - maxSize = 100 -) { +processQFeatures <- function(qfeatures = NULL, + initialSets = NULL, + prefilledSteps = c( + "sampleFiltering", + "featureFiltering", + "missingValuesFeatures", + "missingValuesSamples", + "normalisation", + "aggregation", + "join", + "aggregation" + ), + maxSize = 100) { qfeatures_missing <- missing(qfeatures) || is.null(qfeatures) initial_steps <- check_prefilled_steps(prefilledSteps) diff --git a/R/server_import_tab.R b/R/server_import_tab.R index ab37c12..89cecf0 100644 --- a/R/server_import_tab.R +++ b/R/server_import_tab.R @@ -13,13 +13,11 @@ #' @rdname INTERNAL_server_import_tab #' @keywords internal #' -server_import_tab <- function( - input, - output, - session, - sample_table, - input_table -) { +server_import_tab <- function(input, + output, + session, + sample_table, + input_table) { imported_input <- box_read_table_server( id = "input", given_table = input_table diff --git a/R/server_module_filtering_box.R b/R/server_module_filtering_box.R index 2ff7039..8f3a397 100644 --- a/R/server_module_filtering_box.R +++ b/R/server_module_filtering_box.R @@ -369,14 +369,12 @@ server_module_filtering_box <- function(id, assays_to_process, type, state) { #' @importFrom shiny moduleServer observe req eventReactive reactive #' @importFrom plotly plot_ly renderPlotly #' -server_module_annotation_plot <- function( - id, - assays_to_process, - type, - filter_value, - selected_annotation, - filter_operator -) { +server_module_annotation_plot <- function(id, + assays_to_process, + type, + filter_value, + selected_annotation, + filter_operator) { moduleServer(id, function(input, output, session) { rowname_selector_key <- ".qfeaturesgui_rowname" @@ -512,12 +510,10 @@ missingness_filter_plot_values <- function(values, operator) { ) } -missingness_annotation_plot_wrapper <- function( - annotation, - filtered_annotation, - assay_name, - annotation_name -) { +missingness_annotation_plot_wrapper <- function(annotation, + filtered_annotation, + assay_name, + annotation_name) { categories <- levels(annotation) annotation <- factor(annotation, levels = categories) before_counts <- as.integer(table(annotation)) @@ -569,12 +565,10 @@ missingness_annotation_plot_wrapper <- function( #' #' @importFrom plotly plot_ly config %>% add_histogram layout add_annotations #' -annotation_plot_wrapper <- function( - annotation, - filtered_annotation, - assay_name, - annotation_name -) { +annotation_plot_wrapper <- function(annotation, + filtered_annotation, + assay_name, + annotation_name) { if (all(is.na(annotation))) { plot <- plot_ly( x = numeric(0), diff --git a/R/server_module_filtering_tab.R b/R/server_module_filtering_tab.R index 3de05b4..a60120a 100644 --- a/R/server_module_filtering_tab.R +++ b/R/server_module_filtering_tab.R @@ -12,13 +12,11 @@ #' @importFrom shiny moduleServer eventReactive observeEvent renderUI reactiveValues observe NS reactive req reactiveVal icon #' @importFrom htmltools tags #' @importFrom shinydashboard renderInfoBox infoBox -server_module_filtering_tab <- function( - id, - step_number, - step_rv, - parent_rv, - type = c("samples", "features") -) { +server_module_filtering_tab <- function(id, + step_number, + step_rv, + parent_rv, + type = c("samples", "features")) { type <- match.arg(type) moduleServer(id, function(input, output, session) { diff --git a/R/utils_global.R b/R/utils_global.R index cd7fa64..e615b20 100644 --- a/R/utils_global.R +++ b/R/utils_global.R @@ -78,10 +78,12 @@ error_handler <- function(func, component_name, ...) { #' @importFrom htmltools HTML div #' #' @rdname INTERNAL_show_exception_notification -show_exception_notification <- function(component_name, - type = c("error", "warning"), - time, - duration = 30) { +show_exception_notification <- function( + component_name, + type = c("error", "warning"), + time, + duration = 30 +) { type <- match.arg(type) title <- paste0( @@ -203,10 +205,12 @@ loading <- function(msg) { #' @return A UI element wrapped with waiter behavior. #' @rdname INTERNAL_with_output_waiter #' @keywords internal -with_output_waiter <- function(element, - html = waiter::spin_fading_circles(), - color = "rgba(0, 0, 0, 0.25)", - image = "") { +with_output_waiter <- function( + element, + html = waiter::spin_fading_circles(), + color = "rgba(0, 0, 0, 0.25)", + image = "" +) { output_id <- element$attribs$id if (is.null(output_id) && is.list(element) && length(element) > 0L) { first_child <- element[[1]] @@ -485,10 +489,12 @@ page_assays_subset <- function(qfeatures, pattern) { #' @rdname INTERNAL_bs3Tooltip #' @keywords internal #' -bs3Tooltip <- function(trigger, - tooltipText, - placement = c("right", "left", "top", "bottom"), - icon = "fa-info-circle") { +bs3Tooltip <- function( + trigger, + tooltipText, + placement = c("right", "left", "top", "bottom"), + icon = "fa-info-circle" +) { stopifnot( is.character(tooltipText), length(tooltipText) == 1L, is.character(icon), length(icon) == 1L diff --git a/R/utils_processQFeatures.R b/R/utils_processQFeatures.R index db2c1c2..46d3d6b 100644 --- a/R/utils_processQFeatures.R +++ b/R/utils_processQFeatures.R @@ -1316,8 +1316,10 @@ annotation_cols <- function(x, what) { #' @importFrom MsCoreUtils robustSummary medianPolish #' @importFrom waiter Waiter spin_fading_circles #' -aggregation_qfeatures <- function(qfeatures, method, - fcol) { +aggregation_qfeatures <- function( + qfeatures, method, + fcol +) { n <- length(qfeatures) caption <- if (n > 0L) { paste0("Aggregation of 1/", n, " sets") diff --git a/tests/testthat/helper-qfeatures.R b/tests/testthat/helper-qfeatures.R index 8bec3b3..2e5a7cf 100644 --- a/tests/testthat/helper-qfeatures.R +++ b/tests/testthat/helper-qfeatures.R @@ -126,8 +126,8 @@ expect_qfeatures_equal <- function(object, expected) { testthat::expect_s4_class(object, "QFeatures") testthat::expect_s4_class(expected, "QFeatures") testthat::expect_equal( - QFeatures::getQFeaturesType(object), - QFeatures::getQFeaturesType(expected) + suppressMessages(QFeatures::getQFeaturesType(object)), + suppressMessages(QFeatures::getQFeaturesType(expected)) ) testthat::expect_setequal(names(object), names(expected)) expect_equal_data_frame_by_rowname( diff --git a/tests/testthat/test-shinytest2-importQFeatures.R b/tests/testthat/test-shinytest2-importQFeatures.R index 066296a..451c55d 100644 --- a/tests/testthat/test-shinytest2-importQFeatures.R +++ b/tests/testthat/test-shinytest2-importQFeatures.R @@ -1,163 +1,165 @@ library(shinytest2) test_that("{shinytest2}: twoTable_importQFeatures", { - testthat::skip_on_cran() - - data("inputTable", package = "QFeaturesGUI") - data("sampleTable", package = "QFeaturesGUI") - - appObject <- importQFeatures( - colData = sampleTable, - assayData = inputTable - ) - - app <- AppDriver$new( - appObject, - name = "twoTable_importQFeatures", - height = 1080, - width = 1619 - ) - - app$wait_for_idle() - - app$set_inputs(`readqfeatures-run_col` = "Raw.file") - app$set_inputs(`readqfeatures-removeEmptyCols` = TRUE) - app$set_inputs(`readqfeatures-singlecell` = TRUE) - app$click("readqfeatures-convert") - - app$wait_for_idle() - - download <- app$get_download("readqfeatures-downloadQFeatures") - testthat::expect_true(file.exists(download)) - testthat::expect_setequal( - utils::unzip(download, list = TRUE)$Name, - c( - "importQFeatures_QFeatures_object.rds", - "importQFeatures_sessionInfo.html", - "importQFeatures_script.R" + testthat::skip_on_cran() + + data("inputTable", package = "QFeaturesGUI") + data("sampleTable", package = "QFeaturesGUI") + + appObject <- importQFeatures( + colData = sampleTable, + assayData = inputTable + ) + + app <- AppDriver$new( + appObject, + name = "twoTable_importQFeatures", + height = 1080, + width = 1619 + ) + on.exit(app$stop(), add = TRUE) + + app$wait_for_idle() + + app$set_inputs(`readqfeatures-run_col` = "Raw.file") + app$set_inputs(`readqfeatures-removeEmptyCols` = TRUE) + app$set_inputs(`readqfeatures-singlecell` = TRUE) + app$click("readqfeatures-convert") + + app$wait_for_idle() + + download <- app$get_download("readqfeatures-downloadQFeatures") + testthat::expect_true(file.exists(download)) + testthat::expect_setequal( + utils::unzip(download, list = TRUE)$Name, + c( + "importQFeatures_QFeatures_object.rds", + "importQFeatures_sessionInfo.html", + "importQFeatures_script.R" + ) + ) + + extract_dir <- tempfile("qfeatures-download-") + dir.create(extract_dir) + utils::unzip( + download, + files = c( + "importQFeatures_QFeatures_object.rds", + "importQFeatures_script.R" + ), + exdir = extract_dir ) - ) - - extract_dir <- tempfile("qfeatures-download-") - dir.create(extract_dir) - utils::unzip( - download, - files = c( - "importQFeatures_QFeatures_object.rds", - "importQFeatures_script.R" - ), - exdir = extract_dir - ) - - exported <- readRDS(file.path( - extract_dir, - "importQFeatures_QFeatures_object.rds" - )) - - expected <- QFeatures::readQFeatures( - assayData = inputTable, - colData = sampleTable, - runCol = "Raw.file", - quantCols = NULL, - removeEmptyCols = TRUE, - verbose = FALSE - ) - expected <- QFeatures::zeroIsNA(expected, i = seq_along(expected)) - for (i in seq_along(expected)) { - expected[[i]] <- QFeatures::logTransform(expected[[i]], base = 2) - } - expected <- QFeatures::setQFeaturesType(expected, type = "scp") - names(expected) <- paste0(names(expected), "_initial_import") - - expect_qfeatures_equal(object = exported, expected = expected) - script_env <- new.env(parent = globalenv()) - script_env$dataFrame1 <- inputTable - script_env$dataFrame2 <- sampleTable - suppressPackageStartupMessages(source( - file.path(extract_dir, "importQFeatures_script.R"), - local = script_env - )) - - testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) - script_qfeatures <- script_env$qfeatures - - expect_qfeatures_equal(object = script_qfeatures, expected = exported) + + exported <- readRDS(file.path( + extract_dir, + "importQFeatures_QFeatures_object.rds" + )) + + expected <- QFeatures::readQFeatures( + assayData = inputTable, + colData = sampleTable, + runCol = "Raw.file", + quantCols = NULL, + removeEmptyCols = TRUE, + verbose = FALSE + ) + expected <- QFeatures::zeroIsNA(expected, i = seq_along(expected)) + for (i in seq_along(expected)) { + expected[[i]] <- QFeatures::logTransform(expected[[i]], base = 2) + } + expected <- QFeatures::setQFeaturesType(expected, type = "scp") + names(expected) <- paste0(names(expected), "_initial_import") + + expect_qfeatures_equal(object = exported, expected = expected) + script_env <- new.env(parent = globalenv()) + script_env$dataFrame1 <- inputTable + script_env$dataFrame2 <- sampleTable + suppressPackageStartupMessages(source( + file.path(extract_dir, "importQFeatures_script.R"), + local = script_env + )) + + testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) + script_qfeatures <- script_env$qfeatures + + expect_qfeatures_equal(object = script_qfeatures, expected = exported) }) test_that("{shinytest2}: oneTable_importQFeatures", { - testthat::skip_on_cran() - - data("inputTable", package = "QFeaturesGUI") - - appObject <- importQFeatures( - assayData = inputTable - ) - - app <- AppDriver$new( - appObject, - name = "oneTable_importQFeatures", - height = 1080, - width = 1619 - ) - - app$wait_for_idle() - - - app$set_inputs(`readqfeatures-quant_cols` = c("Reporter.intensity.1", "Reporter.intensity.2", "Reporter.intensity.16", "Reporter.intensity.15", "Reporter.intensity.14", "Reporter.intensity.13", "Reporter.intensity.12", "Reporter.intensity.11", "Reporter.intensity.10", "Reporter.intensity.9", "Reporter.intensity.8", "Reporter.intensity.7", "Reporter.intensity.6", "Reporter.intensity.5", "Reporter.intensity.4", "Reporter.intensity.3")) - app$set_inputs(`readqfeatures-run_col` = "Raw.file") - app$set_inputs(`readqfeatures-zero_as_NA` = FALSE) - app$set_inputs(`readqfeatures-logTransform` = FALSE) - app$set_inputs(`readqfeatures-removeEmptyCols` = TRUE) - app$click("readqfeatures-convert") - - app$wait_for_idle() - - download <- app$get_download("readqfeatures-downloadQFeatures") - testthat::expect_true(file.exists(download)) - testthat::expect_setequal( - utils::unzip(download, list = TRUE)$Name, - c( - "importQFeatures_QFeatures_object.rds", - "importQFeatures_sessionInfo.html", - "importQFeatures_script.R" + testthat::skip_on_cran() + + data("inputTable", package = "QFeaturesGUI") + + appObject <- importQFeatures( + assayData = inputTable + ) + + app <- AppDriver$new( + appObject, + name = "oneTable_importQFeatures", + height = 1080, + width = 1619 ) - ) - - extract_dir <- tempfile("qfeatures-download-") - dir.create(extract_dir) - utils::unzip( - download, - files = c( - "importQFeatures_QFeatures_object.rds", - "importQFeatures_script.R" - ), - exdir = extract_dir - ) - - exported <- readRDS(file.path( - extract_dir, - "importQFeatures_QFeatures_object.rds" - )) - - expected <- QFeatures::readQFeatures( - assayData = inputTable, - runCol = "Raw.file", - quantCols = c("Reporter.intensity.1", "Reporter.intensity.2", "Reporter.intensity.16", "Reporter.intensity.15", "Reporter.intensity.14", "Reporter.intensity.13", "Reporter.intensity.12", "Reporter.intensity.11", "Reporter.intensity.10", "Reporter.intensity.9", "Reporter.intensity.8", "Reporter.intensity.7", "Reporter.intensity.6", "Reporter.intensity.5", "Reporter.intensity.4", "Reporter.intensity.3"), - removeEmptyCols = TRUE, - verbose = FALSE - ) - names(expected) <- paste0(names(expected), "_initial_import") - - expect_qfeatures_equal(object = exported, expected = expected) - script_env <- new.env(parent = globalenv()) - script_env$dataFrame1 <- inputTable - suppressPackageStartupMessages(source( - file.path(extract_dir, "importQFeatures_script.R"), - local = script_env - )) - - testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) - script_qfeatures <- script_env$qfeatures - - expect_qfeatures_equal(object = script_qfeatures, expected = exported) + on.exit(app$stop(), add = TRUE) + + app$wait_for_idle() + + + app$set_inputs(`readqfeatures-quant_cols` = c("Reporter.intensity.1", "Reporter.intensity.2", "Reporter.intensity.16", "Reporter.intensity.15", "Reporter.intensity.14", "Reporter.intensity.13", "Reporter.intensity.12", "Reporter.intensity.11", "Reporter.intensity.10", "Reporter.intensity.9", "Reporter.intensity.8", "Reporter.intensity.7", "Reporter.intensity.6", "Reporter.intensity.5", "Reporter.intensity.4", "Reporter.intensity.3")) + app$set_inputs(`readqfeatures-run_col` = "Raw.file") + app$set_inputs(`readqfeatures-zero_as_NA` = FALSE) + app$set_inputs(`readqfeatures-logTransform` = FALSE) + app$set_inputs(`readqfeatures-removeEmptyCols` = TRUE) + app$click("readqfeatures-convert") + + app$wait_for_idle() + + download <- app$get_download("readqfeatures-downloadQFeatures") + testthat::expect_true(file.exists(download)) + testthat::expect_setequal( + utils::unzip(download, list = TRUE)$Name, + c( + "importQFeatures_QFeatures_object.rds", + "importQFeatures_sessionInfo.html", + "importQFeatures_script.R" + ) + ) + + extract_dir <- tempfile("qfeatures-download-") + dir.create(extract_dir) + utils::unzip( + download, + files = c( + "importQFeatures_QFeatures_object.rds", + "importQFeatures_script.R" + ), + exdir = extract_dir + ) + + exported <- readRDS(file.path( + extract_dir, + "importQFeatures_QFeatures_object.rds" + )) + + expected <- QFeatures::readQFeatures( + assayData = inputTable, + runCol = "Raw.file", + quantCols = c("Reporter.intensity.1", "Reporter.intensity.2", "Reporter.intensity.16", "Reporter.intensity.15", "Reporter.intensity.14", "Reporter.intensity.13", "Reporter.intensity.12", "Reporter.intensity.11", "Reporter.intensity.10", "Reporter.intensity.9", "Reporter.intensity.8", "Reporter.intensity.7", "Reporter.intensity.6", "Reporter.intensity.5", "Reporter.intensity.4", "Reporter.intensity.3"), + removeEmptyCols = TRUE, + verbose = FALSE + ) + names(expected) <- paste0(names(expected), "_initial_import") + + expect_qfeatures_equal(object = exported, expected = expected) + script_env <- new.env(parent = globalenv()) + script_env$dataFrame1 <- inputTable + suppressPackageStartupMessages(source( + file.path(extract_dir, "importQFeatures_script.R"), + local = script_env + )) + + testthat::expect_true(exists("qfeatures", envir = script_env, inherits = FALSE)) + script_qfeatures <- script_env$qfeatures + + expect_qfeatures_equal(object = script_qfeatures, expected = exported) }) diff --git a/tests/testthat/test-shinytest2-processQFeatures.R b/tests/testthat/test-shinytest2-processQFeatures.R index e258a81..3fc8cf1 100644 --- a/tests/testthat/test-shinytest2-processQFeatures.R +++ b/tests/testthat/test-shinytest2-processQFeatures.R @@ -1,135 +1,394 @@ library(shinytest2) -test_that("{shinytest2} recording: processQFeatures", { - testthat::skip_on_cran() - - data("inputTable", package = "QFeaturesGUI") - data("sampleTable", package = "QFeaturesGUI") - qf <- QFeatures::readQFeatures( - assayData = inputTable, - colData = sampleTable, - runCol = "Raw.file", - quantCols = NULL, - removeEmptyCols = TRUE, - verbose = FALSE - ) - appObject <- QFeaturesGUI::processQFeatures(qf, prefilledSteps = c("zeroToNA", "logTransform", "sampleFiltering", "featureFiltering", "missingValuesFeatures", - "missingValuesSamples", "normalisation", "aggregation", "join", "aggregation")) - app <- AppDriver$new(appObject, - name = "processQFeatures", height = 1619, width = 1080) - wait_for_input <- function(id, timeout = 10000) { +wait_for_process_input <- function(app, id, timeout = 10000) { app$wait_for_js( - sprintf( - "(() => { const el = document.getElementById('%s'); return !!(el && window.jQuery && window.jQuery(el).data('shinyInputBinding')); })()", - id - ), - timeout = timeout - ) - } - wait_for_step <- function(step_number, timeout = 30000) { + sprintf( + "(() => { const el = document.getElementById('%s'); return !!(el && window.jQuery && window.jQuery(el).data('shinyInputBinding')); })()", + id + ), + timeout = timeout + ) +} + +wait_for_process_step <- function(app, step_number, timeout = 30000) { selector <- sprintf("a[data-value=\"step_%s\"]", step_number) app$wait_for_js( - sprintf("document.querySelector('%s') !== null", selector), - timeout = timeout + sprintf("document.querySelector('%s') !== null", selector), + timeout = timeout ) app$click(selector = selector) - } - - app$wait_for_js("document.getElementById('zeroToNA_1_v1-export') !== null", timeout = 10000) - app$click(selector = "a[data-value=\"step_1\"]") - app$click("zeroToNA_1_v1-export") - app$wait_for_js("document.getElementById('logTransform_2_v1-apply_log_transform') !== null", timeout = 10000) - app$click(selector = "a[data-value=\"step_2\"]") - app$set_inputs(`logTransform_2_v1-log_base` = "log2", wait_ = FALSE) - app$set_inputs(`logTransform_2_v1-color` = "NULL", wait_ = FALSE) - app$set_inputs(`logTransform_2_v1-pseudocount` = 0, wait_ = FALSE) - app$click("logTransform_2_v1-apply_log_transform") - app$click("logTransform_2_v1-export") - app$wait_for_js("document.getElementById('sampleFiltering_3_v1-add_box') !== null", timeout = 10000) - app$click(selector = "a[data-value=\"step_3\"]") - app$click("sampleFiltering_3_v1-add_box") - wait_for_input("sampleFiltering_3_v1-filtering_1-annotation_selection") - app$set_inputs(`sampleFiltering_3_v1-filtering_1-annotation_selection` = "SampleType") - app$set_inputs(`sampleFiltering_3_v1-filtering_1-filter_operator` = "is_not_missing") - app$click("sampleFiltering_3_v1-add_box") - wait_for_input("sampleFiltering_3_v1-filtering_2-annotation_selection") - app$set_inputs(`sampleFiltering_3_v1-filtering_2-annotation_selection` = "SampleType") - wait_for_input("sampleFiltering_3_v1-filtering_2-filter_ui_samples") - app$set_inputs(`sampleFiltering_3_v1-filtering_2-filter_ui_samples` = c("Monocyte", - "Macrophage"), wait_ = FALSE) - app$click("sampleFiltering_3_v1-apply_filters") - app$click("sampleFiltering_3_v1-export") - app$wait_for_js("document.getElementById('featureFiltering_4_v1-add_box') !== null", timeout = 10000) - app$click(selector = "a[data-value=\"step_4\"]") - app$click("featureFiltering_4_v1-add_box") - wait_for_input("featureFiltering_4_v1-filtering_1-annotation_selection") - app$set_inputs(`featureFiltering_4_v1-filtering_1-annotation_selection` = "Potential.contaminant") - app$set_inputs(`featureFiltering_4_v1-filtering_1-filter_operator` = "!=") - wait_for_input("featureFiltering_4_v1-filtering_1-filter_ui_features") - app$set_inputs(`featureFiltering_4_v1-filtering_1-filter_ui_features` = "+") - app$click("featureFiltering_4_v1-add_box") - wait_for_input("featureFiltering_4_v1-filtering_2-annotation_selection") - app$set_inputs(`featureFiltering_4_v1-filtering_2-annotation_selection` = "Reverse") - app$set_inputs(`featureFiltering_4_v1-filtering_2-filter_operator` = "is_not_missing") - app$set_inputs(`featureFiltering_4_v1-filtering_2-filter_operator` = "!=") - wait_for_input("featureFiltering_4_v1-filtering_2-filter_ui_features") - app$set_inputs(`featureFiltering_4_v1-filtering_2-filter_ui_features` = "+") - app$click("featureFiltering_4_v1-add_box") - wait_for_input("featureFiltering_4_v1-filtering_3-annotation_selection") - app$set_inputs(`featureFiltering_4_v1-filtering_3-annotation_selection` = "Length") - app$set_inputs(`featureFiltering_4_v1-filtering_3-filter_operator` = "<=") - wait_for_input("featureFiltering_4_v1-filtering_3-filter_ui_features") - app$set_inputs(`featureFiltering_4_v1-filtering_3-filter_ui_features` = 15) - app$click("featureFiltering_4_v1-apply_filters") - app$click("featureFiltering_4_v1-export") - app$wait_for_js("document.getElementById('missingValuesFeatures_5_v1-export') !== null", timeout = 10000) - app$click(selector = "a[data-value=\"step_5\"]") - app$set_inputs(`missingValuesFeatures_5_v1-threshold_features` = 0.75) - app$click("missingValuesFeatures_5_v1-export") - app$wait_for_js("document.getElementById('missingValuesSamples_6_v1-export') !== null", timeout = 10000) - app$click(selector = "a[data-value=\"step_6\"]") - app$set_inputs(`missingValuesSamples_6_v1-threshold_samples` = 0.5) - app$click("missingValuesSamples_6_v1-export") - app$wait_for_js("document.getElementById('normalisation_7_v1-apply_normalisation') !== null", timeout = 10000) - app$click(selector = "a[data-value=\"step_7\"]") - app$set_inputs(`normalisation_7_v1-method` = "diff.median") - app$click("normalisation_7_v1-apply_normalisation") - app$click("normalisation_7_v1-export") - app$wait_for_js("document.getElementById('aggregation_8_v1-aggregate') !== null", timeout = 10000) - app$click(selector = "a[data-value=\"step_8\"]") - app$set_inputs(`aggregation_8_v1-method` = "colMedians") - app$set_inputs(`aggregation_8_v1-fcol` = "Modified.sequence") - app$click("aggregation_8_v1-aggregate") - app$set_inputs(`aggregation_8_v1-features` = "_(Acetyl (Protein N-term))ATNFLAHEK_") - app$click("aggregation_8_v1-export") - wait_for_step(9) - app$wait_for_js("document.getElementById('join_9_v1-export') !== null", timeout = 30000) - app$set_inputs(`join_9_v1-feature_type` = "peptides") - app$click("join_9_v1-export") - wait_for_step(10) - app$wait_for_js("document.getElementById('aggregation_10_v1-aggregate') !== null", timeout = 30000) - app$set_inputs(`aggregation_10_v1-method` = "colMedians") - app$set_inputs(`aggregation_10_v1-fcol` = "Leading.razor.protein") - app$click("aggregation_10_v1-aggregate") - app$set_inputs(`aggregation_10_v1-features` = "P84090") - app$click("aggregation_10_v1-export") - app$click(selector = "a[data-value=\"summary_tab\"]") - app$wait_for_js( - "document.getElementById('summary_tab-download_qfeatures') !== null && document.getElementById('summary_tab-download_qfeatures').offsetParent !== null", - timeout = 10000 - ) - app$wait_for_js( - "document.getElementById('summary_tab-download_qfeatures').getAttribute('href') !== ''", - timeout = 10000 - ) - download <- app$get_download("summary_tab-download_qfeatures") - testthat::expect_true(file.exists(download)) - testthat::expect_setequal( - utils::unzip(download, list = TRUE)$Name, - c( - "processQFeatures_QFeatures_object.rds", - "processQFeatures_sessionInfo.html", - "processQFeatures_script.R" - ) - ) +} + +download_process_qfeatures <- function(app) { + app$click(selector = "a[data-value=\"summary_tab\"]") + app$wait_for_js( + "document.getElementById('summary_tab-download_qfeatures') !== null && document.getElementById('summary_tab-download_qfeatures').offsetParent !== null", + timeout = 10000 + ) + app$wait_for_js( + "document.getElementById('summary_tab-download_qfeatures').getAttribute('href') !== ''", + timeout = 10000 + ) + + download <- app$get_download("summary_tab-download_qfeatures") + testthat::expect_true(file.exists(download)) + testthat::expect_setequal( + utils::unzip(download, list = TRUE)$Name, + c( + "processQFeatures_QFeatures_object.rds", + "processQFeatures_sessionInfo.html", + "processQFeatures_script.R" + ) + ) + + extract_dir <- tempfile("processqfeatures-download-") + dir.create(extract_dir) + utils::unzip( + download, + files = "processQFeatures_QFeatures_object.rds", + exdir = extract_dir + ) + readRDS(file.path(extract_dir, "processQFeatures_QFeatures_object.rds")) +} + +make_process_test_qfeatures <- function() { + qf <- make_test_qfeatures() + set1 <- qf[["set1"]] + set2 <- qf[["set2"]] + + SummarizedExperiment::assay(set1)[1, 1] <- 0 + SummarizedExperiment::assay(set2)[2, 2] <- 0 + SummarizedExperiment::colData(set1)$condition[2] <- NA + SummarizedExperiment::colData(set2)$condition[2] <- NA + SummarizedExperiment::rowData(set1)$feature_class[3] <- NA + SummarizedExperiment::rowData(set2)$feature_class[2] <- NA + + sample_data <- as.data.frame(SummarizedExperiment::colData(set1)) + suppressMessages(QFeatures::QFeatures( + list(set1 = set1, set2 = set2), + colData = sample_data + )) +} + +add_expected_process_assays <- function(qfeatures, processed_qfeatures, + step_number, type) { + expected <- qfeatures + for (assay_name in names(processed_qfeatures)) { + expected[[paste0(assay_name, "_", type, "_", step_number)]] <- + processed_qfeatures[[assay_name]] + } + expected +} + +test_that("{shinytest2} recording: processQFeatures", { + testthat::skip_on_cran() + + data("inputTable", package = "QFeaturesGUI") + data("sampleTable", package = "QFeaturesGUI") + qf <- QFeatures::readQFeatures( + assayData = inputTable, + colData = sampleTable, + runCol = "Raw.file", + quantCols = NULL, + removeEmptyCols = TRUE, + verbose = FALSE + ) + appObject <- QFeaturesGUI::processQFeatures(qf, prefilledSteps = c( + "zeroToNA", "logTransform", "sampleFiltering", "featureFiltering", "missingValuesFeatures", + "missingValuesSamples", "normalisation", "aggregation", "join", "aggregation" + )) + app <- AppDriver$new(appObject, + name = "processQFeatures", height = 1619, width = 1080 + ) + on.exit(app$stop(), add = TRUE) + + app$wait_for_js("document.getElementById('zeroToNA_1_v1-export') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_1\"]") + app$click("zeroToNA_1_v1-export") + app$wait_for_js("document.getElementById('logTransform_2_v1-apply_log_transform') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_2\"]") + app$set_inputs(`logTransform_2_v1-log_base` = "log2", wait_ = FALSE) + app$set_inputs(`logTransform_2_v1-color` = "NULL", wait_ = FALSE) + app$set_inputs(`logTransform_2_v1-pseudocount` = 0, wait_ = FALSE) + app$click("logTransform_2_v1-apply_log_transform") + app$click("logTransform_2_v1-export") + app$wait_for_js("document.getElementById('sampleFiltering_3_v1-add_box') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_3\"]") + app$click("sampleFiltering_3_v1-add_box") + wait_for_process_input(app, "sampleFiltering_3_v1-filtering_1-annotation_selection") + app$set_inputs(`sampleFiltering_3_v1-filtering_1-annotation_selection` = "SampleType") + app$set_inputs(`sampleFiltering_3_v1-filtering_1-filter_operator` = "is_not_missing") + app$click("sampleFiltering_3_v1-add_box") + wait_for_process_input(app, "sampleFiltering_3_v1-filtering_2-annotation_selection") + app$set_inputs(`sampleFiltering_3_v1-filtering_2-annotation_selection` = "SampleType") + wait_for_process_input(app, "sampleFiltering_3_v1-filtering_2-filter_ui_samples") + app$set_inputs(`sampleFiltering_3_v1-filtering_2-filter_ui_samples` = c( + "Monocyte", + "Macrophage" + ), wait_ = FALSE) + app$click("sampleFiltering_3_v1-apply_filters") + app$click("sampleFiltering_3_v1-export") + app$wait_for_js("document.getElementById('featureFiltering_4_v1-add_box') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_4\"]") + app$click("featureFiltering_4_v1-add_box") + wait_for_process_input(app, "featureFiltering_4_v1-filtering_1-annotation_selection") + app$set_inputs(`featureFiltering_4_v1-filtering_1-annotation_selection` = "Potential.contaminant") + app$set_inputs(`featureFiltering_4_v1-filtering_1-filter_operator` = "!=") + wait_for_process_input(app, "featureFiltering_4_v1-filtering_1-filter_ui_features") + app$set_inputs(`featureFiltering_4_v1-filtering_1-filter_ui_features` = "+") + app$click("featureFiltering_4_v1-add_box") + wait_for_process_input(app, "featureFiltering_4_v1-filtering_2-annotation_selection") + app$set_inputs(`featureFiltering_4_v1-filtering_2-annotation_selection` = "Reverse") + app$set_inputs(`featureFiltering_4_v1-filtering_2-filter_operator` = "is_not_missing") + app$set_inputs(`featureFiltering_4_v1-filtering_2-filter_operator` = "!=") + wait_for_process_input(app, "featureFiltering_4_v1-filtering_2-filter_ui_features") + app$set_inputs(`featureFiltering_4_v1-filtering_2-filter_ui_features` = "+") + app$click("featureFiltering_4_v1-add_box") + wait_for_process_input(app, "featureFiltering_4_v1-filtering_3-annotation_selection") + app$set_inputs(`featureFiltering_4_v1-filtering_3-annotation_selection` = "Length") + app$set_inputs(`featureFiltering_4_v1-filtering_3-filter_operator` = "<=") + wait_for_process_input(app, "featureFiltering_4_v1-filtering_3-filter_ui_features") + app$set_inputs(`featureFiltering_4_v1-filtering_3-filter_ui_features` = 15) + app$click("featureFiltering_4_v1-apply_filters") + app$click("featureFiltering_4_v1-export") + app$wait_for_js("document.getElementById('missingValuesFeatures_5_v1-export') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_5\"]") + app$set_inputs(`missingValuesFeatures_5_v1-threshold_features` = 0.75) + app$click("missingValuesFeatures_5_v1-export") + app$wait_for_js("document.getElementById('missingValuesSamples_6_v1-export') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_6\"]") + app$set_inputs(`missingValuesSamples_6_v1-threshold_samples` = 0.5) + app$click("missingValuesSamples_6_v1-export") + app$wait_for_js("document.getElementById('normalisation_7_v1-apply_normalisation') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_7\"]") + app$set_inputs(`normalisation_7_v1-method` = "diff.median") + app$click("normalisation_7_v1-apply_normalisation") + app$click("normalisation_7_v1-export") + app$wait_for_js("document.getElementById('aggregation_8_v1-aggregate') !== null", timeout = 10000) + app$click(selector = "a[data-value=\"step_8\"]") + app$set_inputs(`aggregation_8_v1-method` = "colMedians") + app$set_inputs(`aggregation_8_v1-fcol` = "Modified.sequence") + app$click("aggregation_8_v1-aggregate") + app$set_inputs(`aggregation_8_v1-features` = "_(Acetyl (Protein N-term))ATNFLAHEK_") + app$click("aggregation_8_v1-export") + wait_for_process_step(app, 9) + app$wait_for_js("document.getElementById('join_9_v1-export') !== null", timeout = 30000) + app$set_inputs(`join_9_v1-feature_type` = "peptides") + app$click("join_9_v1-export") + wait_for_process_step(app, 10) + app$wait_for_js("document.getElementById('aggregation_10_v1-aggregate') !== null", timeout = 30000) + app$set_inputs(`aggregation_10_v1-method` = "colMedians") + app$set_inputs(`aggregation_10_v1-fcol` = "Leading.razor.protein") + app$click("aggregation_10_v1-aggregate") + app$set_inputs(`aggregation_10_v1-features` = "P84090") + app$click("aggregation_10_v1-export") + app$click(selector = "a[data-value=\"summary_tab\"]") + app$wait_for_js( + "document.getElementById('summary_tab-download_qfeatures') !== null && document.getElementById('summary_tab-download_qfeatures').offsetParent !== null", + timeout = 10000 + ) + app$wait_for_js( + "document.getElementById('summary_tab-download_qfeatures').getAttribute('href') !== ''", + timeout = 10000 + ) + download <- app$get_download("summary_tab-download_qfeatures") + testthat::expect_true(file.exists(download)) + testthat::expect_setequal( + utils::unzip(download, list = TRUE)$Name, + c( + "processQFeatures_QFeatures_object.rds", + "processQFeatures_sessionInfo.html", + "processQFeatures_script.R" + ) + ) +}) + +test_that("{shinytest2}: zeroToNA exports the expected QFeatures object", { + testthat::skip_on_cran() + + qf <- make_process_test_qfeatures() + app <- AppDriver$new( + QFeaturesGUI::processQFeatures(qf, prefilledSteps = "zeroToNA"), + name = "processQFeatures_zeroToNA", + height = 900, + width = 1200 + ) + on.exit(app$stop(), add = TRUE) + + wait_for_process_step(app, 1) + app$wait_for_js("document.getElementById('zeroToNA_1_v1-export') !== null", timeout = 10000) + app$click("zeroToNA_1_v1-export") + + processed <- QFeatures::zeroIsNA(qf, i = seq_along(qf)) + expected <- add_expected_process_assays(qf, processed, 1, "zero_to_na") + exported <- download_process_qfeatures(app) + + expect_qfeatures_equal(object = exported, expected = expected) +}) + +test_that("{shinytest2}: logTransform exports the expected QFeatures object", { + testthat::skip_on_cran() + + qf <- make_process_test_qfeatures() + app <- AppDriver$new( + QFeaturesGUI::processQFeatures(qf, prefilledSteps = "logTransform"), + name = "processQFeatures_logTransform", + height = 900, + width = 1200 + ) + on.exit(app$stop(), add = TRUE) + + wait_for_process_step(app, 1) + app$wait_for_js("document.getElementById('logTransform_1_v1-apply_log_transform') !== null", timeout = 10000) + app$set_inputs(`logTransform_1_v1-log_base` = "log2", wait_ = FALSE) + app$set_inputs(`logTransform_1_v1-color` = "NULL", wait_ = FALSE) + app$set_inputs(`logTransform_1_v1-pseudocount` = 1, wait_ = FALSE) + app$click("logTransform_1_v1-apply_log_transform") + app$click("logTransform_1_v1-export") + + processed <- qf + for (assay_name in names(processed)) { + processed[[assay_name]] <- QFeatures::logTransform( + qf[[assay_name]], + base = 2, + pc = 1 + ) + } + expected <- add_expected_process_assays(qf, processed, 1, "log_transform") + exported <- download_process_qfeatures(app) + + expect_qfeatures_equal(object = exported, expected = expected) +}) + +test_that("{shinytest2}: sampleFiltering exports the expected QFeatures object", { + testthat::skip_on_cran() + + qf <- make_process_test_qfeatures() + app <- AppDriver$new( + QFeaturesGUI::processQFeatures(qf, prefilledSteps = "sampleFiltering"), + name = "processQFeatures_sampleFiltering", + height = 1000, + width = 1200 + ) + on.exit(app$stop(), add = TRUE) + + wait_for_process_step(app, 1) + app$wait_for_js("document.getElementById('sampleFiltering_1_v1-add_box') !== null", timeout = 10000) + app$click("sampleFiltering_1_v1-add_box") + wait_for_process_input(app, "sampleFiltering_1_v1-filtering_1-annotation_selection") + app$set_inputs(`sampleFiltering_1_v1-filtering_1-annotation_selection` = "condition") + app$set_inputs(`sampleFiltering_1_v1-filtering_1-filter_operator` = "is_not_missing") + app$wait_for_js( + "window.Shiny && Shiny.shinyapp && Shiny.shinyapp.$inputValues['sampleFiltering_1_v1-filtering_1-filter_operator'] === 'is_not_missing'", + timeout = 10000 + ) + app$click("sampleFiltering_1_v1-apply_filters") + app$wait_for_js( + "(() => { const el = document.getElementById('sampleFiltering_1_v1-number_samples_removed'); return el && /1/.test(el.textContent); })()", + timeout = 10000 + ) + app$click("sampleFiltering_1_v1-export") + + processed <- qf[, !is.na(SummarizedExperiment::colData(qf)$condition), ] + expected <- add_expected_process_assays(qf, processed, 1, "samples_filtering") + exported <- download_process_qfeatures(app) + + expect_qfeatures_equal(object = exported, expected = expected) +}) + +test_that("{shinytest2}: featureFiltering exports the expected QFeatures object", { + testthat::skip_on_cran() + + qf <- make_process_test_qfeatures() + app <- AppDriver$new( + QFeaturesGUI::processQFeatures(qf, prefilledSteps = "featureFiltering"), + name = "processQFeatures_featureFiltering", + height = 1000, + width = 1200 + ) + on.exit(app$stop(), add = TRUE) + + wait_for_process_step(app, 1) + app$wait_for_js("document.getElementById('featureFiltering_1_v1-add_box') !== null", timeout = 10000) + app$click("featureFiltering_1_v1-add_box") + wait_for_process_input(app, "featureFiltering_1_v1-filtering_1-annotation_selection") + app$set_inputs(`featureFiltering_1_v1-filtering_1-annotation_selection` = "feature_class") + app$set_inputs(`featureFiltering_1_v1-filtering_1-filter_operator` = "is_not_missing") + app$click("featureFiltering_1_v1-apply_filters") + app$click("featureFiltering_1_v1-export") + + processed <- qf + for (assay_name in names(processed)) { + keep <- !is.na(SummarizedExperiment::rowData(qf[[assay_name]])$feature_class) + processed[[assay_name]] <- qf[[assay_name]][keep, ] + } + expected <- add_expected_process_assays(qf, processed, 1, "features_filtering") + exported <- download_process_qfeatures(app) + + expect_qfeatures_equal(object = exported, expected = expected) +}) + +test_that("{shinytest2}: normalisation exports the expected QFeatures object", { + testthat::skip_on_cran() + + qf <- make_process_test_qfeatures() + app <- AppDriver$new( + QFeaturesGUI::processQFeatures(qf, prefilledSteps = "normalisation"), + name = "processQFeatures_normalisation", + height = 900, + width = 1200 + ) + on.exit(app$stop(), add = TRUE) + + wait_for_process_step(app, 1) + app$wait_for_js("document.getElementById('normalisation_1_v1-apply_normalisation') !== null", timeout = 10000) + app$set_inputs(`normalisation_1_v1-method` = "diff.median") + app$click("normalisation_1_v1-apply_normalisation") + app$click("normalisation_1_v1-export") + + processed <- qf + for (assay_name in names(processed)) { + processed[[assay_name]] <- QFeatures::normalize( + qf[[assay_name]], + method = "diff.median" + ) + } + expected <- add_expected_process_assays(qf, processed, 1, "normalisation") + exported <- download_process_qfeatures(app) + + expect_qfeatures_equal(object = exported, expected = expected) +}) + +test_that("{shinytest2}: aggregation exports the expected QFeatures object", { + testthat::skip_on_cran() + + qf <- make_process_test_qfeatures() + app <- AppDriver$new( + QFeaturesGUI::processQFeatures(qf, prefilledSteps = "aggregation"), + name = "processQFeatures_aggregation", + height = 900, + width = 1200 + ) + on.exit(app$stop(), add = TRUE) + + wait_for_process_step(app, 1) + app$wait_for_js("document.getElementById('aggregation_1_v1-aggregate') !== null", timeout = 10000) + app$set_inputs(`aggregation_1_v1-method` = "colMedians") + app$set_inputs(`aggregation_1_v1-fcol` = "protein") + app$click("aggregation_1_v1-aggregate") + app$click("aggregation_1_v1-export") + + processed <- qf + for (assay_name in names(processed)) { + processed[[assay_name]] <- suppressMessages(QFeatures::aggregateFeatures( + qf[[assay_name]], + fun = matrixStats::colMedians, + fcol = "protein", + na.rm = TRUE + )) + } + expected <- add_expected_process_assays(qf, processed, 1, "aggregation") + exported <- download_process_qfeatures(app) + + expect_qfeatures_equal(object = exported, expected = expected) }) From 78340550d65f76b3f189652e0cbb6742cba5971b Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Mon, 15 Jun 2026 10:54:10 +0200 Subject: [PATCH 7/9] fix specific for windows (shinytest) --- tests/testthat/test-shinytest2-processQFeatures.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/test-shinytest2-processQFeatures.R b/tests/testthat/test-shinytest2-processQFeatures.R index 3fc8cf1..b6bfdd7 100644 --- a/tests/testthat/test-shinytest2-processQFeatures.R +++ b/tests/testthat/test-shinytest2-processQFeatures.R @@ -314,7 +314,15 @@ test_that("{shinytest2}: featureFiltering exports the expected QFeatures object" wait_for_process_input(app, "featureFiltering_1_v1-filtering_1-annotation_selection") app$set_inputs(`featureFiltering_1_v1-filtering_1-annotation_selection` = "feature_class") app$set_inputs(`featureFiltering_1_v1-filtering_1-filter_operator` = "is_not_missing") + app$wait_for_js( + "window.Shiny && Shiny.shinyapp && Shiny.shinyapp.$inputValues['featureFiltering_1_v1-filtering_1-filter_operator'] === 'is_not_missing'", + timeout = 10000 + ) app$click("featureFiltering_1_v1-apply_filters") + app$wait_for_js( + "(() => { const el = document.getElementById('featureFiltering_1_v1-number_features_removed'); return el && /(^|\\D)2(\\D|$)/.test(el.textContent); })()", + timeout = 10000 + ) app$click("featureFiltering_1_v1-export") processed <- qf From f486bd9943aedf38963555c6b3628b269e2afce5 Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Mon, 15 Jun 2026 11:21:00 +0200 Subject: [PATCH 8/9] fix specific for windows (shinytest)2 --- .../test-shinytest2-processQFeatures.R | 68 +++++++++++++++---- 1 file changed, 54 insertions(+), 14 deletions(-) diff --git a/tests/testthat/test-shinytest2-processQFeatures.R b/tests/testthat/test-shinytest2-processQFeatures.R index b6bfdd7..6ebc833 100644 --- a/tests/testthat/test-shinytest2-processQFeatures.R +++ b/tests/testthat/test-shinytest2-processQFeatures.R @@ -1,5 +1,9 @@ library(shinytest2) +js_string <- function(value) { + paste0('"', gsub('(["\\\\])', "\\\\\\1", value), '"') +} + wait_for_process_input <- function(app, id, timeout = 10000) { app$wait_for_js( sprintf( @@ -19,6 +23,28 @@ wait_for_process_step <- function(app, step_number, timeout = 30000) { app$click(selector = selector) } +wait_for_process_input_value <- function(app, id, value, timeout = 30000) { + app$wait_for_js( + sprintf( + "window.Shiny && Shiny.shinyapp && Shiny.shinyapp.$inputValues[%s] === %s", + js_string(id), + js_string(value) + ), + timeout = timeout + ) +} + +wait_for_process_output_number <- function(app, id, value, timeout = 30000) { + app$wait_for_js( + sprintf( + "(() => { const el = document.getElementById(%s); if (!el) return false; const matches = (el.textContent || '').match(/-?\\d+(\\.\\d+)?/g) || []; return matches.includes(%s); })()", + js_string(id), + js_string(as.character(value)) + ), + timeout = timeout + ) +} + download_process_qfeatures <- function(app) { app$click(selector = "a[data-value=\"summary_tab\"]") app$wait_for_js( @@ -155,8 +181,8 @@ test_that("{shinytest2} recording: processQFeatures", { app$click(selector = "a[data-value=\"step_5\"]") app$set_inputs(`missingValuesFeatures_5_v1-threshold_features` = 0.75) app$click("missingValuesFeatures_5_v1-export") - app$wait_for_js("document.getElementById('missingValuesSamples_6_v1-export') !== null", timeout = 10000) - app$click(selector = "a[data-value=\"step_6\"]") + wait_for_process_step(app, 6) + app$wait_for_js("document.getElementById('missingValuesSamples_6_v1-export') !== null", timeout = 30000) app$set_inputs(`missingValuesSamples_6_v1-threshold_samples` = 0.5) app$click("missingValuesSamples_6_v1-export") app$wait_for_js("document.getElementById('normalisation_7_v1-apply_normalisation') !== null", timeout = 10000) @@ -278,14 +304,21 @@ test_that("{shinytest2}: sampleFiltering exports the expected QFeatures object", wait_for_process_input(app, "sampleFiltering_1_v1-filtering_1-annotation_selection") app$set_inputs(`sampleFiltering_1_v1-filtering_1-annotation_selection` = "condition") app$set_inputs(`sampleFiltering_1_v1-filtering_1-filter_operator` = "is_not_missing") - app$wait_for_js( - "window.Shiny && Shiny.shinyapp && Shiny.shinyapp.$inputValues['sampleFiltering_1_v1-filtering_1-filter_operator'] === 'is_not_missing'", - timeout = 10000 + wait_for_process_input_value( + app, + "sampleFiltering_1_v1-filtering_1-annotation_selection", + "condition" + ) + wait_for_process_input_value( + app, + "sampleFiltering_1_v1-filtering_1-filter_operator", + "is_not_missing" ) app$click("sampleFiltering_1_v1-apply_filters") - app$wait_for_js( - "(() => { const el = document.getElementById('sampleFiltering_1_v1-number_samples_removed'); return el && /1/.test(el.textContent); })()", - timeout = 10000 + wait_for_process_output_number( + app, + "sampleFiltering_1_v1-number_samples_removed", + 1 ) app$click("sampleFiltering_1_v1-export") @@ -314,14 +347,21 @@ test_that("{shinytest2}: featureFiltering exports the expected QFeatures object" wait_for_process_input(app, "featureFiltering_1_v1-filtering_1-annotation_selection") app$set_inputs(`featureFiltering_1_v1-filtering_1-annotation_selection` = "feature_class") app$set_inputs(`featureFiltering_1_v1-filtering_1-filter_operator` = "is_not_missing") - app$wait_for_js( - "window.Shiny && Shiny.shinyapp && Shiny.shinyapp.$inputValues['featureFiltering_1_v1-filtering_1-filter_operator'] === 'is_not_missing'", - timeout = 10000 + wait_for_process_input_value( + app, + "featureFiltering_1_v1-filtering_1-annotation_selection", + "feature_class" + ) + wait_for_process_input_value( + app, + "featureFiltering_1_v1-filtering_1-filter_operator", + "is_not_missing" ) app$click("featureFiltering_1_v1-apply_filters") - app$wait_for_js( - "(() => { const el = document.getElementById('featureFiltering_1_v1-number_features_removed'); return el && /(^|\\D)2(\\D|$)/.test(el.textContent); })()", - timeout = 10000 + wait_for_process_output_number( + app, + "featureFiltering_1_v1-number_features_removed", + 2 ) app$click("featureFiltering_1_v1-export") From 06f326028bdd9be643840fbf65c1c48302960d0b Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Mon, 15 Jun 2026 14:50:47 +0200 Subject: [PATCH 9/9] fix specific for mac (shinytest) --- tests/testthat/test-shinytest2-processQFeatures.R | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-shinytest2-processQFeatures.R b/tests/testthat/test-shinytest2-processQFeatures.R index 6ebc833..c67f02f 100644 --- a/tests/testthat/test-shinytest2-processQFeatures.R +++ b/tests/testthat/test-shinytest2-processQFeatures.R @@ -303,12 +303,17 @@ test_that("{shinytest2}: sampleFiltering exports the expected QFeatures object", app$click("sampleFiltering_1_v1-add_box") wait_for_process_input(app, "sampleFiltering_1_v1-filtering_1-annotation_selection") app$set_inputs(`sampleFiltering_1_v1-filtering_1-annotation_selection` = "condition") - app$set_inputs(`sampleFiltering_1_v1-filtering_1-filter_operator` = "is_not_missing") wait_for_process_input_value( app, "sampleFiltering_1_v1-filtering_1-annotation_selection", "condition" ) + wait_for_process_input_value( + app, + "sampleFiltering_1_v1-filtering_1-filter_operator", + "==" + ) + app$set_inputs(`sampleFiltering_1_v1-filtering_1-filter_operator` = "is_not_missing") wait_for_process_input_value( app, "sampleFiltering_1_v1-filtering_1-filter_operator", @@ -346,12 +351,17 @@ test_that("{shinytest2}: featureFiltering exports the expected QFeatures object" app$click("featureFiltering_1_v1-add_box") wait_for_process_input(app, "featureFiltering_1_v1-filtering_1-annotation_selection") app$set_inputs(`featureFiltering_1_v1-filtering_1-annotation_selection` = "feature_class") - app$set_inputs(`featureFiltering_1_v1-filtering_1-filter_operator` = "is_not_missing") wait_for_process_input_value( app, "featureFiltering_1_v1-filtering_1-annotation_selection", "feature_class" ) + wait_for_process_input_value( + app, + "featureFiltering_1_v1-filtering_1-filter_operator", + "==" + ) + app$set_inputs(`featureFiltering_1_v1-filtering_1-filter_operator` = "is_not_missing") wait_for_process_input_value( app, "featureFiltering_1_v1-filtering_1-filter_operator",