From 0a970bc1be060f3969af9183023ee06f183e50f1 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Sat, 28 Feb 2026 10:38:11 -0500 Subject: [PATCH 1/6] feat: update create_download_plot_handler to support response curve plots to be exported as a zip file --- R/module-statmodel-server.R | 2 +- R/statmodel-server-visualization.R | 57 ++++++++++++++++--- tests/testthat/test-module-statmodel-server.R | 25 ++++++++ .../test-statmodel-ui-options-visualization.R | 26 +++++++++ 4 files changed, 100 insertions(+), 10 deletions(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 0881e62..1207951 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -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) # Plot rendering output[[NAMESPACE_STATMODEL$visualization_plot_output]] = renderUI({ diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 0343a5f..46dbbc4 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -118,15 +118,54 @@ 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 = ""), +create_download_plot_handler <- function(output, input, contrast, preprocess_data) { + 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) + if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == + CONSTANTS_STATMODEL$plot_type_response_curve) { + # Generate response curve plot + matrix <- contrast$matrix + 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 temp PDF, then zip it + temp_dir <- tempdir() + pdf_path <- file.path(temp_dir, "Ex_ResponseCurvePlot.pdf") + ggplot2::ggsave(pdf_path, + plot = response_plot, device = "pdf", + width = 10, height = 8 + ) + + zip_path <- file.path(temp_dir, "Ex_ResponseCurvePlot.zip") + utils::zip(zip_path, files = pdf_path, flags = "-j") + file.copy(zip_path, file) + } else { + # Existing behavior for other plot types (TODO: refactor in future issue) + 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) + } } ) -} +} \ No newline at end of file diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index a40f2d8..1515b32 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -633,4 +633,29 @@ test_that("Ratio scale checkbox input can be toggled", { ) } ) +}) + +# ============================================================================ +# DOWNLOAD PLOT HANDLER TESTS +# ============================================================================ + +test_that("statmodelServer initializes with updated download handler without error", { + expect_error( + 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") }) + ), + { + expect_null(contrast$matrix) + } + ), + NA + ) }) \ No newline at end of file diff --git a/tests/testthat/test-statmodel-ui-options-visualization.R b/tests/testthat/test-statmodel-ui-options-visualization.R index 3133bdc..b4cbbca 100644 --- a/tests/testthat/test-statmodel-ui-options-visualization.R +++ b/tests/testthat/test-statmodel-ui-options-visualization.R @@ -59,4 +59,30 @@ test_that("All possible options in create_plot_type_selector", { expect_true(grepl("Comparison Plot", ui_html), info = "Comparison Plot should be present") +}) + +# ============================================================================ +# DOWNLOAD PLOT HANDLER TESTS +# ============================================================================ + +test_that("statmodelServer initializes with updated download handler without error", { + expect_error( + 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 successfully with updated create_download_plot_handler + expect_null(contrast$matrix) + } + ), + NA + ) }) \ No newline at end of file From 308039cfc6595f34d0bc0653461b36d55a585e3b Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Sat, 28 Feb 2026 11:09:21 -0500 Subject: [PATCH 2/6] fix: add error notifications for missing contrast matrix and plot files. Minor cleanups --- R/statmodel-server-visualization.R | 9 +++++++ .../test-statmodel-ui-options-visualization.R | 26 ------------------- 2 files changed, 9 insertions(+), 26 deletions(-) diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 46dbbc4..b3bc67d 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -133,6 +133,10 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat 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) @@ -159,9 +163,14 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat zip_path <- file.path(temp_dir, "Ex_ResponseCurvePlot.zip") utils::zip(zip_path, files = pdf_path, flags = "-j") file.copy(zip_path, file) + unlink(c(pdf_path, zip_path)) } else { # Existing behavior for other plot types (TODO: refactor in future issue) files <- list.files(getwd(), pattern = "^Ex_", full.names = TRUE) + if (length(files) == 0) { + showNotification("No plot files found to download.", type = "error") + return(NULL) + } file_info <- file.info(files) latest_file <- files[which.max(file_info$mtime)] file.copy(latest_file, file) diff --git a/tests/testthat/test-statmodel-ui-options-visualization.R b/tests/testthat/test-statmodel-ui-options-visualization.R index b4cbbca..3133bdc 100644 --- a/tests/testthat/test-statmodel-ui-options-visualization.R +++ b/tests/testthat/test-statmodel-ui-options-visualization.R @@ -59,30 +59,4 @@ test_that("All possible options in create_plot_type_selector", { expect_true(grepl("Comparison Plot", ui_html), info = "Comparison Plot should be present") -}) - -# ============================================================================ -# DOWNLOAD PLOT HANDLER TESTS -# ============================================================================ - -test_that("statmodelServer initializes with updated download handler without error", { - expect_error( - 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 successfully with updated create_download_plot_handler - expect_null(contrast$matrix) - } - ), - NA - ) }) \ No newline at end of file From adcc03a10d8ba06ce81f8c6abce06f35f167c170 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Wed, 4 Mar 2026 15:12:34 -0500 Subject: [PATCH 3/6] feat: enhance download functionality tests by adding zip support for response curve plots --- NAMESPACE | 2 + R/statmodel-server-visualization.R | 2 + tests/testthat/test-module-statmodel-server.R | 70 ++++++++++++++----- 3 files changed, 57 insertions(+), 17 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ed41e9d..4985cf0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -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) @@ -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) diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index b3bc67d..7acb336 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -118,6 +118,8 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) showNotification(conditionMessage(e), type = "error", duration = 8) }) } +#' @importFrom ggplot2 ggsave +#' @importFrom utils zip create_download_plot_handler <- function(output, input, contrast, preprocess_data) { output[[NAMESPACE_STATMODEL$visualization_download_plot_results]] <- downloadHandler( filename = function() { diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index 1515b32..ba25c4f 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -639,23 +639,59 @@ test_that("Ratio scale checkbox input can be toggled", { # DOWNLOAD PLOT HANDLER TESTS # ============================================================================ -test_that("statmodelServer initializes with updated download handler without error", { - expect_error( - 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") }) - ), - { - expect_null(contrast$matrix) - } +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") }) ), - NA + { + # 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) + } ) +}) + +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)) }) \ No newline at end of file From 4bb342ede3b43a7ec18a626318bd4ad4bfa4c7e2 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Wed, 4 Mar 2026 15:31:16 -0500 Subject: [PATCH 4/6] fix: enhance download functionality for response curve plots with unique temp files and error handling --- R/statmodel-server-visualization.R | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 7acb336..6f115a3 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -154,18 +154,21 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat increasing = input[[NAMESPACE_STATMODEL$modeling_response_curve_increasing_trend]] ) - # Save plot to a temp PDF, then zip it - temp_dir <- tempdir() - pdf_path <- file.path(temp_dir, "Ex_ResponseCurvePlot.pdf") + # 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 <- file.path(temp_dir, "Ex_ResponseCurvePlot.zip") - utils::zip(zip_path, files = pdf_path, flags = "-j") - file.copy(zip_path, file) - unlink(c(pdf_path, zip_path)) + 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) + } } else { # Existing behavior for other plot types (TODO: refactor in future issue) files <- list.files(getwd(), pattern = "^Ex_", full.names = TRUE) @@ -175,7 +178,18 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat } file_info <- file.info(files) latest_file <- files[which.max(file_info$mtime)] - file.copy(latest_file, file) + if (grepl("\\.zip$", latest_file, ignore.case = TRUE)) { + copied <- file.copy(latest_file, file, overwrite = TRUE) + } else { + summary_zip <- tempfile("SummaryPlot-", fileext = ".zip") + on.exit(unlink(summary_zip, force = TRUE), add = TRUE) + utils::zip(zipfile = summary_zip, files = latest_file, flags = "-j") + copied <- file.copy(summary_zip, file, overwrite = TRUE) + } + if (!isTRUE(copied)) { + showNotification("Failed to prepare summary plot download.", type = "error") + return(NULL) + } } } ) From 26191542837cac2ad89a9dbdb625fd7eede95fd9 Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Wed, 4 Mar 2026 18:30:58 -0500 Subject: [PATCH 5/6] fix: improve error handling in download plot handler for response curve plots --- R/statmodel-server-visualization.R | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index 6f115a3..bf5f5ae 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -131,8 +131,9 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat } }, content = function(file) { - if (input[[NAMESPACE_STATMODEL$visualization_plot_type]] == - CONSTANTS_STATMODEL$plot_type_response_curve) { + 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)) { @@ -190,7 +191,11 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat showNotification("Failed to prepare summary plot download.", type = "error") return(NULL) } - } + } + }, error = function(e) { + showNotification(conditionMessage(e), type = "error") + return(NULL) + }) } ) } \ No newline at end of file From 7215528daacf46898fdda02803ef2c2898fcc05f Mon Sep 17 00:00:00 2001 From: Swaraj Patil Date: Wed, 4 Mar 2026 19:57:11 -0500 Subject: [PATCH 6/6] feat: Enable user to download group comparison plots like Volcano, Heatmap & Comparison --- R/module-statmodel-server.R | 2 +- R/statmodel-server-visualization.R | 163 +++++++++++------- tests/testthat/test-module-statmodel-server.R | 76 ++++++++ 3 files changed, 179 insertions(+), 62 deletions(-) diff --git a/R/module-statmodel-server.R b/R/module-statmodel-server.R index 1207951..160ccc8 100644 --- a/R/module-statmodel-server.R +++ b/R/module-statmodel-server.R @@ -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, input, contrast, preprocess_data) + create_download_plot_handler(output, input, contrast, preprocess_data, data_comparison, loadpage_input) # Plot rendering output[[NAMESPACE_STATMODEL$visualization_plot_output]] = renderUI({ diff --git a/R/statmodel-server-visualization.R b/R/statmodel-server-visualization.R index bf5f5ae..591d454 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -120,7 +120,7 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) } #' @importFrom ggplot2 ggsave #' @importFrom utils zip -create_download_plot_handler <- function(output, input, contrast, preprocess_data) { +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]] == @@ -131,71 +131,112 @@ create_download_plot_handler <- function(output, input, contrast, preprocess_dat } }, content = function(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) + 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]] - ) + 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 - ) + # 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) - } - } else { - # Existing behavior for other plot types (TODO: refactor in future issue) - files <- list.files(getwd(), pattern = "^Ex_", full.names = TRUE) - if (length(files) == 0) { - showNotification("No plot files found to download.", type = "error") - return(NULL) - } - file_info <- file.info(files) - latest_file <- files[which.max(file_info$mtime)] - if (grepl("\\.zip$", latest_file, ignore.case = TRUE)) { - copied <- file.copy(latest_file, file, overwrite = TRUE) - } else { - summary_zip <- tempfile("SummaryPlot-", fileext = ".zip") - on.exit(unlink(summary_zip, force = TRUE), add = TRUE) - utils::zip(zipfile = summary_zip, files = latest_file, flags = "-j") - copied <- file.copy(summary_zip, file, overwrite = TRUE) - } - if (!isTRUE(copied)) { - showNotification("Failed to prepare summary plot download.", type = "error") + 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) + } + } else { + # Generate group comparison plot using a session-scoped temp directory + plot_type <- input[[NAMESPACE_STATMODEL$visualization_plot_type]] + fold_change_cutoff <- ifelse( + !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) } - } - }, error = function(e) { - showNotification(conditionMessage(e), type = "error") - return(NULL) - }) + ) } ) } \ No newline at end of file diff --git a/tests/testthat/test-module-statmodel-server.R b/tests/testthat/test-module-statmodel-server.R index ba25c4f..eaf8692 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -694,4 +694,80 @@ test_that("download handler filename returns SummaryPlot for other plot types", } 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)) +}) + +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) + expect_null(significant$result) + } + ) +}) + +test_that("all plot type constants are defined for download handler branching", { + # 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") }) \ No newline at end of file