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/module-statmodel-server.R b/R/module-statmodel-server.R index 0881e62..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) + 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 0343a5f..36bd98f 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -118,15 +118,131 @@ create_group_comparison_plot = function(input, loadpage_input, data_comparison) showNotification(conditionMessage(e), type = "error", duration = 8) }) } +#' Get filename for plot download based on plot type +#' @param plot_type the current plot type string +#' @return filename string ending in .zip +get_download_plot_filename <- function(plot_type) { + if (plot_type == CONSTANTS_STATMODEL$plot_type_response_curve) { + paste("ResponseCurvePlot-", Sys.Date(), ".zip", sep = "") + } else { + paste("SummaryPlot-", Sys.Date(), ".zip", sep = "") + } +} + +#' Zip PDF files and copy to download destination +#' @param pdf_files character vector of PDF file paths +#' @param dest_file destination file path for the download +#' @return TRUE if successful, FALSE otherwise +zip_and_copy_plot <- function(pdf_files, dest_file) { + if (length(pdf_files) == 0) { + showNotification("No plot files were generated.", type = "error") + return(FALSE) + } + zip_path <- tempfile("PlotDownload-", 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, dest_file, overwrite = TRUE) + if (!isTRUE(copied)) { + showNotification("Failed to prepare plot download.", type = "error") + return(FALSE) + } + return(TRUE) +} -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() { + get_download_plot_filename(input[[NAMESPACE_STATMODEL$visualization_plot_type]]) + }, 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 temp PDF, then zip and copy + pdf_path <- tempfile("ResponseCurvePlot-", fileext = ".pdf") + on.exit(unlink(pdf_path, force = TRUE), add = TRUE) + ggplot2::ggsave(pdf_path, + plot = response_plot, device = "pdf", + width = 10, height = 8 + ) + if (!zip_and_copy_plot(pdf_path, file)) 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]], 0 + ) + + # 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 and zip them + pdf_files <- list.files(temp_dir, pattern = "\\.pdf$", full.names = TRUE) + if (!zip_and_copy_plot(pdf_files, file)) 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 a40f2d8..e47aaae 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -633,4 +633,101 @@ test_that("Ratio scale checkbox input can be toggled", { ) } ) +}) + +# ============================================================================ +# DOWNLOAD PLOT HANDLER TESTS +# ============================================================================ + +test_that("get_download_plot_filename returns ResponseCurvePlot for response curves", { + filename <- MSstatsShiny:::get_download_plot_filename(CONSTANTS_STATMODEL$plot_type_response_curve) + expect_true(grepl("ResponseCurvePlot", filename)) + expect_true(grepl("\\.zip$", filename)) +}) + +test_that("get_download_plot_filename returns SummaryPlot for non-response-curve types", { + for (plot_type in c(CONSTANTS_STATMODEL$plot_type_volcano_plot, + CONSTANTS_STATMODEL$plot_type_heatmap, + CONSTANTS_STATMODEL$plot_type_comparison_plot)) { + filename <- MSstatsShiny:::get_download_plot_filename(plot_type) + expect_true(grepl("SummaryPlot", filename), + info = paste("Expected SummaryPlot for", plot_type)) + expect_true(grepl("\\.zip$", filename)) + } +}) + +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") + pdf(temp_pdf) + plot(1:10) + dev.off() + on.exit(unlink(temp_pdf), add = TRUE) + + dest_file <- tempfile("download_", fileext = ".zip") + on.exit(unlink(dest_file), add = TRUE) + + result <- MSstatsShiny:::zip_and_copy_plot(temp_pdf, dest_file) + expect_true(result) + expect_true(file.exists(dest_file)) + expect_gt(file.size(dest_file), 0) + + # Verify zip contains a PDF + contents <- utils::unzip(dest_file, list = TRUE) + expect_true(any(grepl("\\.pdf$", contents$Name))) +}) + +test_that("zip_and_copy_plot returns FALSE for empty file list", { + dest_file <- tempfile("download_", fileext = ".zip") + fn <- MSstatsShiny:::zip_and_copy_plot + mockery::stub(fn, "showNotification", function(...) NULL) + result <- fn(character(0), dest_file) + expect_false(result) +}) + +test_that("zip_and_copy_plot handles multiple PDFs", { + temp_pdfs <- vapply(1:3, function(i) { + path <- tempfile(paste0("test_plot_", i, "_"), fileext = ".pdf") + pdf(path); plot(1:10); dev.off() + path + }, character(1)) + on.exit(unlink(temp_pdfs), add = TRUE) + + dest_file <- tempfile("download_", fileext = ".zip") + on.exit(unlink(dest_file), add = TRUE) + + result <- MSstatsShiny:::zip_and_copy_plot(temp_pdfs, dest_file) + expect_true(result) + + contents <- utils::unzip(dest_file, list = TRUE) + expect_equal(sum(grepl("\\.pdf$", contents$Name)), 3) +}) + +test_that("create_download_plot_handler is invoked with all 6 arguments", { + handler_called <- FALSE + handler_args <- NULL + + mockery::stub(statmodelServer, "create_download_plot_handler", function(...) { + handler_called <<- TRUE + handler_args <<- list(...) + }) + + 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_true(handler_called, + info = "create_download_plot_handler should be called during server init") + expect_equal(length(handler_args), 6, + info = "create_download_plot_handler should receive 6 arguments") + } + ) }) \ No newline at end of file