From bf154d9b91532fe3ab1a9071b8c8db88bf83ecbd Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Mon, 8 Jun 2026 16:45:49 +0200 Subject: [PATCH 1/3] first tentative is missing operator --- R/code_generator_processQFeatures.R | 36 ++++++- R/server_module_filtering_box.R | 62 +++++++++++- R/server_module_filtering_tab.R | 20 ++++ tests/testthat/test-filtering.R | 140 ++++++++++++++++++++++++++++ 4 files changed, 250 insertions(+), 8 deletions(-) create mode 100644 tests/testthat/test-filtering.R diff --git a/R/code_generator_processQFeatures.R b/R/code_generator_processQFeatures.R index 147a2f7..f41d6f4 100644 --- a/R/code_generator_processQFeatures.R +++ b/R/code_generator_processQFeatures.R @@ -369,7 +369,14 @@ codeGeneratorFiltering <- function(qf, condition, type, step_number) { for (i in 1:length(condition)) { annotation <- as_r_string_literal(condition[[i]]$annotation) if (condition[[i]]$annotation == ".qfeaturesgui_rowname") { - if (condition[[i]]$operator == "==") { + if (is_missingness_filter_operator(condition[[i]]$operator)) { + build_condition <- if (condition[[i]]$operator == "is_missing") { + "is.na(rownames(rowData(se)))" + } else { + "!is.na(rownames(rowData(se)))" + } + vector <- "" + } else if (condition[[i]]$operator == "==") { build_condition <- paste0("rownames(rowData(se)) %in% ") vector <- as_r_vector_literal(condition[[i]]$value) } else { @@ -377,7 +384,14 @@ codeGeneratorFiltering <- function(qf, condition, type, step_number) { vector <- paste0(as_r_vector_literal(condition[[i]]$value), ")") } } else { - if (condition[[i]]$operator == "==") { + if (is_missingness_filter_operator(condition[[i]]$operator)) { + build_condition <- if (condition[[i]]$operator == "is_missing") { + paste0("is.na(rowData(se)[[", annotation, "]])") + } else { + paste0("!is.na(rowData(se)[[", annotation, "]])") + } + vector <- "" + } else if (condition[[i]]$operator == "==") { build_condition <- paste0("rowData(se)[[", annotation, "]] %in% ") vector <- as_r_vector_literal(condition[[i]]$value) } else if (condition[[i]]$operator == "!=") { @@ -418,7 +432,14 @@ for(i in 1:length(step%s_setNames)){ for (i in 1:length(condition)) { annotation <- as_r_string_literal(condition[[i]]$annotation) if (condition[[i]]$annotation == ".qfeaturesgui_rowname") { - if (condition[[i]]$operator == "==") { + if (is_missingness_filter_operator(condition[[i]]$operator)) { + build_condition <- if (condition[[i]]$operator == "is_missing") { + "is.na(rownames(colData(se)))" + } else { + "!is.na(rownames(colData(se)))" + } + vector <- "" + } else if (condition[[i]]$operator == "==") { build_condition <- paste0("rownames(colData(se)) %in% ") vector <- as_r_vector_literal(condition[[i]]$value) } else { @@ -426,7 +447,14 @@ for(i in 1:length(step%s_setNames)){ vector <- paste0(as_r_vector_literal(condition[[i]]$value), ")") } } else { - if (condition[[i]]$operator == "==") { + if (is_missingness_filter_operator(condition[[i]]$operator)) { + build_condition <- if (condition[[i]]$operator == "is_missing") { + paste0("is.na(colData(se)[[", annotation, "]])") + } else { + paste0("!is.na(colData(se)[[", annotation, "]])") + } + vector <- "" + } else if (condition[[i]]$operator == "==") { build_condition <- paste0("colData(se)[[", annotation, "]] %in% ") vector <- as_r_vector_literal(condition[[i]]$value) } else if (condition[[i]]$operator == "!=") { diff --git a/R/server_module_filtering_box.R b/R/server_module_filtering_box.R index 7aa3f51..335f192 100644 --- a/R/server_module_filtering_box.R +++ b/R/server_module_filtering_box.R @@ -24,7 +24,9 @@ server_module_filtering_box <- function(id, assays_to_process, type, state) { ">" = "is greater than", ">=" = "is greater than or equal to", "==" = "is equal to", - "!=" = "is not equal to" + "!=" = "is not equal to", + "is_missing" = "is missing", + "is_not_missing" = "is not missing" ) operator_choices_all <- c( "Less than" = "<", @@ -32,11 +34,15 @@ server_module_filtering_box <- function(id, assays_to_process, type, state) { "Greater than" = ">", "Greater than or equal to" = ">=", "Equal to" = "==", - "Not equal to" = "!=" + "Not equal to" = "!=", + "Is missing" = "is_missing", + "Is not missing" = "is_not_missing" ) operator_choices_categorical <- c( "Equal to" = "==", - "Not equal to" = "!=" + "Not equal to" = "!=", + "Is missing" = "is_missing", + "Is not missing" = "is_not_missing" ) combined_samples_annotations <- reactive({ @@ -142,6 +148,9 @@ server_module_filtering_box <- function(id, assays_to_process, type, state) { req(input$filter_operator) is_categorical <- annotations_type() %in% c("character", "factor") is_equality_operator <- input$filter_operator %in% c("==", "!=") + if (is_missingness_filter_operator(input$filter_operator)) { + return(FALSE) + } if (!(is_categorical && is_equality_operator)) { return(FALSE) } @@ -154,6 +163,10 @@ server_module_filtering_box <- function(id, assays_to_process, type, state) { if (is.null(state_filter_value) && !is.null(state)) { state_filter_value <- state$filter_value } + req(input$filter_operator) + if (is_missingness_filter_operator(input$filter_operator)) { + return(NULL) + } is_categorical <- annotations_type() %in% c("character", "factor") is_equality_operator <- input$filter_operator %in% c("==", "!=") if (is_categorical) { @@ -204,6 +217,9 @@ server_module_filtering_box <- function(id, assays_to_process, type, state) { req(input$annotation_selection) req(input$filter_operator) req(annotations_type()) + if (is_missingness_filter_operator(input$filter_operator)) { + return() + } is_categorical <- annotations_type() %in% c("character", "factor") if (!is_categorical) { return() @@ -271,6 +287,12 @@ server_module_filtering_box <- function(id, assays_to_process, type, state) { } else { input$annotation_selection } + if (is_missingness_filter_operator(input$filter_operator)) { + return(paste( + annotation_label, + operator_labels[[input$filter_operator]] + )) + } if (annotations_type() %in% c("character", "factor") && input$filter_operator %in% c("==", "!=")) { selected_values <- as.character(input[[paste0("filter_ui_", type)]]) @@ -299,6 +321,13 @@ server_module_filtering_box <- function(id, assays_to_process, type, state) { req(input$annotation_selection) req(input$filter_operator) req(input$filter_operator %in% names(operator_labels)) + if (is_missingness_filter_operator(input$filter_operator)) { + return(list( + annotation = input$annotation_selection, + operator = input$filter_operator, + value = NULL + )) + } filter_value <- input[[paste0("filter_ui_", type)]] if (is.null(filter_value) || is_empty_categorical_multiselect()) { return(NULL) @@ -386,6 +415,14 @@ server_module_annotation_plot <- function( req(annotation_values()) selected_operator <- filter_operator() req(selected_operator) + if (is_missingness_filter_operator(selected_operator)) { + condition_mask <- apply_filter_operator( + values = annotation_values(), + operator = selected_operator, + target = NULL + ) + return(condition_mask[condition_mask]) + } condition_mask <- apply_filter_operator( values = annotation_values(), operator = selected_operator, @@ -395,7 +432,17 @@ server_module_annotation_plot <- function( annotation_values()[condition_mask] }) output$plot <- renderPlotly({ - annotation <- annotation_values() + selected_operator <- filter_operator() + req(selected_operator) + if (is_missingness_filter_operator(selected_operator)) { + annotation <- apply_filter_operator( + values = annotation_values(), + operator = selected_operator, + target = NULL + ) + } else { + annotation <- annotation_values() + } filtered <- filtered_annotation() selected <- selected_annotation() @@ -413,6 +460,13 @@ server_module_annotation_plot <- function( } else { selected } + if (is_missingness_filter_operator(selected_operator)) { + annotation_label <- paste0( + "Missingness (", + annotation_label, + ")" + ) + } error_handler( annotation_plot_wrapper, diff --git a/R/server_module_filtering_tab.R b/R/server_module_filtering_tab.R index 3c0307e..f1b9995 100644 --- a/R/server_module_filtering_tab.R +++ b/R/server_module_filtering_tab.R @@ -151,6 +151,12 @@ server_module_filtering_tab <- function( filtering_condition_specs[[paste0("condition_spec_", i)]] }) specs <- Filter(function(spec) { + if (is.list(spec) && + !is.null(spec$annotation) && + !is.null(spec$operator) && + is_missingness_filter_operator(spec$operator)) { + return(TRUE) + } is.list(spec) && !is.null(spec$annotation) && !is.null(spec$operator) && @@ -326,6 +332,12 @@ feature_filtering <- function(qfeatures, condition_specs) { #' @keywords internal #' apply_filter_operator <- function(values, operator, target) { + if (operator == "is_missing") { + return(is.na(values)) + } + if (operator == "is_not_missing") { + return(!is.na(values)) + } if (length(target) == 0) { return(rep(FALSE, length(values))) } @@ -349,3 +361,11 @@ apply_filter_operator <- function(values, operator, target) { } operator_functions[[operator]](values, target) } + +missingness_filter_operators <- function() { + c("is_missing", "is_not_missing") +} + +is_missingness_filter_operator <- function(operator) { + operator %in% missingness_filter_operators() +} diff --git a/tests/testthat/test-filtering.R b/tests/testthat/test-filtering.R new file mode 100644 index 0000000..181f622 --- /dev/null +++ b/tests/testthat/test-filtering.R @@ -0,0 +1,140 @@ +test_that("apply_filter_operator supports missingness operators", { + values <- c("a", NA, "b", NA) + + expect_equal( + apply_filter_operator(values, "is_missing", NULL), + c(FALSE, TRUE, FALSE, TRUE) + ) + expect_equal( + apply_filter_operator(values, "is_not_missing", NULL), + c(TRUE, FALSE, TRUE, FALSE) + ) + expect_equal( + apply_filter_operator(values, "==", "a"), + c(TRUE, NA, FALSE, NA) + ) + expect_equal( + apply_filter_operator(c(1, 2, NA), ">=", 2), + c(FALSE, TRUE, NA) + ) + expect_error( + apply_filter_operator(values, "contains", "a"), + "Unsupported filtering operator" + ) +}) + +test_that("sample_filtering applies missingness conditions to sample annotations", { + qf <- make_test_qfeatures() + SummarizedExperiment::colData(qf)$condition <- c("ctrl", NA, "case") + + missing_samples <- sample_filtering( + qf, + list(list( + annotation = "condition", + operator = "is_missing", + value = NULL + )) + ) + present_samples <- sample_filtering( + qf, + list(list( + annotation = "condition", + operator = "is_not_missing", + value = NULL + )) + ) + + expect_equal(rownames(SummarizedExperiment::colData(missing_samples)), "s2") + expect_equal( + rownames(SummarizedExperiment::colData(present_samples)), + c("s1", "s3") + ) +}) + +test_that("feature_filtering applies missingness conditions to feature annotations", { + qf <- make_test_qfeatures() + + missing_features <- feature_filtering( + qf, + list(list( + annotation = "score", + operator = "is_missing", + value = NULL + )) + ) + present_features <- feature_filtering( + qf, + list(list( + annotation = "score", + operator = "is_not_missing", + value = NULL + )) + ) + + expect_equal(rownames(missing_features[["set1"]]), "f3") + expect_equal(rownames(missing_features[["set2"]]), character()) + expect_equal( + rownames(present_features[["set1"]]), + c("f1", "f2", "f4") + ) + expect_equal(rownames(present_features[["set2"]]), c("g1", "g2")) +}) + +test_that("codeGeneratorFiltering emits is.na conditions", { + qf <- make_test_qfeatures() + feature_code <- paste(codeGeneratorFiltering( + qf = qf, + condition = list( + list( + annotation = "score", + operator = "is_missing", + value = NULL + ), + list( + annotation = "protein", + operator = "!=", + value = "P1" + ) + ), + type = "features", + step_number = 1 + ), collapse = "\n") + sample_code <- paste(codeGeneratorFiltering( + qf = qf, + condition = list( + list( + annotation = "condition", + operator = "is_not_missing", + value = NULL + ), + list( + annotation = "sample_score", + operator = ">=", + value = 2 + ) + ), + type = "samples", + step_number = 1 + ), collapse = "\n") + + expect_true(grepl( + 'is.na(rowData(se)[["score"]])', + feature_code, + fixed = TRUE + )) + expect_true(grepl( + ' & !(rowData(se)[["protein"]] %in% c("P1"))', + feature_code, + fixed = TRUE + )) + expect_true(grepl( + '!is.na(colData(se)[["condition"]])', + sample_code, + fixed = TRUE + )) + expect_true(grepl( + ' & colData(se)[["sample_score"]] >= c(2)', + sample_code, + fixed = TRUE + )) +}) From dbbe129d4354a2b71c0f8af82f3220fc93b9dbfb Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Tue, 9 Jun 2026 10:09:58 +0200 Subject: [PATCH 2/3] improve is missing filter plotting --- R/server_module_filtering_box.R | 95 +++++++++++++++++++++++++++++---- tests/testthat/test-filtering.R | 45 ++++++++++++++++ 2 files changed, 131 insertions(+), 9 deletions(-) diff --git a/R/server_module_filtering_box.R b/R/server_module_filtering_box.R index 335f192..2ff7039 100644 --- a/R/server_module_filtering_box.R +++ b/R/server_module_filtering_box.R @@ -421,7 +421,11 @@ server_module_annotation_plot <- function( operator = selected_operator, target = NULL ) - return(condition_mask[condition_mask]) + plot_values <- missingness_filter_plot_values( + values = annotation_values(), + operator = selected_operator + ) + return(plot_values[condition_mask]) } condition_mask <- apply_filter_operator( values = annotation_values(), @@ -435,10 +439,9 @@ server_module_annotation_plot <- function( selected_operator <- filter_operator() req(selected_operator) if (is_missingness_filter_operator(selected_operator)) { - annotation <- apply_filter_operator( + annotation <- missingness_filter_plot_values( values = annotation_values(), - operator = selected_operator, - target = NULL + operator = selected_operator ) } else { annotation <- annotation_values() @@ -461,11 +464,19 @@ server_module_annotation_plot <- function( selected } if (is_missingness_filter_operator(selected_operator)) { - annotation_label <- paste0( - "Missingness (", - annotation_label, - ")" - ) + operator_label <- if (selected_operator == "is_missing") { + "Is missing" + } else { + "Is not missing" + } + return(error_handler( + missingness_annotation_plot_wrapper, + component_name = "annotation_plot (filtering_box)", + annotation = annotation, + filtered_annotation = filtered, + assay_name = plot_title, + annotation_name = paste0(operator_label, " (", annotation_label, ")") + )) } error_handler( @@ -480,6 +491,72 @@ server_module_annotation_plot <- function( }) } +missingness_filter_plot_values <- function(values, operator) { + condition_mask <- apply_filter_operator( + values = values, + operator = operator, + target = NULL + ) + if (operator == "is_missing") { + false_label <- "Is not missing" + true_label <- "Is missing" + } else if (operator == "is_not_missing") { + false_label <- "Is missing" + true_label <- "Is not missing" + } else { + stop(paste0("Unsupported missingness operator: ", operator)) + } + factor( + ifelse(condition_mask, true_label, false_label), + levels = c(false_label, true_label) + ) +} + +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)) + + plot <- plot_ly() %>% + plotly::add_trace( + x = categories, + y = before_counts, + type = "bar", + name = "Before Filtering" + ) %>% + layout( + barmode = "group", + xaxis = list(title = paste0("Filter Result: ", annotation_name)), + yaxis = list(title = "Number of appearances"), + title = assay_name + ) %>% + config(displaylogo = FALSE, toImageButtonOptions = list( + format = "svg", + filename = "annotation_plot", + height = 500, + width = 700, + scale = 1 + )) + + if (length(filtered_annotation) > 0) { + filtered_annotation <- factor(filtered_annotation, levels = categories) + after_counts <- as.integer(table(filtered_annotation)) + plot <- plot %>% + plotly::add_trace( + x = categories, + y = after_counts, + type = "bar", + name = "After Filtering" + ) + } + plot +} + #' @title Annotation plot wrapper #' #' @param annotation_df A data.frame that contains the annotation values diff --git a/tests/testthat/test-filtering.R b/tests/testthat/test-filtering.R index 181f622..c2a2564 100644 --- a/tests/testthat/test-filtering.R +++ b/tests/testthat/test-filtering.R @@ -138,3 +138,48 @@ test_that("codeGeneratorFiltering emits is.na conditions", { fixed = TRUE )) }) + +test_that("missingness plot values explain TRUE and FALSE labels", { + values <- c("a", NA, "b") + + is_missing_values <- missingness_filter_plot_values(values, "is_missing") + is_not_missing_values <- missingness_filter_plot_values( + values, + "is_not_missing" + ) + + expect_equal( + levels(is_missing_values), + c("Is not missing", "Is missing") + ) + expect_equal( + as.character(is_missing_values), + c("Is not missing", "Is missing", "Is not missing") + ) + expect_equal( + levels(is_not_missing_values), + c("Is missing", "Is not missing") + ) + expect_equal( + as.character(is_not_missing_values), + c("Is not missing", "Is missing", "Is not missing") + ) +}) + +test_that("missingness plot renders when all values are FALSE", { + annotation <- missingness_filter_plot_values(c("a", "b"), "is_missing") + plot <- missingness_annotation_plot_wrapper( + annotation = annotation, + filtered_annotation = annotation[FALSE], + assay_name = "All samples across sets", + annotation_name = "Is missing (condition)" + ) + built <- plotly::plotly_build(plot) + + expect_s3_class(plot, "plotly") + expect_equal( + as.vector(built$x$data[[1]]$x), + c("Is not missing", "Is missing") + ) + expect_equal(as.vector(built$x$data[[1]]$y), c(2L, 0L)) +}) From 0ecbc3d30172484538dd4828a11fc0f9a904c14c Mon Sep 17 00:00:00 2001 From: leopoldguyot Date: Tue, 9 Jun 2026 10:42:56 +0200 Subject: [PATCH 3/3] address comments --- R/code_generator_processQFeatures.R | 4 ++-- R/server_module_filtering_tab.R | 2 +- tests/testthat/test-filtering.R | 16 +++++++++++++++- 3 files changed, 18 insertions(+), 4 deletions(-) diff --git a/R/code_generator_processQFeatures.R b/R/code_generator_processQFeatures.R index f41d6f4..3ca84a1 100644 --- a/R/code_generator_processQFeatures.R +++ b/R/code_generator_processQFeatures.R @@ -395,7 +395,7 @@ codeGeneratorFiltering <- function(qf, condition, type, step_number) { build_condition <- paste0("rowData(se)[[", annotation, "]] %in% ") vector <- as_r_vector_literal(condition[[i]]$value) } else if (condition[[i]]$operator == "!=") { - build_condition <- paste0("!(rowData(se)[[", annotation, "]] %in% ") + build_condition <- paste0("!is.na(rowData(se)[[", annotation, "]]) & !(rowData(se)[[", annotation, "]] %in% ") vector <- paste0(as_r_vector_literal(condition[[i]]$value), ")") } else { build_condition <- paste0("rowData(se)[[", annotation, "]] ", condition[[i]]$operator, " ") @@ -458,7 +458,7 @@ for(i in 1:length(step%s_setNames)){ build_condition <- paste0("colData(se)[[", annotation, "]] %in% ") vector <- as_r_vector_literal(condition[[i]]$value) } else if (condition[[i]]$operator == "!=") { - build_condition <- paste0("!(colData(se)[[", annotation, "]] %in% ") + build_condition <- paste0("!is.na(colData(se)[[", annotation, "]]) & !(colData(se)[[", annotation, "]] %in% ") vector <- paste0(as_r_vector_literal(condition[[i]]$value), ")") } else { build_condition <- paste0("colData(se)[[", annotation, "]] ", condition[[i]]$operator, " ") diff --git a/R/server_module_filtering_tab.R b/R/server_module_filtering_tab.R index f1b9995..3de05b4 100644 --- a/R/server_module_filtering_tab.R +++ b/R/server_module_filtering_tab.R @@ -346,7 +346,7 @@ apply_filter_operator <- function(values, operator, target) { if (operator == "==") { return(values %in% target_values) } - return(!(values %in% target_values)) + return(!is.na(values) & !(values %in% target_values)) } operator_functions <- list( "==" = `==`, diff --git a/tests/testthat/test-filtering.R b/tests/testthat/test-filtering.R index c2a2564..130be0f 100644 --- a/tests/testthat/test-filtering.R +++ b/tests/testthat/test-filtering.R @@ -13,6 +13,10 @@ test_that("apply_filter_operator supports missingness operators", { apply_filter_operator(values, "==", "a"), c(TRUE, NA, FALSE, NA) ) + expect_equal( + apply_filter_operator(values, "!=", c("a", "c")), + c(FALSE, FALSE, TRUE, FALSE) + ) expect_equal( apply_filter_operator(c(1, 2, NA), ">=", 2), c(FALSE, TRUE, NA) @@ -107,6 +111,11 @@ test_that("codeGeneratorFiltering emits is.na conditions", { operator = "is_not_missing", value = NULL ), + list( + annotation = "batch", + operator = "!=", + value = "A" + ), list( annotation = "sample_score", operator = ">=", @@ -123,7 +132,7 @@ test_that("codeGeneratorFiltering emits is.na conditions", { fixed = TRUE )) expect_true(grepl( - ' & !(rowData(se)[["protein"]] %in% c("P1"))', + ' & !is.na(rowData(se)[["protein"]]) & !(rowData(se)[["protein"]] %in% c("P1"))', feature_code, fixed = TRUE )) @@ -132,6 +141,11 @@ test_that("codeGeneratorFiltering emits is.na conditions", { sample_code, fixed = TRUE )) + expect_true(grepl( + ' & !is.na(colData(se)[["batch"]]) & !(colData(se)[["batch"]] %in% c("A"))', + sample_code, + fixed = TRUE + )) expect_true(grepl( ' & colData(se)[["sample_score"]] >= c(2)', sample_code,