From 0279f4c9a5f994a257b5cabd74b91bbb91f34148 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Mon, 15 Jun 2026 17:20:26 -0400 Subject: [PATCH 1/2] Add QQ plot to the statistical-analysis page --- R/constants.R | 3 +- R/module-statmodel-server.R | 27 +++++++--- R/statmodel-server-download-code.R | 7 +++ R/statmodel-server-visualization.R | 53 +++++++++++++------ R/statmodel-ui-options-visualization.R | 18 +++++-- tests/testthat/test-module-statmodel-server.R | 35 ++++++++++++ .../test-statmodel-ui-options-visualization.R | 11 +++- 7 files changed, 123 insertions(+), 31 deletions(-) diff --git a/R/constants.R b/R/constants.R index 2fdfb47..5305820 100644 --- a/R/constants.R +++ b/R/constants.R @@ -57,7 +57,8 @@ CONSTANTS_STATMODEL = list( plot_type_volcano_plot = "VolcanoPlot", # VolcanoPlot plot_type_heatmap = "Heatmap", # Heatmap plot_type_comparison_plot = "ComparisonPlot", # ComparisonPlot - plot_type_response_curve = "ResponseCurve" # ResponseCurve + plot_type_response_curve = "ResponseCurve", # ResponseCurve + plot_type_qq_plot = "QQPlots" # QQPlots — matches MSstats::groupComparisonQCPlots(type = "QQPlots") ) NAMESPACE_EXPDES = list( diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 0337d5d..3a3488f 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -77,11 +77,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, ), selected = character(0)) updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type, - choices = c( - "Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, - "Heatmap" = CONSTANTS_STATMODEL$plot_type_heatmap, - "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot - )) + choices = default_template_plot_type_choices()) updateCheckboxInput(session, NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend, value = FALSE) shinyjs::show("statmodel_contrast_header", asis = TRUE) shinyjs::show("statmodel_workflow_bullet_default", asis = TRUE) @@ -524,9 +520,26 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, ) } }) - + + } else if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == + CONSTANTS_STATMODEL$plot_type_qq_plot) { + output_plot = renderPlot({ + req(input[[NAMESPACE_STATMODEL$visualization_which_protein]]) + show_modal_spinner() + tryCatch({ + MSstats::groupComparisonQCPlots( + data = data_comparison(), + type = "QQPlots", + which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], + address = FALSE + ) + }, error = function(e) { + showNotification(conditionMessage(e), type = "error", duration = 8) + NULL + }, finally = { remove_modal_spinner() }) + }) } else { - output_plot = renderPlotly({ + output_plot = renderPlotly({ create_group_comparison_plot( input, loadpage_input(), data_comparison() ) diff --git a/R/statmodel-server-download-code.R b/R/statmodel-server-download-code.R index 49729ca..e783c43 100644 --- a/R/statmodel-server-download-code.R +++ b/R/statmodel-server-download-code.R @@ -126,12 +126,19 @@ generate_analysis_code = function(qc_input, loadpage_input, comp_mat, input, app codes = paste(codes, "model = MSstats::groupComparison(contrast.matrix, summarized)\n", sep = "") } + plot_type = input[[NAMESPACE_STATMODEL$visualization_plot_type]] + if (loadpage_input$BIO == "PTM") { codes = paste(codes, "groupComparisonPlotsPTM(data=model, type=\"Enter VolcanoPlot, Heatmap, or ComparisonPlot\", which.Comparison=\"all\", which.PTM=\"all\", address=\"\")\n", sep = "") + } else if (!is.null(plot_type) && plot_type == CONSTANTS_STATMODEL$plot_type_qq_plot) { + codes = paste(codes, "MSstats::groupComparisonQCPlots(data=model, + type=\"QQPlots\", + which.Protein=\"Enter a single protein name\", + address=\"\")\n", sep = "") } else { codes = paste(codes, "groupComparisonPlots(data=model$ComparisonResult, type=\"Enter VolcanoPlot, Heatmap, or ComparisonPlot\", diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 2c71c0a..99f2b7e 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -20,22 +20,9 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da 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 - ) - } + n_comparisons <- length(rownames()) updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type, - choices = choices) + choices = default_template_plot_type_choices(n_comparisons)) }) output[[NAMESPACE_STATMODEL$visualization_which_protein]] = renderUI({ @@ -55,6 +42,8 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da create_heatmap_options(ns) } else if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) { create_response_curve_options(ns, template = if (!is.null(app_template)) app_template() else NULL) + } else if (plot_type == CONSTANTS_STATMODEL$plot_type_qq_plot) { + create_qq_plot_options(ns) } else { NULL } @@ -166,12 +155,32 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) NULL }) } +#' Default-template plot-type choices for the visualization dropdown +#' @param n_comparisons number of comparisons currently in the contrast matrix +#' @return named character vector suitable for `selectInput(choices = ...)` +#' @noRd +default_template_plot_type_choices <- function(n_comparisons = 0) { + if (isTRUE(n_comparisons >= 2)) { + c("Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, + "Heatmap" = CONSTANTS_STATMODEL$plot_type_heatmap, + "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot, + "QQ Plot" = CONSTANTS_STATMODEL$plot_type_qq_plot) + } else { + c("Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, + "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot, + "QQ Plot" = CONSTANTS_STATMODEL$plot_type_qq_plot) + } +} + #' Get filename for plot download based on plot type #' @param plot_type the current plot type string #' @return filename string ending in .zip +#' @noRd get_download_plot_filename <- function(plot_type) { if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) { paste("ResponseCurvePlot-", Sys.Date(), ".zip", sep = "") + } else if (plot_type == CONSTANTS_STATMODEL$plot_type_qq_plot) { + paste("QQPlot-", Sys.Date(), ".zip", sep = "") } else { paste("SummaryPlot-", Sys.Date(), ".zip", sep = "") } @@ -301,11 +310,21 @@ 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 = if (plot_type == + which.Comparison = if (plot_type == CONSTANTS_STATMODEL$plot_type_heatmap) "all" else input[[NAMESPACE_STATMODEL$visualization_which_comparison]], address = address_prefix ) + } else if (plot_type == CONSTANTS_STATMODEL$plot_type_qq_plot) { + qq_file <- file.path(temp_dir, "Ex_QQPlot.pdf") + pdf(qq_file, width = 10, height = 10) + MSstats::groupComparisonQCPlots( + data = data_comparison(), + type = "QQPlots", + which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], + address = FALSE + ) + dev.off() } else { groupComparisonPlots( data = data_comparison()$ComparisonResult, @@ -316,7 +335,7 @@ 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 = if (plot_type == + 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]], diff --git a/R/statmodel-ui-options-visualization.R b/R/statmodel-ui-options-visualization.R index 3d8cdc4..d972ebc 100644 --- a/R/statmodel-ui-options-visualization.R +++ b/R/statmodel-ui-options-visualization.R @@ -19,13 +19,14 @@ create_visualization_section <- function(ns) { create_plot_type_selector <- function(ns) { fluidRow( selectInput( - ns(NAMESPACE_STATMODEL$visualization_plot_type), - label = h4("3. Visualization - select plot type"), + ns(NAMESPACE_STATMODEL$visualization_plot_type), + label = h4("3. Visualization - select plot type"), c( - "Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, - "Heatmap" = CONSTANTS_STATMODEL$plot_type_heatmap, + "Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, + "Heatmap" = CONSTANTS_STATMODEL$plot_type_heatmap, "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot, - "Response Curve" = CONSTANTS_STATMODEL$plot_type_response_curve + "Response Curve" = CONSTANTS_STATMODEL$plot_type_response_curve, + "QQ Plot" = CONSTANTS_STATMODEL$plot_type_qq_plot ) ) ) @@ -62,6 +63,13 @@ create_comparison_plot_options <- function(ns) { uiOutput(ns(NAMESPACE_STATMODEL$visualization_which_protein)) ) } +#' Create QQ plot specific options +#' @noRd +create_qq_plot_options <- function(ns) { + tagList( + uiOutput(ns(NAMESPACE_STATMODEL$visualization_which_protein)) + ) +} #' Create heatmap specific options #' @noRd create_heatmap_options <- function(ns) { diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index 7d6d35f..fef6b59 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -656,6 +656,41 @@ test_that("get_download_plot_filename returns SummaryPlot for non-response-curve } }) +test_that("get_download_plot_filename returns QQPlot for QQ plot type", { + filename <- MSstatsShiny:::get_download_plot_filename(CONSTANTS_STATMODEL$plot_type_qq_plot) + expect_true(grepl("^QQPlot-", filename)) + expect_true(grepl("\\.zip$", filename)) +}) + +test_that("default_template_plot_type_choices excludes Heatmap when n_comparisons < 2", { + for (n in c(0, 1)) { + choices <- MSstatsShiny:::default_template_plot_type_choices(n) + expect_true("Volcano Plot" %in% names(choices), info = paste("n =", n)) + expect_true("Comparison Plot" %in% names(choices), info = paste("n =", n)) + expect_true("QQ Plot" %in% names(choices), info = paste("n =", n)) + expect_false("Heatmap" %in% names(choices), info = paste("n =", n)) + } +}) + +test_that("default_template_plot_type_choices includes Heatmap when n_comparisons >= 2", { + choices <- MSstatsShiny:::default_template_plot_type_choices(2) + expect_true("Volcano Plot" %in% names(choices)) + expect_true("Heatmap" %in% names(choices)) + expect_true("Comparison Plot" %in% names(choices)) + expect_true("QQ Plot" %in% names(choices)) +}) + +test_that("default_template_plot_type_choices binds QQ Plot to the QQPlots constant", { + choices <- MSstatsShiny:::default_template_plot_type_choices(0) + expect_equal(unname(choices[["QQ Plot"]]), CONSTANTS_STATMODEL$plot_type_qq_plot) + expect_equal(CONSTANTS_STATMODEL$plot_type_qq_plot, "QQPlots") +}) + +test_that("default_template_plot_type_choices defaults to no-Heatmap when n_comparisons omitted", { + expect_identical(MSstatsShiny:::default_template_plot_type_choices(), + MSstatsShiny:::default_template_plot_type_choices(0)) +}) + test_that("zip_and_copy_plot creates a valid zip from PDF files", { # Create a real temp PDF to zip temp_pdf <- tempfile("test_plot_", fileext = ".pdf") diff --git a/tests/testthat/test-statmodel-ui-options-visualization.R b/tests/testthat/test-statmodel-ui-options-visualization.R index b5b3955..4df6fe0 100644 --- a/tests/testthat/test-statmodel-ui-options-visualization.R +++ b/tests/testthat/test-statmodel-ui-options-visualization.R @@ -33,6 +33,14 @@ test_that("Correct elements are present in create_comparison_plot_options", { info = "Which protein namespace should be present") }) +test_that("Correct elements are present in create_qq_plot_options", { + ns <- NS("test_module") + result <- create_qq_plot_options(ns) + ui_html <- htmltools::renderTags(result)$html + expect_true(grepl(NAMESPACE_STATMODEL$visualization_which_protein, ui_html), + info = "Which protein namespace should be present for QQ plot") +}) + test_that("Correct elements are present in create_volcano_plot_options", { ns <- NS("test_module") result <- create_volcano_plot_options(ns) @@ -55,5 +63,6 @@ test_that("All possible options in create_plot_type_selector", { info = "Heatmap option should be present") expect_true(grepl("Comparison Plot", ui_html), info = "Comparison Plot should be present") - + expect_true(grepl("QQ Plot", ui_html), + info = "QQ Plot option should be present") }) \ No newline at end of file From 2e25acf3c38bc829f10bccdb48f111b3c1107b77 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Mon, 15 Jun 2026 19:42:23 -0400 Subject: [PATCH 2/2] Resolve the nitpicks --- R/module-statmodel-server.R | 4 ++- R/statmodel-server-visualization.R | 34 ++++++++++++------- tests/testthat/test-module-statmodel-server.R | 20 +++++++++++ 3 files changed, 44 insertions(+), 14 deletions(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 3a3488f..53db1eb 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -77,7 +77,9 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input, ), selected = character(0)) updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type, - choices = default_template_plot_type_choices()) + choices = default_template_plot_type_choices( + include_qq = !isTRUE(loadpage_input()$BIO == "PTM") + )) updateCheckboxInput(session, NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend, value = FALSE) shinyjs::show("statmodel_contrast_header", asis = TRUE) shinyjs::show("statmodel_workflow_bullet_default", asis = TRUE) diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 99f2b7e..67fd651 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -21,8 +21,10 @@ render_group_comparison_plot_inputs = function(output, session, rownames, get_da if (mode == CONSTANTS_STATMODEL$comparison_mode_response_curve) return() n_comparisons <- length(rownames()) + include_qq <- !isTRUE(loadpage_input()$BIO == "PTM") updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type, - choices = default_template_plot_type_choices(n_comparisons)) + choices = default_template_plot_type_choices(n_comparisons, + include_qq = include_qq)) }) output[[NAMESPACE_STATMODEL$visualization_which_protein]] = renderUI({ @@ -157,19 +159,23 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) } #' Default-template plot-type choices for the visualization dropdown #' @param n_comparisons number of comparisons currently in the contrast matrix +#' @param include_qq if FALSE, omit "QQ Plot" (PTM data lacks the required +#' FittedModel field for `groupComparisonQCPlots`). #' @return named character vector suitable for `selectInput(choices = ...)` #' @noRd -default_template_plot_type_choices <- function(n_comparisons = 0) { - if (isTRUE(n_comparisons >= 2)) { +default_template_plot_type_choices <- function(n_comparisons = 0, include_qq = TRUE) { + choices <- if (isTRUE(n_comparisons >= 2)) { c("Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, "Heatmap" = CONSTANTS_STATMODEL$plot_type_heatmap, - "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot, - "QQ Plot" = CONSTANTS_STATMODEL$plot_type_qq_plot) + "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot) } else { c("Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_plot, - "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot, - "QQ Plot" = CONSTANTS_STATMODEL$plot_type_qq_plot) + "Comparison Plot" = CONSTANTS_STATMODEL$plot_type_comparison_plot) } + if (isTRUE(include_qq)) { + choices <- c(choices, "QQ Plot" = CONSTANTS_STATMODEL$plot_type_qq_plot) + } + choices } #' Get filename for plot download based on plot type @@ -318,13 +324,15 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat } else if (plot_type == CONSTANTS_STATMODEL$plot_type_qq_plot) { qq_file <- file.path(temp_dir, "Ex_QQPlot.pdf") pdf(qq_file, width = 10, height = 10) - MSstats::groupComparisonQCPlots( - data = data_comparison(), - type = "QQPlots", - which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], - address = FALSE + tryCatch( + MSstats::groupComparisonQCPlots( + data = data_comparison(), + type = "QQPlots", + which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], + address = FALSE + ), + finally = dev.off() ) - dev.off() } else { groupComparisonPlots( data = data_comparison()$ComparisonResult, diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index fef6b59..cbd49f5 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -691,6 +691,26 @@ test_that("default_template_plot_type_choices defaults to no-Heatmap when n_comp MSstatsShiny:::default_template_plot_type_choices(0)) }) +test_that("default_template_plot_type_choices omits QQ Plot when include_qq = FALSE", { + for (n in c(0, 1, 2)) { + choices <- MSstatsShiny:::default_template_plot_type_choices(n, include_qq = FALSE) + expect_false("QQ Plot" %in% names(choices), + info = paste("n =", n, "include_qq = FALSE")) + expect_true("Volcano Plot" %in% names(choices), info = paste("n =", n)) + expect_true("Comparison Plot" %in% names(choices), info = paste("n =", n)) + } + expect_false("QQ Plot" %in% names( + MSstatsShiny:::default_template_plot_type_choices(2, include_qq = FALSE))) +}) + +test_that("default_template_plot_type_choices includes QQ Plot when include_qq = TRUE", { + for (n in c(0, 1, 2)) { + choices <- MSstatsShiny:::default_template_plot_type_choices(n, include_qq = TRUE) + expect_true("QQ Plot" %in% names(choices), + info = paste("n =", n, "include_qq = TRUE")) + } +}) + test_that("zip_and_copy_plot creates a valid zip from PDF files", { # Create a real temp PDF to zip temp_pdf <- tempfile("test_plot_", fileext = ".pdf")