From b4d2e5511da319810763e5b59172d18e2dc12ee2 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Wed, 22 Apr 2026 22:19:26 -0400 Subject: [PATCH 1/9] - Default the DIANN 2.0+ checkbox to unchecked - Auto detect the DIANN dataset file type and automatically toggle the checkbox for better user experience, still retaining the ability to let user manually toggle the checkbox if required - Show a warning if the user selects an invalid state of the checkbox based on the type of file uploaded - Handle application crashing in case if the user uses an invalid configuration while uplaoding the data - Write test cases for all edge cases of the DIANN file version detection --- NAMESPACE | 1 - R/module-loadpage-server.R | 69 +++++++++--- R/module-loadpage-ui.R | 2 +- R/utils.R | 38 +++++++ tests/testthat/test-utils.R | 203 ++++++++++++++++++++++++++++++++++++ 5 files changed, 297 insertions(+), 16 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 63cc7e1..7d82f7c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,7 +39,6 @@ importFrom(DT,renderDataTable) importFrom(Hmisc,describe) importFrom(MSstats,MSstatsQualityMetricsPlot) importFrom(MSstatsBioNet,annotateProteinInfoFromIndra) -importFrom(MSstatsBioNet,deleteEdgeFromNetwork) importFrom(MSstatsBioNet,exportNetworkToHTML) importFrom(MSstatsBioNet,getSubnetworkFromIndra) importFrom(MSstatsConvert,MSstatsLogsSettings) diff --git a/R/module-loadpage-server.R b/R/module-loadpage-server.R index 6c2eb4f..496161f 100644 --- a/R/module-loadpage-server.R +++ b/R/module-loadpage-server.R @@ -82,21 +82,20 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE, app_templa } }) - # Read first 100 rows for Metamorpheus PTM preview. - # TODO: Extend preview reading to other input formats (e.g., Spectronaut, MaxQuant) - # for dynamic UI updates. Currently limited to Metamorpheus. + # Read first 100 rows for preview-based UI features. + # Supported: Metamorpheus PTM (modification ID dropdown), DIANN (version auto-detection). + # TODO: Extend to other input formats (Spectronaut, MaxQuant) as needed. observe({ - if (isTRUE(input$filetype == "meta") && isTRUE(input$BIO == "PTM")) { + should_preview <- (isTRUE(input$filetype == "meta") && isTRUE(input$BIO == "PTM")) || + (isTRUE(input$filetype == "diann") && isTRUE(input$BIO != "PTM")) + if (should_preview) { file_info <- main_data_file() if (!is.null(file_info)) { - preview <- tryCatch( - data.table::fread(file_info$datapath, nrows = 100, header = TRUE), - error = function(e) { - showNotification(paste("Could not preview file:", conditionMessage(e)), - type = "warning", duration = 5) - NULL - } - ) + preview <- .read_preview(file_info$datapath, file_info$name) + if (is.null(preview)) { + showNotification("Could not preview file. Please verify the file format.", + type = "warning", duration = 5) + } preview_data(preview) } else { preview_data(NULL) @@ -106,6 +105,40 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE, app_templa } }) + # Auto-toggle DIANN 2.0+ checkbox based on detected file format + observe({ + req(input$filetype == "diann", input$BIO != "PTM") + preview <- preview_data() + if (!is.null(preview)) { + is_2plus <- .is_diann_2plus(preview) + updateCheckboxInput(session, "diann_2plus", value = is_2plus) + if (is_2plus) { + showNotification("Detected DIANN 2.0+ format (per-fragment columns).", + type = "message", duration = 5) + } else { + showNotification("Detected DIANN 1.x format (legacy fragment column).", + type = "message", duration = 5) + } + } + }) + + # Warn user if they manually set DIANN 2.0+ checkbox to a value that conflicts with detected format + observeEvent(input$diann_2plus, { + req(input$filetype == "diann", input$BIO != "PTM") + preview <- preview_data() + if (is.null(preview)) return() + detected_2plus <- .is_diann_2plus(preview) + if (isTRUE(input$diann_2plus) != detected_2plus) { + showNotification( + paste0("Warning: You've ", + if (isTRUE(input$diann_2plus)) "checked" else "unchecked", + " DIANN 2.0+, but the uploaded file appears to be ", + if (detected_2plus) "DIANN 2.0+ format" else "DIANN 1.x format", + ". This mismatch may cause upload to fail."), + type = "warning", duration = 10) + } + }, ignoreInit = TRUE) + # ========= METAMORPHEUS PTM: Dynamic modification ID dropdown ========= output$mod_id_meta_ui <- renderUI({ ns <- session$ns @@ -412,9 +445,17 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE, app_templa getMaxqPtmSites(input) }) - get_data = eventReactive(input$proceed1, { - getData(input) + tryCatch( + getData(input), + error = function(e) { + tryCatch(remove_modal_spinner(), error = function(e2) NULL) + showNotification( + paste("Failed to load data:", conditionMessage(e)), + type = "error", duration = 12) + NULL + } + ) }) diff --git a/R/module-loadpage-ui.R b/R/module-loadpage-ui.R index c4c629b..5e4b476 100644 --- a/R/module-loadpage-ui.R +++ b/R/module-loadpage-ui.R @@ -602,7 +602,7 @@ create_label_free_options <- function(ns) { # DIANN specific options conditionalPanel( condition = "input['loadpage-filetype'] == 'diann' && input['loadpage-DDA_DIA'] == 'LType'", - checkboxInput(ns("diann_2plus"), "DIANN 2.0+", value = TRUE), + checkboxInput(ns("diann_2plus"), "DIANN 2.0+", value = FALSE), conditionalPanel( condition = "!input['loadpage-diann_2plus']", textInput(ns("intensity_column"), diff --git a/R/utils.R b/R/utils.R index f77f64c..0910009 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,3 +1,41 @@ +#' Read preview columns from a data file (handles CSV, TSV, and Parquet) +#' +#' @param filepath Path to the file. +#' @param filename Original filename (used to detect parquet extension). +#' @param nrows Number of rows to read. Default 100. Parquet returns columns only. +#' @return A data frame with up to `nrows` rows, or NULL on error. +#' @noRd +.read_preview <- function(filepath, filename = NULL, nrows = 100) { + ext <- if (!is.null(filename)) tolower(tools::file_ext(basename(filename))) else "" + tryCatch({ + if (ext %in% c("parquet", "pq")) { + # For parquet, read the whole file but only need column names for detection + arrow::read_parquet(filepath) + } else { + data.table::fread(filepath, nrows = nrows, header = TRUE) + } + }, error = function(e) NULL) +} + +#' Detect whether a DIANN preview is in 2.0+ format +#' +#' DIANN 2.0+ files have per-fragment columns (Fr.0.Quantity, Fr.1.Quantity, etc.) +#' and no FragmentQuantCorrected column. Older versions use a single +#' Fragment.Quant.Corrected / FragmentQuantCorrected column. +#' +#' @param preview_df Data frame preview of the DIANN file. +#' @return Logical. TRUE if the file appears to be DIANN 2.0+. +#' @noRd +.is_diann_2plus <- function(preview_df) { + if (is.null(preview_df) || ncol(preview_df) == 0) return(FALSE) + cols <- names(preview_df) + # DIANN 2.0+ signature: numbered fragment columns like "Fr.0.Quantity" + has_numbered_fragments <- any(grepl("^Fr\\.[0-9]+\\.Quantity$", cols)) + # DIANN 1.x signature: the legacy fragment column + has_legacy_fragments <- any(cols %in% c("Fragment.Quant.Corrected", "FragmentQuantCorrected")) + has_numbered_fragments && !has_legacy_fragments +} + #' Extract unique modification IDs from preview data #' #' Parses the Full Sequence column to find bracket-enclosed modification IDs. diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 19072d6..566d430 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1650,4 +1650,207 @@ test_that("extract_mod_ids_from_preview handles consecutive modifications", { result <- MSstatsShiny:::.extract_mod_ids_from_preview(preview) expect_equal(length(result), 3) expect_true(all(c("[Mod1]", "[Mod2]", "[Mod3]") %in% result)) +}) + +# ============================================================================ +# DIANN FORMAT DETECTION TESTS +# ============================================================================ + +test_that("is_diann_2plus returns TRUE for DIANN 2.0+ format with numbered fragment columns", { + preview <- data.frame( + Run = "run1", + Protein.Group = "P1", + Fr.0.Quantity = 100, + Fr.1.Quantity = 200, + Fr.2.Quantity = 300, + Precursor.Charge = 2 + ) + expect_true(MSstatsShiny:::.is_diann_2plus(preview)) +}) + +test_that("is_diann_2plus returns FALSE for DIANN 1.x format with legacy Fragment.Quant.Corrected", { + preview <- data.frame( + Run = "run1", + Protein.Group = "P1", + Fragment.Quant.Corrected = 100, + Fragment.Quant.Raw = 95, + Precursor.Charge = 2 + ) + expect_false(MSstatsShiny:::.is_diann_2plus(preview)) +}) + +test_that("is_diann_2plus returns FALSE for DIANN 1.x format with FragmentQuantCorrected (no dots)", { + preview <- data.frame( + Run = "run1", + FragmentQuantCorrected = 100, + Precursor.Charge = 2 + ) + expect_false(MSstatsShiny:::.is_diann_2plus(preview)) +}) + +test_that("is_diann_2plus returns FALSE when both formats are present (legacy takes precedence)", { + preview <- data.frame( + Run = "run1", + Fragment.Quant.Corrected = 100, + Fr.0.Quantity = 200 + ) + expect_false(MSstatsShiny:::.is_diann_2plus(preview)) +}) + +test_that("is_diann_2plus returns FALSE for NULL preview", { + expect_false(MSstatsShiny:::.is_diann_2plus(NULL)) +}) + +test_that("is_diann_2plus returns FALSE for empty data frame", { + expect_false(MSstatsShiny:::.is_diann_2plus(data.frame())) +}) + +test_that("is_diann_2plus returns FALSE for data with no fragment columns", { + preview <- data.frame( + Run = "run1", + Protein.Group = "P1", + Precursor.Charge = 2 + ) + expect_false(MSstatsShiny:::.is_diann_2plus(preview)) +}) + +test_that("is_diann_2plus detects DIANN 2.0+ with many numbered fragment columns", { + # Real DIANN 2.0+ files can have Fr.0 through Fr.11 + cols <- c("Run", "Protein.Group", paste0("Fr.", 0:11, ".Quantity"), + paste0("Fr.", 0:11, ".Index"), paste0("Fr.", 0:11, ".Score")) + preview <- as.data.frame(setNames( + lapply(cols, function(x) if (grepl("Quantity", x)) runif(1) else "x"), + cols + )) + expect_true(MSstatsShiny:::.is_diann_2plus(preview)) +}) + +# ============================================================================ +# PREVIEW READER TESTS +# ============================================================================ + +test_that("read_preview reads CSV files with nrows limit", { + tmp <- tempfile(fileext = ".csv") + df <- data.frame(a = 1:200, b = letters[1:26][1:200 %% 26 + 1]) + write.csv(df, tmp, row.names = FALSE) + + preview <- MSstatsShiny:::.read_preview(tmp, "test.csv", nrows = 100) + expect_false(is.null(preview)) + expect_equal(nrow(preview), 100) + expect_true(all(c("a", "b") %in% names(preview))) + + unlink(tmp) +}) + +test_that("read_preview reads TSV files", { + tmp <- tempfile(fileext = ".tsv") + df <- data.frame(a = 1:50, b = letters[1:50 %% 26 + 1]) + write.table(df, tmp, sep = "\t", row.names = FALSE, quote = FALSE) + + preview <- MSstatsShiny:::.read_preview(tmp, "test.tsv", nrows = 100) + expect_false(is.null(preview)) + expect_equal(nrow(preview), 50) + + unlink(tmp) +}) + +test_that("read_preview returns NULL for non-existent files", { + preview <- MSstatsShiny:::.read_preview("/nonexistent/path.csv", "test.csv") + expect_null(preview) +}) + +test_that("read_preview returns NULL for malformed files", { + tmp <- tempfile(fileext = ".csv") + writeBin(as.raw(c(0xFF, 0xFE, 0x00, 0x00)), tmp) # Garbage bytes + preview <- MSstatsShiny:::.read_preview(tmp, "test.csv") + # Either NULL or a data frame (fread can sometimes parse garbage) — both acceptable + expect_true(is.null(preview) || is.data.frame(preview)) + unlink(tmp) +}) + +test_that("read_preview handles NULL filename gracefully", { + tmp <- tempfile(fileext = ".csv") + df <- data.frame(a = 1:10) + write.csv(df, tmp, row.names = FALSE) + + # Should default to CSV reading path + preview <- MSstatsShiny:::.read_preview(tmp, NULL) + expect_false(is.null(preview)) + expect_equal(nrow(preview), 10) + + unlink(tmp) +}) + +test_that("read_preview dispatches parquet files to arrow reader", { + # Skip if arrow not available + skip_if_not_installed("arrow") + + tmp <- tempfile(fileext = ".parquet") + df <- data.frame(a = 1:50, b = runif(50)) + arrow::write_parquet(df, tmp) + + preview <- MSstatsShiny:::.read_preview(tmp, "test.parquet") + expect_false(is.null(preview)) + expect_true(all(c("a", "b") %in% names(preview))) + + unlink(tmp) +}) + +test_that("read_preview recognizes .pq extension as parquet", { + skip_if_not_installed("arrow") + + tmp <- tempfile(fileext = ".pq") + df <- data.frame(a = 1:10) + arrow::write_parquet(df, tmp) + + preview <- MSstatsShiny:::.read_preview(tmp, "test.pq") + expect_false(is.null(preview)) + + unlink(tmp) +}) + +# ============================================================================ +# INTEGRATION TESTS: PREVIEW + DIANN DETECTION +# ============================================================================ + +test_that("DIANN 1.x CSV file is correctly detected as not 2.0+", { + tmp <- tempfile(fileext = ".csv") + df <- data.frame( + Run = paste0("run", 1:10), + Protein.Group = "P1", + Fragment.Quant.Corrected = runif(10) * 1000, + Fragment.Quant.Raw = runif(10) * 1000, + Precursor.Charge = 2, + Q.Value = runif(10, 0, 0.01) + ) + write.csv(df, tmp, row.names = FALSE) + + preview <- MSstatsShiny:::.read_preview(tmp, "diann_1x.csv") + expect_false(MSstatsShiny:::.is_diann_2plus(preview)) + + unlink(tmp) +}) + +test_that("DIANN 2.0 parquet file is correctly detected as 2.0+", { + skip_if_not_installed("arrow") + + tmp <- tempfile(fileext = ".parquet") + df <- data.frame( + Run = paste0("run", 1:10), + Protein.Group = "P1", + Fr.0.Quantity = runif(10) * 1000, + Fr.0.Index = 1L, + Fr.1.Quantity = runif(10) * 1000, + Fr.1.Index = 2L, + Fr.2.Quantity = runif(10) * 1000, + Fr.2.Index = 3L, + Precursor.Charge = 2, + Q.Value = runif(10, 0, 0.01) + ) + arrow::write_parquet(df, tmp) + + preview <- MSstatsShiny:::.read_preview(tmp, "diann_2plus.parquet") + expect_true(MSstatsShiny:::.is_diann_2plus(preview)) + + unlink(tmp) }) \ No newline at end of file From b5f13e3996b34658457456fda631224efc1697e3 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Wed, 22 Apr 2026 22:44:30 -0400 Subject: [PATCH 2/9] Resolve nitpicks in the DIANN dataset file type checkbox handling feature --- R/module-loadpage-server.R | 14 ++++++++++++-- R/utils.R | 10 ++++++++-- tests/testthat/test-utils.R | 5 +++-- 3 files changed, 23 insertions(+), 6 deletions(-) diff --git a/R/module-loadpage-server.R b/R/module-loadpage-server.R index 496161f..1bca0ba 100644 --- a/R/module-loadpage-server.R +++ b/R/module-loadpage-server.R @@ -91,6 +91,8 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE, app_templa if (should_preview) { file_info <- main_data_file() if (!is.null(file_info)) { + # Reset DIANN detection tracker so a new file re-triggers the notification + last_detected_diann_format(NULL) preview <- .read_preview(file_info$datapath, file_info$name) if (is.null(preview)) { showNotification("Could not preview file. Please verify the file format.", @@ -105,12 +107,19 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE, app_templa } }) + # Track last detected DIANN format to avoid redundant notifications + last_detected_diann_format <- reactiveVal(NULL) + # Auto-toggle DIANN 2.0+ checkbox based on detected file format observe({ req(input$filetype == "diann", input$BIO != "PTM") preview <- preview_data() - if (!is.null(preview)) { - is_2plus <- .is_diann_2plus(preview) + if (is.null(preview)) return() + + is_2plus <- .is_diann_2plus(preview) + previous <- last_detected_diann_format() + # Only update and notify when the detected state actually changes + if (is.null(previous) || previous != is_2plus) { updateCheckboxInput(session, "diann_2plus", value = is_2plus) if (is_2plus) { showNotification("Detected DIANN 2.0+ format (per-fragment columns).", @@ -119,6 +128,7 @@ loadpageServer <- function(id, parent_session, is_web_server = FALSE, app_templa showNotification("Detected DIANN 1.x format (legacy fragment column).", type = "message", duration = 5) } + last_detected_diann_format(is_2plus) } }) diff --git a/R/utils.R b/R/utils.R index 0910009..e3af653 100644 --- a/R/utils.R +++ b/R/utils.R @@ -9,8 +9,14 @@ ext <- if (!is.null(filename)) tolower(tools::file_ext(basename(filename))) else "" tryCatch({ if (ext %in% c("parquet", "pq")) { - # For parquet, read the whole file but only need column names for detection - arrow::read_parquet(filepath) + # For parquet, read only the schema (column names) to avoid OOM on large files. + # Return an empty data frame with the correct column structure for detection. + schema <- arrow::open_dataset(filepath, format = "parquet")$schema + col_names <- schema$names + empty_df <- as.data.frame( + setNames(lapply(col_names, function(x) logical(0)), col_names) + ) + empty_df } else { data.table::fread(filepath, nrows = nrows, header = TRUE) } diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 566d430..9f84b74 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1781,8 +1781,7 @@ test_that("read_preview handles NULL filename gracefully", { unlink(tmp) }) -test_that("read_preview dispatches parquet files to arrow reader", { - # Skip if arrow not available +test_that("read_preview dispatches parquet files to arrow schema reader", { skip_if_not_installed("arrow") tmp <- tempfile(fileext = ".parquet") @@ -1791,6 +1790,8 @@ test_that("read_preview dispatches parquet files to arrow reader", { preview <- MSstatsShiny:::.read_preview(tmp, "test.parquet") expect_false(is.null(preview)) + # Schema-only read returns 0 rows but correct column names + expect_equal(nrow(preview), 0) expect_true(all(c("a", "b") %in% names(preview))) unlink(tmp) From cdde69f2345c142600f8596b3e184b503bd67fa5 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Fri, 24 Apr 2026 10:49:45 -0400 Subject: [PATCH 3/9] Install dependent packages and regenerate the documentation --- NAMESPACE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 7d82f7c..a2c0866 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,8 +37,8 @@ importFrom(DT,datatable) importFrom(DT,renderDT) importFrom(DT,renderDataTable) importFrom(Hmisc,describe) -importFrom(MSstats,MSstatsQualityMetricsPlot) importFrom(MSstatsBioNet,annotateProteinInfoFromIndra) +importFrom(MSstatsBioNet,deleteEdgeFromNetwork) importFrom(MSstatsBioNet,exportNetworkToHTML) importFrom(MSstatsBioNet,getSubnetworkFromIndra) importFrom(MSstatsConvert,MSstatsLogsSettings) From 0e12d23e9a26abe4fe0064fa576a796bff473359 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Fri, 24 Apr 2026 14:42:26 -0400 Subject: [PATCH 4/9] Update the documentation --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index a2c0866..63cc7e1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,6 +37,7 @@ importFrom(DT,datatable) importFrom(DT,renderDT) importFrom(DT,renderDataTable) importFrom(Hmisc,describe) +importFrom(MSstats,MSstatsQualityMetricsPlot) importFrom(MSstatsBioNet,annotateProteinInfoFromIndra) importFrom(MSstatsBioNet,deleteEdgeFromNetwork) importFrom(MSstatsBioNet,exportNetworkToHTML) From f547738738232cdcf6dc1596577610d5c3da36fe Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Fri, 24 Apr 2026 18:40:47 -0400 Subject: [PATCH 5/9] Statmodel Inference: - Remove "display protein name" checkbox - Set a default comparison name - Pre-select single comparison instead of "all" - Disable Heatmap when fewer than 2 comparisons - Remove "all" option for all cases of volcano plot --- R/statmodel-server-visualization.R | 43 ++++++++++++++----- R/statmodel-ui-comparisons.R | 2 +- R/statmodel-ui-options-visualization.R | 5 +-- .../test-statmodel-ui-options-visualization.R | 5 +-- 4 files changed, 36 insertions(+), 19 deletions(-) diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 4d4a017..f85e942 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -6,9 +6,36 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da ns = session$ns output[[NAMESPACE_STATMODEL$visualization_which_comparison]] = renderUI({ + comparison_names <- rownames() + req(length(comparison_names) > 0) selectInput(ns(NAMESPACE_STATMODEL$visualization_which_comparison), label = h5("Select comparison to plot"), - c("all", rownames()), selected = "all") + comparison_names, selected = comparison_names[1]) + }) + + # Dynamically filter plot type choices based on number of comparisons. + # Skips response curve mode (handled separately in module-statmodel-server.R). + observe({ + req(input[[NAMESPACE_STATMODEL$comparison_mode]]) + mode <- input[[NAMESPACE_STATMODEL$comparison_mode]] + if (mode == CONSTANTS_STATMODEL$comparison_mode_response_curve) return() + + comparison_names <- rownames() + n_comparisons <- length(comparison_names) + + choices <- c( + "Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, + "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot + ) + if (n_comparisons >= 2) { + choices <- c( + "Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, + "Heatmap" = CONSTANTS_STATMODEL$plot_type_heatmap, + "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot + ) + } + updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type, + choices = choices) }) output[[NAMESPACE_STATMODEL$visualization_which_protein]] = renderUI({ @@ -21,9 +48,7 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da plot_type = input[[NAMESPACE_STATMODEL$visualization_plot_type]] if (plot_type == CONSTANTS_STATMODEL$plot_type_volcano_plot) { - show_protein_name = !is.null(loadpage_input()$DDA_DIA) && - loadpage_input()$DDA_DIA != "TMT" - create_volcano_plot_options(ns, show_protein_name) + create_volcano_plot_options(ns) } else if (plot_type == CONSTANTS_STATMODEL$plot_type_comparison_plot) { create_comparison_plot_options(ns) } else if (plot_type == CONSTANTS_STATMODEL$plot_type_heatmap) { @@ -78,10 +103,6 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) fold_change_cutoff = ifelse(!is.null(input[[NAMESPACE_STATMODEL$visualization_fold_change_input]]), input[[NAMESPACE_STATMODEL$visualization_fold_change_input]], FALSE) tryCatch({ - if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == CONSTANTS_STATMODEL$plot_type_volcano_plot && input[[NAMESPACE_STATMODEL$visualization_which_comparison]] == "all") { - remove_modal_spinner() - stop('** Cannot generate multiple plots in a screen. Please refine selection or save to a pdf. **') - } if (loadpage_input$BIO == "PTM") { plot_result = groupComparisonPlotsPTM( data_comparison, @@ -116,7 +137,7 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) sig = input[[NAMESPACE_STATMODEL$visualization_volcano_significance_cutoff]], FCcutoff = fold_change_cutoff, logBase.pvalue = as.numeric(input[[NAMESPACE_STATMODEL$visualization_logp_base]]), - ProteinName = input[[NAMESPACE_STATMODEL$visualization_volcano_display_protein_name]], + ProteinName = FALSE, numProtein = input[[NAMESPACE_STATMODEL$visualization_heatmap_number_proteins]], clustering = input[[NAMESPACE_STATMODEL$visualization_heatmap_cluster_option]], which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], @@ -266,7 +287,7 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat sig = input[[NAMESPACE_STATMODEL$visualization_volcano_significance_cutoff]], FCcutoff = fold_change_cutoff, logBase.pvalue = as.integer(input[[NAMESPACE_STATMODEL$visualization_logp_base]]), - ProteinName = input[[NAMESPACE_STATMODEL$visualization_volcano_display_protein_name]], + ProteinName = FALSE, which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], address = address_prefix ) @@ -277,7 +298,7 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat sig = input[[NAMESPACE_STATMODEL$visualization_volcano_significance_cutoff]], FCcutoff = fold_change_cutoff, logBase.pvalue = as.numeric(input[[NAMESPACE_STATMODEL$visualization_logp_base]]), - ProteinName = input[[NAMESPACE_STATMODEL$visualization_volcano_display_protein_name]], + ProteinName = FALSE, numProtein = input[[NAMESPACE_STATMODEL$visualization_heatmap_number_proteins]], clustering = input[[NAMESPACE_STATMODEL$visualization_heatmap_cluster_option]], which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], diff --git a/R/statmodel-ui-comparisons.R b/R/statmodel-ui-comparisons.R index f89807a..e44e555 100644 --- a/R/statmodel-ui-comparisons.R +++ b/R/statmodel-ui-comparisons.R @@ -74,7 +74,7 @@ build_custom_nonpairwise_panel <- function(ns) { tagList( h5("Non-pairwise Comparison:"), textInput(ns(NAMESPACE_STATMODEL$comparisons_custom_nonpairwise_name), - label = "Comparison Name", value = ""), + label = "Comparison Name", value = "custom comparison"), uiOutput(ns(NAMESPACE_STATMODEL$comparisons_custom_nonpairwise_weights)), actionButton(ns(NAMESPACE_STATMODEL$comparisons_submit), "Add"), actionButton(ns(NAMESPACE_STATMODEL$comparisons_clear), "Clear matrix") diff --git a/R/statmodel-ui-options-visualization.R b/R/statmodel-ui-options-visualization.R index 24cb684..52c9f27 100644 --- a/R/statmodel-ui-options-visualization.R +++ b/R/statmodel-ui-options-visualization.R @@ -32,12 +32,9 @@ create_plot_type_selector <- function(ns) { } #' Create volcano plot specific options #' @noRd -create_volcano_plot_options <- function(ns, show_protein_name = TRUE) { +create_volcano_plot_options <- function(ns) { tagList( uiOutput(ns(NAMESPACE_STATMODEL$visualization_which_comparison)), - if (show_protein_name) { - checkboxInput(ns(NAMESPACE_STATMODEL$visualization_volcano_display_protein_name), label = p("display protein name")) - }, selectInput( ns(NAMESPACE_STATMODEL$visualization_logp_base), label = h5("Log transformation of adjusted p-value"), diff --git a/tests/testthat/test-statmodel-ui-options-visualization.R b/tests/testthat/test-statmodel-ui-options-visualization.R index 3133bdc..26a00e7 100644 --- a/tests/testthat/test-statmodel-ui-options-visualization.R +++ b/tests/testthat/test-statmodel-ui-options-visualization.R @@ -39,13 +39,12 @@ test_that("Correct elements are present in create_volcano_plot_options", { ui_html <- htmltools::renderTags(result)$html expect_true(grepl(NAMESPACE_STATMODEL$visualization_which_comparison, ui_html), info = "Which comparison namespace should be present") - expect_true(grepl(NAMESPACE_STATMODEL$visualization_volcano_display_protein_name, ui_html), - info = "Display protein name checkbox namespace should be present") + expect_false(grepl(NAMESPACE_STATMODEL$visualization_volcano_display_protein_name, ui_html), + info = "Display protein name checkbox should be removed") expect_true(grepl(NAMESPACE_STATMODEL$visualization_logp_base, ui_html), info = "Log p-value base namespace should be present") expect_true(grepl(NAMESPACE_STATMODEL$visualization_volcano_significance_cutoff, ui_html), info = "Significance cutoff namespace should be present") - }) test_that("All possible options in create_plot_type_selector", { From b46e6cd30fd65ed3306d37e22acf32344b899263 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Sat, 25 Apr 2026 16:40:23 -0400 Subject: [PATCH 6/9] - Resolve nitpicks for the non-pairwise comparison bugfixes - Update the significant protein extraction test --- R/module-statmodel-server.R | 15 +++++++++++++++ R/statmodel-server-visualization.R | 6 +++--- R/statmodel-ui-comparisons.R | 2 +- tests/testthat/test-utils-statmodel-server.R | 4 +++- 4 files changed, 22 insertions(+), 5 deletions(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 5b06cee..bac7a12 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -130,6 +130,21 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, output[[NAMESPACE_STATMODEL$modeling_section_header]] <- renderUI({ get_modeling_section_header(input[[NAMESPACE_STATMODEL$comparison_mode]], app_template()) }) + + # Auto-generate unique default name for non-pairwise comparisons + observe({ + req(input[[NAMESPACE_STATMODEL$comparison_mode]] == + CONSTANTS_STATMODEL$comparison_mode_custom_nonpairwise) + existing_names <- if (!is.null(contrast$matrix)) rownames(contrast$matrix) else character(0) + # Find the next available "custom comparison N" + n <- 1 + while (paste0("custom comparison ", n) %in% existing_names) { + n <- n + 1 + } + updateTextInput(session, + NAMESPACE_STATMODEL$comparisons_custom_nonpairwise_name, + value = paste0("custom comparison ", n)) + }) # Reset on configuration change observeEvent(c(input[[NAMESPACE_STATMODEL$comparison_mode]], loadpage_input()$proceed1), { diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 84ed241..2a3bfda 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -142,7 +142,7 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) sig = input[[NAMESPACE_STATMODEL$visualization_volcano_significance_cutoff]], FCcutoff = fold_change_cutoff, logBase.pvalue = as.numeric(input[[NAMESPACE_STATMODEL$visualization_logp_base]]), - ProteinName = FALSE, + ProteinName = TRUE, numProtein = input[[NAMESPACE_STATMODEL$visualization_heatmap_number_proteins]], clustering = input[[NAMESPACE_STATMODEL$visualization_heatmap_cluster_option]], which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], @@ -293,7 +293,7 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat sig = input[[NAMESPACE_STATMODEL$visualization_volcano_significance_cutoff]], FCcutoff = fold_change_cutoff, logBase.pvalue = as.integer(input[[NAMESPACE_STATMODEL$visualization_logp_base]]), - ProteinName = FALSE, + ProteinName = TRUE, which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], address = address_prefix ) @@ -304,7 +304,7 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat sig = input[[NAMESPACE_STATMODEL$visualization_volcano_significance_cutoff]], FCcutoff = fold_change_cutoff, logBase.pvalue = as.numeric(input[[NAMESPACE_STATMODEL$visualization_logp_base]]), - ProteinName = FALSE, + ProteinName = TRUE, numProtein = input[[NAMESPACE_STATMODEL$visualization_heatmap_number_proteins]], clustering = input[[NAMESPACE_STATMODEL$visualization_heatmap_cluster_option]], which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], diff --git a/R/statmodel-ui-comparisons.R b/R/statmodel-ui-comparisons.R index e44e555..f89807a 100644 --- a/R/statmodel-ui-comparisons.R +++ b/R/statmodel-ui-comparisons.R @@ -74,7 +74,7 @@ build_custom_nonpairwise_panel <- function(ns) { tagList( h5("Non-pairwise Comparison:"), textInput(ns(NAMESPACE_STATMODEL$comparisons_custom_nonpairwise_name), - label = "Comparison Name", value = "custom comparison"), + label = "Comparison Name", value = ""), uiOutput(ns(NAMESPACE_STATMODEL$comparisons_custom_nonpairwise_weights)), actionButton(ns(NAMESPACE_STATMODEL$comparisons_submit), "Add"), actionButton(ns(NAMESPACE_STATMODEL$comparisons_clear), "Clear matrix") diff --git a/tests/testthat/test-utils-statmodel-server.R b/tests/testthat/test-utils-statmodel-server.R index b137774..aa42ee1 100644 --- a/tests/testthat/test-utils-statmodel-server.R +++ b/tests/testthat/test-utils-statmodel-server.R @@ -287,7 +287,9 @@ test_that("extract_significant_proteins filters PTM data correctly", { loadpage_input <- list(BIO = "PTM") result <- extract_significant_proteins(data_comp, loadpage_input, 0.05) - expect_equal(nrow(result), 1) + expect_equal(nrow(result$ADJUSTED.Model), 1) + expect_equal(nrow(result$PTM.Model), 2) + expect_equal(nrow(result$PROTEIN.Model), 1) }) test_that("extract_significant_proteins filters TMT data correctly", { From 3ccf5e87a7f71ed96e4864af168090aa987005fa Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Mon, 27 Apr 2026 11:42:24 -0400 Subject: [PATCH 7/9] Address PR reviews by removing unwanted test cases and defaulting the heatmap to all alogn with removing the single comparison options dropdown --- R/constants.R | 1 - R/statmodel-server-visualization.R | 15 ++++++++++++--- R/statmodel-ui-options-visualization.R | 3 ++- .../test-statmodel-ui-options-visualization.R | 2 -- 4 files changed, 14 insertions(+), 7 deletions(-) diff --git a/R/constants.R b/R/constants.R index 3733e07..2fdfb47 100644 --- a/R/constants.R +++ b/R/constants.R @@ -36,7 +36,6 @@ NAMESPACE_STATMODEL = list( visualization_fold_change_checkbox = "visualization_fold_change_checkbox", visualization_fold_change_input = "visualization_fold_change_input", visualization_which_comparison = "visualization_which_comparison", - visualization_volcano_display_protein_name = "visualization_volcano_display_protein_name", visualization_volcano_significance_cutoff = "visualization_volcano_significance_cutoff", visualization_heatmap_number_proteins = "visualization_heatmap_number_proteins", visualization_heatmap_cluster_option = "visualization_heatmap_cluster_option", diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 2a3bfda..7d0f578 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -6,6 +6,9 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da ns = session$ns output[[NAMESPACE_STATMODEL$visualization_which_comparison]] = renderUI({ + # Don't render dropdown for Heatmap (uses all comparisons) + req(input[[NAMESPACE_STATMODEL$visualization_plot_type]] != + CONSTANTS_STATMODEL$plot_type_heatmap) comparison_names <- rownames() req(length(comparison_names) > 0) selectInput(ns(NAMESPACE_STATMODEL$visualization_which_comparison), @@ -111,7 +114,9 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) FCcutoff = fold_change_cutoff, logBase.pvalue = as.integer(input[[NAMESPACE_STATMODEL$visualization_logp_base]]), ProteinName = TRUE, - which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], + which.Comparison = if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == + CONSTANTS_STATMODEL$plot_type_heatmap) "all" + else input[[NAMESPACE_STATMODEL$visualization_which_comparison]], address = FALSE, isPlotly = TRUE ) @@ -129,7 +134,9 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) ProteinName = TRUE, numProtein = input[[NAMESPACE_STATMODEL$visualization_heatmap_number_proteins]], clustering = input[[NAMESPACE_STATMODEL$visualization_heatmap_cluster_option]], - which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], + which.Comparison = if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == + CONSTANTS_STATMODEL$plot_type_heatmap) "all" + else input[[NAMESPACE_STATMODEL$visualization_which_comparison]], which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], height = input[[NAMESPACE_STATMODEL$visualization_plot_height_slider]], address = "Ex_", @@ -145,7 +152,9 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) ProteinName = TRUE, numProtein = input[[NAMESPACE_STATMODEL$visualization_heatmap_number_proteins]], clustering = input[[NAMESPACE_STATMODEL$visualization_heatmap_cluster_option]], - which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], + which.Comparison = if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == + CONSTANTS_STATMODEL$plot_type_heatmap) "all" + else input[[NAMESPACE_STATMODEL$visualization_which_comparison]], which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], height = input[[NAMESPACE_STATMODEL$visualization_plot_height_slider]], address = "Ex_", diff --git a/R/statmodel-ui-options-visualization.R b/R/statmodel-ui-options-visualization.R index 52c9f27..4e167ac 100644 --- a/R/statmodel-ui-options-visualization.R +++ b/R/statmodel-ui-options-visualization.R @@ -66,9 +66,10 @@ create_comparison_plot_options <- function(ns) { #' @noRd create_heatmap_options <- function(ns) { tagList( + uiOutput(ns(NAMESPACE_STATMODEL$visualization_which_comparison)), h4("Note: Only one page will be shown in browser. To view all proteins please view this plot as a pdf. Heatmaps require at least two comparisons."), selectInput( - ns(NAMESPACE_STATMODEL$visualization_logp_base), + ns(NAMESPACE_STATMODEL$visualization_logp_base), label = h5("Log transformation of adjusted p-value"), c("base 2" = "2", "base 10" = "10"), selected = "10" diff --git a/tests/testthat/test-statmodel-ui-options-visualization.R b/tests/testthat/test-statmodel-ui-options-visualization.R index 26a00e7..b5b3955 100644 --- a/tests/testthat/test-statmodel-ui-options-visualization.R +++ b/tests/testthat/test-statmodel-ui-options-visualization.R @@ -39,8 +39,6 @@ test_that("Correct elements are present in create_volcano_plot_options", { ui_html <- htmltools::renderTags(result)$html expect_true(grepl(NAMESPACE_STATMODEL$visualization_which_comparison, ui_html), info = "Which comparison namespace should be present") - expect_false(grepl(NAMESPACE_STATMODEL$visualization_volcano_display_protein_name, ui_html), - info = "Display protein name checkbox should be removed") expect_true(grepl(NAMESPACE_STATMODEL$visualization_logp_base, ui_html), info = "Log p-value base namespace should be present") expect_true(grepl(NAMESPACE_STATMODEL$visualization_volcano_significance_cutoff, ui_html), From b023986c87a4b67a9d5605fb4097f6c3c0979255 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Sat, 2 May 2026 20:34:17 -0400 Subject: [PATCH 8/9] Remove the uiOutput from create_heatmap_options as it is unnecessary --- R/statmodel-server-visualization.R | 3 --- R/statmodel-ui-options-visualization.R | 1 - 2 files changed, 4 deletions(-) diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 7d0f578..c7d33a1 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -6,9 +6,6 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da ns = session$ns output[[NAMESPACE_STATMODEL$visualization_which_comparison]] = renderUI({ - # Don't render dropdown for Heatmap (uses all comparisons) - req(input[[NAMESPACE_STATMODEL$visualization_plot_type]] != - CONSTANTS_STATMODEL$plot_type_heatmap) comparison_names <- rownames() req(length(comparison_names) > 0) selectInput(ns(NAMESPACE_STATMODEL$visualization_which_comparison), diff --git a/R/statmodel-ui-options-visualization.R b/R/statmodel-ui-options-visualization.R index 4e167ac..3d8cdc4 100644 --- a/R/statmodel-ui-options-visualization.R +++ b/R/statmodel-ui-options-visualization.R @@ -66,7 +66,6 @@ create_comparison_plot_options <- function(ns) { #' @noRd create_heatmap_options <- function(ns) { tagList( - uiOutput(ns(NAMESPACE_STATMODEL$visualization_which_comparison)), h4("Note: Only one page will be shown in browser. To view all proteins please view this plot as a pdf. Heatmaps require at least two comparisons."), selectInput( ns(NAMESPACE_STATMODEL$visualization_logp_base), From d28c6b44194377440b291b0d5019af155065c929 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Sun, 3 May 2026 12:26:26 -0400 Subject: [PATCH 9/9] Resolve nitpick in Statmodel for Heatmap plot type all --- R/statmodel-server-visualization.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index c7d33a1..a2aefbc 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -300,7 +300,9 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat FCcutoff = fold_change_cutoff, logBase.pvalue = as.integer(input[[NAMESPACE_STATMODEL$visualization_logp_base]]), ProteinName = TRUE, - which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], + which.Comparison = if (plot_type == + CONSTANTS_STATMODEL$plot_type_heatmap) "all" + else input[[NAMESPACE_STATMODEL$visualization_which_comparison]], address = address_prefix ) } else { @@ -313,7 +315,9 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat ProteinName = TRUE, numProtein = input[[NAMESPACE_STATMODEL$visualization_heatmap_number_proteins]], clustering = input[[NAMESPACE_STATMODEL$visualization_heatmap_cluster_option]], - which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]], + which.Comparison = if (plot_type == + CONSTANTS_STATMODEL$plot_type_heatmap) "all" + else input[[NAMESPACE_STATMODEL$visualization_which_comparison]], which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], height = input[[NAMESPACE_STATMODEL$visualization_plot_height_slider]], address = address_prefix,