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

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)

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({

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)
+        }
+      )
     }
   )
-}
+}

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")
+    }
+  )
 })