Skip to content

Merge the feature to download all the plots (including group comparison) from statmodel into Development #174

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

Open
swaraj-neu wants to merge 6 commits into
base: devel
Choose a base branch
from
+259 −10
Open

Merge the feature to download all the plots (including group comparison) from statmodel into Development #174

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
0a970bc
feat: update create_download_plot_handler to support response curve p…
swaraj-neu Feb 28, 2026
308039c
fix: add error notifications for missing contrast matrix and plot files.
swaraj-neu Feb 28, 2026
adcc03a
feat: enhance download functionality tests by adding zip support for …
swaraj-neu Mar 4, 2026
4bb342e
fix: enhance download functionality for response curve plots with uni…
swaraj-neu Mar 4, 2026
2619154
fix: improve error handling in download plot handler for response cur…
swaraj-neu Mar 4, 2026
7215528
feat: Enable user to download group comparison plots like Volcano, He…
swaraj-neu Mar 5, 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
2 changes: 2 additions & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -64,6 +64,7 @@ importFrom(dplyr,n_distinct)
importFrom(dplyr,select)
importFrom(dplyr,summarise)
importFrom(dplyr,ungroup)
importFrom(ggplot2,ggsave)
importFrom(ggrepel,geom_text_repel)
importFrom(gplots,heatmap.2)
importFrom(grDevices,dev.off)
Expand Down Expand Up @@ -209,4 +210,5 @@ importFrom(utils,read.table)
importFrom(utils,txtProgressBar)
importFrom(utils,write.csv)
importFrom(utils,write.table)
importFrom(utils,zip)
importFrom(uuid,UUIDgenerate)
2 changes: 1 addition & 1 deletion R/module-statmodel-server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -205,7 +205,7 @@ statmodelServer = function(id, parent_session, loadpage_input, qc_input,
# Download handlers
create_download_handlers(output, data_comparison, SignificantProteins,
data_comparison_code)
create_download_plot_handler(output)
create_download_plot_handler(output, input, contrast, preprocess_data, data_comparison, loadpage_input)

# Plot rendering
output[[NAMESPACE_STATMODEL$visualization_plot_output]] = renderUI({
Expand Down
128 changes: 119 additions & 9 deletions R/statmodel-server-visualization.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -118,15 +118,125 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison)
showNotification(conditionMessage(e), type = "error", duration = 8)
})
}

create_download_plot_handler = function(output) {
output[[NAMESPACE_STATMODEL$visualization_download_plot_results]] = downloadHandler(
filename = function() paste("SummaryPlot-", Sys.Date(), ".zip", sep = ""),
#' @importFrom ggplot2 ggsave
#' @importFrom utils zip
create_download_plot_handler <- function(output, input, contrast, preprocess_data, data_comparison, loadpage_input) {
output[[NAMESPACE_STATMODEL$visualization_download_plot_results]] <- downloadHandler(
filename = function() {
if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] ==
CONSTANTS_STATMODEL$plot_type_response_curve) {
paste("ResponseCurvePlot-", Sys.Date(), ".zip", sep = "")
} else {
paste("SummaryPlot-", Sys.Date(), ".zip", sep = "")
}
},
content = function(file) {
files = list.files(getwd(), pattern = "^Ex_", full.names = TRUE)
file_info = file.info(files)
latest_file = files[which.max(file_info$mtime)]
file.copy(latest_file, file)
tryCatch(
{
if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] ==
CONSTANTS_STATMODEL$plot_type_response_curve) {
# Generate response curve plot
matrix <- contrast$matrix
if (is.null(matrix)) {
showNotification("Please build a contrast matrix first.", type = "error")
return(NULL)
}
protein_level_data <- merge(preprocess_data()$ProteinLevelData, matrix, by = "GROUP")
dia_prepared <- prepare_dose_response_fit(data = protein_level_data)

response_plot <- visualizeResponseProtein(
data = dia_prepared,
protein_name = input[[NAMESPACE_STATMODEL$visualization_which_protein]],
drug_name = input[[NAMESPACE_STATMODEL$visualization_response_curve_which_drug]],
ratio_response = isTRUE(input[[NAMESPACE_STATMODEL$visualization_response_curve_ratio_scale]]),
show_ic50 = TRUE,
add_ci = TRUE,
transform_dose = input[[NAMESPACE_STATMODEL$modeling_response_curve_log_xaxis]],
n_samples = 1000,
increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]]
)

# Save plot to a unique temp PDF, then zip it
pdf_path <- tempfile("Ex_ResponseCurvePlot-", fileext = ".pdf")
ggplot2::ggsave(pdf_path,
plot = response_plot, device = "pdf",
width = 10, height = 8
)

zip_path <- tempfile("Ex_ResponseCurvePlot-", fileext = ".zip")
on.exit(unlink(c(pdf_path, zip_path), force = TRUE), add = TRUE)
utils::zip(zipfile = zip_path, files = pdf_path, flags = "-j")
copied <- file.copy(zip_path, file, overwrite = TRUE)
if (!isTRUE(copied)) {
showNotification("Failed to copy response curve ZIP for download.", type = "error")
return(NULL)
}
Comment on lines +160 to +173
Copy link
Contributor

@tonywu1999 tonywu1999 Mar 5, 2026

Choose a reason for hiding this comment

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

This code + the temp directory creation seems to be duplicated between both plot types. Can this be consolidated into one code block? I don't think the zipfile names need to be necessarily different here (or a helper function that helps zipping files based on ggplot outputs).

} else {
# Generate group comparison plot using a session-scoped temp directory
plot_type <- input[[NAMESPACE_STATMODEL$visualization_plot_type]]
fold_change_cutoff <- ifelse(
Copy link
Contributor

@tonywu1999 tonywu1999 Mar 5, 2026

Choose a reason for hiding this comment

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

I think this should be zero if NULL.

!is.null(input[[NAMESPACE_STATMODEL$visualization_fold_change_input]]),
input[[NAMESPACE_STATMODEL$visualization_fold_change_input]], FALSE
)

# Use a temp directory so the function saves the PDF natively
temp_dir <- tempfile("plot_download_")
dir.create(temp_dir)
on.exit(unlink(temp_dir, recursive = TRUE, force = TRUE), add = TRUE)
address_prefix <- file.path(temp_dir, "Ex_")

if (loadpage_input()$BIO == "PTM") {
groupComparisonPlotsPTM(
data_comparison(),
plot_type,
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]],
address = address_prefix
)
} else {
groupComparisonPlots(
data = data_comparison()$ComparisonResult,
type = plot_type,
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]],
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.Protein = input[[NAMESPACE_STATMODEL$visualization_which_protein]],
height = input[[NAMESPACE_STATMODEL$visualization_plot_height_slider]],
address = address_prefix,
isPlotly = FALSE
)
}

# Find the PDF files the function saved to the temp directory
pdf_files <- list.files(temp_dir, pattern = "\\.pdf$", full.names = TRUE)
if (length(pdf_files) == 0) {
showNotification("No plot files were generated.", type = "error")
return(NULL)
}

# Zip all generated PDFs (some plot types may produce multiple files)
zip_path <- tempfile("SummaryPlot-", fileext = ".zip")
on.exit(unlink(zip_path, force = TRUE), add = TRUE)
utils::zip(zipfile = zip_path, files = pdf_files, flags = "-j")
copied <- file.copy(zip_path, file, overwrite = TRUE)
if (!isTRUE(copied)) {
showNotification("Failed to prepare plot download.", type = "error")
return(NULL)
}
}
},
error = function(e) {
showNotification(conditionMessage(e), type = "error")
return(NULL)
}
)
}
)
}
}
137 changes: 137 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 @@ -633,4 +633,141 @@ test_that("Ratio scale checkbox input can be toggled", {
)
}
)
})

# ============================================================================
# DOWNLOAD PLOT HANDLER TESTS
# ============================================================================

test_that("create_download_plot_handler registers a downloadHandler", {
mock_input <- list()
mock_input[[NAMESPACE_STATMODEL$visualization_plot_type]] <- CONSTANTS_STATMODEL$plot_type_response_curve

mock_contrast <- list(matrix = NULL)
mock_preprocess <- function() { NULL }

mock_download_handler <- mock("handler_result")

stub(create_download_plot_handler, "downloadHandler", mock_download_handler)

mock_output <- list()
stub(create_download_plot_handler, "output", mock_output)

# Use a real-looking output assignment by wrapping in testServer
testServer(
statmodelServer,
args = list(
parent_session = MockShinySession$new(),
loadpage_input = reactive({
list(BIO = "protein", DDA_DIA = "DDA", filetype = "standard", proceed1 = 0)
}),
qc_input = reactive({ list(normalization = "equalizeMedians") }),
get_data = reactive({ create_mock_raw_data() }),
preprocess_data = reactive({ create_mock_data("DDA", "protein") })
),
{
# Server initialized: create_download_plot_handler was called internally
# Verify the server doesn't crash with the new 4-argument signature
expect_null(contrast$matrix)
Copy link
Contributor

@tonywu1999 tonywu1999 Mar 5, 2026

Choose a reason for hiding this comment

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

I'm not sure if this is a valid test that would validate create_download_plot_handler was even called. You'd need to verify the mock for create_download_plot_handler was invoked.

}
)
})

test_that("download handler filename returns ResponseCurvePlot for response curves", {
# Test the filename logic directly
plot_type <- CONSTANTS_STATMODEL$plot_type_response_curve
filename <- if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) {
paste("ResponseCurvePlot-", Sys.Date(), ".zip", sep = "")
} else {
paste("SummaryPlot-", Sys.Date(), ".zip", sep = "")
}
expect_true(grepl("ResponseCurvePlot", filename))
expect_true(grepl("\\.zip$", filename))
})

test_that("download handler filename returns SummaryPlot for other plot types", {
plot_type <- CONSTANTS_STATMODEL$plot_type_volcano_plot
filename <- if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) {
paste("ResponseCurvePlot-", Sys.Date(), ".zip", sep = "")
} else {
paste("SummaryPlot-", Sys.Date(), ".zip", sep = "")
}
expect_true(grepl("SummaryPlot", filename))
expect_true(grepl("\\.zip$", filename))
})

# ============================================================================
# GROUP COMPARISON PLOT DOWNLOAD TESTS
# ============================================================================

test_that("download handler filename returns SummaryPlot for Volcano plot", {
plot_type <- CONSTANTS_STATMODEL$plot_type_volcano_plot
filename <- if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) {
paste("ResponseCurvePlot-", Sys.Date(), ".zip", sep = "")
} else {
paste("SummaryPlot-", Sys.Date(), ".zip", sep = "")
}
expect_true(grepl("SummaryPlot", filename))
expect_true(grepl("\\.zip$", filename))
})

test_that("download handler filename returns SummaryPlot for Heatmap", {
plot_type <- CONSTANTS_STATMODEL$plot_type_heatmap
filename <- if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) {
paste("ResponseCurvePlot-", Sys.Date(), ".zip", sep = "")
} else {
paste("SummaryPlot-", Sys.Date(), ".zip", sep = "")
}
expect_true(grepl("SummaryPlot", filename))
expect_true(grepl("\\.zip$", filename))
})

test_that("download handler filename returns SummaryPlot for ComparisonPlot", {
plot_type <- CONSTANTS_STATMODEL$plot_type_comparison_plot
filename <- if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) {
paste("ResponseCurvePlot-", Sys.Date(), ".zip", sep = "")
} else {
paste("SummaryPlot-", Sys.Date(), ".zip", sep = "")
}
expect_true(grepl("SummaryPlot", filename))
expect_true(grepl("\\.zip$", filename))
})
Comment on lines +676 to +734
Copy link
Contributor

@tonywu1999 tonywu1999 Mar 5, 2026

Choose a reason for hiding this comment

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

You're not testing any helper functions here. Could you adjust these tests to use test a helper function?


test_that("statmodelServer initializes with updated download handler signature", {
testServer(
statmodelServer,
args = list(
parent_session = MockShinySession$new(),
loadpage_input = reactive({
list(BIO = "protein", DDA_DIA = "DDA", filetype = "standard", proceed1 = 0)
}),
qc_input = reactive({ list(normalization = "equalizeMedians") }),
get_data = reactive({ create_mock_raw_data() }),
preprocess_data = reactive({ create_mock_data("DDA", "protein") })
),
{
# Verify server initializes without error with 6-argument download handler
# (output, input, contrast, preprocess_data, data_comparison, loadpage_input)
expect_null(contrast$matrix)
Copy link
Contributor

@tonywu1999 tonywu1999 Mar 5, 2026

Choose a reason for hiding this comment

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

Similarly, I'm not sure if this is a valid test that would validate create_download_plot_handler was even called. You'd need to verify the mock for create_download_plot_handler was invoked with the 6 arguments

expect_null(significant$result)
}
)
})

test_that("all plot type constants are defined for download handler branching", {
Copy link
Contributor

@tonywu1999 tonywu1999 Mar 5, 2026

Choose a reason for hiding this comment

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

Similarly, this test only tests the constants are different, but what would be more useful is verifying the logic flow of the helper function create_download_plot_handler

# Verify all plot types the download handler needs to branch on exist
expect_true(!is.null(CONSTANTS_STATMODEL$plot_type_volcano_plot))
expect_true(!is.null(CONSTANTS_STATMODEL$plot_type_heatmap))
expect_true(!is.null(CONSTANTS_STATMODEL$plot_type_comparison_plot))
expect_true(!is.null(CONSTANTS_STATMODEL$plot_type_response_curve))

# Verify they are distinct values
plot_types <- c(
CONSTANTS_STATMODEL$plot_type_volcano_plot,
CONSTANTS_STATMODEL$plot_type_heatmap,
CONSTANTS_STATMODEL$plot_type_comparison_plot,
CONSTANTS_STATMODEL$plot_type_response_curve
)
expect_equal(length(plot_types), length(unique(plot_types)),
info = "All plot type constants should be unique")
})
Loading