Skip to content

Add QQ plot to the statistical-analysis page #216

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
tonywu1999 merged 2 commits into from
Jun 16, 2026
Merged

Add QQ plot to the statistical-analysis page #216

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
0279f4c
Add QQ plot to the statistical-analysis page
swaraj-neu Jun 15, 2026
2e25acf
Resolve the nitpicks
swaraj-neu Jun 15, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion R/constants.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand Down
27 changes: 21 additions & 6 deletions R/module-statmodel-server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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()
)
Expand Down
7 changes: 7 additions & 0 deletions R/statmodel-server-download-code.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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\",
Expand Down
61 changes: 44 additions & 17 deletions R/statmodel-server-visualization.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))
})
Comment thread
coderabbitai[bot] marked this conversation as resolved.

output[[NAMESPACE_STATMODEL$visualization_which_protein]] = renderUI({
Expand All @@ -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
}
Expand Down Expand Up @@ -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 = "")
}
Expand Down Expand Up @@ -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,
Expand All @@ -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]],
Expand Down
18 changes: 13 additions & 5 deletions R/statmodel-ui-options-visualization.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
)
)
)
Expand Down Expand Up @@ -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) {
Expand Down
55 changes: 55 additions & 0 deletions tests/testthat/test-module-statmodel-server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down
11 changes: 10 additions & 1 deletion tests/testthat/test-statmodel-ui-options-visualization.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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")
})
Loading