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..591d454 100644 --- a/R/statmodel-server-visualization.R +++ b/R/statmodel-server-visualization.R @@ -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) + } + } 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) + } + ) } ) -} +} \ 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..eaf8692 100644 --- a/tests/testthat/test-module-statmodel-server.R +++ b/tests/testthat/test-module-statmodel-server.R @@ -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) + } + ) +}) + +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)) +}) + +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