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..53db1eb 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -77,10 +77,8 @@ 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( + 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) @@ -524,9 +522,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..67fd651 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -20,22 +20,11 @@ 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()) + include_qq <- !isTRUE(loadpage_input()$BIO == "PTM") updateSelectInput(session, NAMESPACE_STATMODEL$visualization_plot_type, - choices = choices) + choices = default_template_plot_type_choices(n_comparisons, + include_qq = include_qq)) }) output[[NAMESPACE_STATMODEL$visualization_which_protein]] = renderUI({ @@ -55,6 +44,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 +157,36 @@ 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 +#' @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, 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) + } else { + c("Volcano Plot" = CONSTANTS_STATMODEL$plot_type_volcano_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 #' @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 +316,23 @@ 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) + tryCatch( + MSstats::groupComparisonQCPlots( + data = data_comparison(), + type = "QQPlots", + which.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]], + address = FALSE + ), + finally = dev.off() + ) } else { groupComparisonPlots( data = data_comparison()$ComparisonResult, @@ -316,7 +343,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..cbd49f5 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -656,6 +656,61 @@ 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("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") 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