Skip to content

fix(plots): Fix plotting bugs in statistical analysis page #203

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 11 commits into from
May 3, 2026
Merged

fix(plots): Fix plotting bugs in statistical analysis page #203

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
b4d2e55
- Default the DIANN 2.0+ checkbox to unchecked
swaraj-neu Apr 23, 2026
b5f13e3
Resolve nitpicks in the DIANN dataset file type checkbox handling fea…
swaraj-neu Apr 23, 2026
cdde69f
Install dependent packages and regenerate the documentation
swaraj-neu Apr 24, 2026
0e12d23
Update the documentation
swaraj-neu Apr 24, 2026
f547738
Statmodel Inference:
swaraj-neu Apr 24, 2026
7a20fb7
Merge remote-tracking branch 'origin/devel' into bugfix/diann
swaraj-neu Apr 24, 2026
b46e6cd
- Resolve nitpicks for the non-pairwise comparison bugfixes
swaraj-neu Apr 25, 2026
3ccf5e8
Address PR reviews by removing unwanted test cases and defaulting the…
swaraj-neu Apr 27, 2026
1cc7eac
Merge remote-tracking branch 'origin/devel' into bugfix/diann
swaraj-neu May 3, 2026
b023986
Remove the uiOutput from create_heatmap_options as it is unnecessary
swaraj-neu May 3, 2026
d28c6b4
Resolve nitpick in Statmodel for Heatmap plot type all
swaraj-neu May 3, 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
1 change: 0 additions & 1 deletion R/constants.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down
15 changes: 15 additions & 0 deletions R/module-statmodel-server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))
})
Comment on lines +133 to +147

@coderabbitai coderabbitai Bot Apr 25, 2026

Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

⚠️ Potential issue | 🟡 Minor

Auto-default observer can clobber user-typed comparison names.

This observe re-fires not only when input[[comparison_mode]] switches to custom_nonpairwise, but also any time contrast$matrix changes (e.g., the input$table_cell_edit observer at lines 396–400, or after matrix_build mutates the matrix). Each time it fires it unconditionally calls updateTextInput(...), which will overwrite any name the user has typed into the comparison name field (for example, while they are editing a cell in the existing matrix or right after submitting a row).

Consider gating the update so it only runs on mode entry or when a new row was actually appended (e.g., scope the dependency with observeEvent(input[[comparison_mode]], ...) and read contrast$matrix inside isolate(), or only update when the current text input value already matches a previously-generated "custom comparison N").

🛠️ Suggested fix sketch 
-      # 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))
-      })
+      # Auto-generate unique default name for non-pairwise comparisons.
+      # Re-evaluate on mode switch or when rows are added; do not overwrite a
+      # name the user has customized away from the auto-generated pattern.
+      observeEvent(
+        list(input[[NAMESPACE_STATMODEL$comparison_mode]],
+             nrow(contrast$matrix)),
+        {
+          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)
+          current <- isolate(input[[NAMESPACE_STATMODEL$comparisons_custom_nonpairwise_name]])
+          is_auto <- is.null(current) || !nzchar(current) ||
+                     grepl("^custom comparison \\d+$", current)
+          if (!is_auto) return()
+          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))
+        },
+        ignoreInit = FALSE
+      )
🤖 Prompt for AI Agents 
Verify each finding against the current code and only fix it if needed.

In `@R/module-statmodel-server.R` around lines 133 - 147, The observer that
auto-generates the default name (the block that currently calls updateTextInput
for NAMESPACE_STATMODEL$comparisons_custom_nonpairwise_name) runs whenever
contrast$matrix changes and thus can overwrite user edits; change it to only run
on mode entry or when a genuinely new autogenerated name is required: replace
observe({...}) with observeEvent(input[[NAMESPACE_STATMODEL$comparison_mode]], {
... }) and inside the handler read contrast$matrix with isolate(contrast$matrix)
(or check the current input value via
input[[NAMESPACE_STATMODEL$comparisons_custom_nonpairwise_name]] and only call
updateTextInput when that value is empty or exactly matches a previous
autogenerated "custom comparison N"); keep the same name-generation loop but
ensure updateTextInput is conditional so it won't clobber user-typed names.


# Reset on configuration change
observeEvent(c(input[[NAMESPACE_STATMODEL$comparison_mode]], loadpage_input()$proceed1), {
Expand Down
63 changes: 47 additions & 16 deletions R/statmodel-server-visualization.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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])

@tonywu1999 tonywu1999 Apr 25, 2026

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What happens with Heatmap plots here? I think Heatmap plots benefit from being able to select "all" (does a single comparison selected for a Heatmap work?).

@swaraj-neu swaraj-neu Apr 27, 2026

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@tonywu1999 You're right, it doesn't work. for a single comparison
Removed the "Select comparison to plot" dropdown entirely for Heatmap since heatmaps inherently visualize all comparisons together. The dropdown still appears for Volcano Plot and Comparison Plot where selecting a single comparison makes sense. Also hardcoded which.Comparison = "all" for Heatmap in create_group_comparison_plot as a safety net in case the dropdown's last input value persists when switching plot types.

})

# 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({
Expand All @@ -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) {
Expand Down Expand Up @@ -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") {
result = groupComparisonPlotsPTM(
data_comparison,
Expand All @@ -90,7 +111,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
)
Expand All @@ -108,7 +131,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_",
Expand All @@ -121,10 +146,12 @@ 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 = 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_",
Expand Down Expand Up @@ -272,8 +299,10 @@ 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]],
which.Comparison = input[[NAMESPACE_STATMODEL$visualization_which_comparison]],
ProteinName = TRUE,
which.Comparison = if (plot_type ==
CONSTANTS_STATMODEL$plot_type_heatmap) "all"
else input[[NAMESPACE_STATMODEL$visualization_which_comparison]],
address = address_prefix
)
} else {
Expand All @@ -283,10 +312,12 @@ 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 = 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,
Expand Down
7 changes: 2 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 @@ -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"),
Expand Down Expand Up @@ -71,7 +68,7 @@ create_heatmap_options <- function(ns) {
tagList(
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"
Expand Down
3 changes: 0 additions & 3 deletions 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 @@ -39,13 +39,10 @@ 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),

@tonywu1999 tonywu1999 Apr 25, 2026

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think you can just get rid of this unit test. Also, can the constant be deleted too?

info = "Display protein name checkbox namespace should be present")
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", {
Expand Down
2 changes: 2 additions & 0 deletions tests/testthat/test-utils-statmodel-server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -288,6 +288,8 @@ test_that("extract_significant_proteins filters PTM data correctly", {

result <- extract_significant_proteins(data_comp, loadpage_input, 0.05)
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", {
Expand Down
Loading