feature(network-visualization): Add button to export HTML from Shiny

NAMESPACE

@@ -38,6 +38,7 @@ importFrom(DT,renderDT)
 importFrom(DT,renderDataTable)
 importFrom(Hmisc,describe)
 importFrom(MSstatsBioNet,annotateProteinInfoFromIndra)
+importFrom(MSstatsBioNet,exportNetworkToHTML)
 importFrom(MSstatsBioNet,getSubnetworkFromIndra)
 importFrom(MSstatsConvert,MSstatsLogsSettings)
 importFrom(MSstatsPTM,FragPipetoMSstatsPTMFormat)

R/MSstatsShiny.R

@@ -36,6 +36,7 @@
 #' @importFrom tidyr unite pivot_wider
 #' @importFrom MSstatsConvert MSstatsLogsSettings
 #' @importFrom MSstatsPTM dataProcessPlotsPTM groupComparisonPlotsPTM MaxQtoMSstatsPTMFormat PDtoMSstatsPTMFormat FragPipetoMSstatsPTMFormat SkylinetoMSstatsPTMFormat MetamorpheusToMSstatsPTMFormat SpectronauttoMSstatsPTMFormat
+#' @importFrom MSstatsBioNet exportNetworkToHTML
 #' @importFrom utils capture.output head packageVersion read.csv read.delim write.csv
 #' @importFrom stats aggregate
 #' @importFrom methods is

R/module-visualize-network-server.R

@@ -226,6 +226,27 @@ extractSubnetwork <- function(annotated_df, pValue, evidence, statementTypes,
   })
 }
 
+export_network_html <- function(render_data, displayLabelType, file) {
+  if (is.null(render_data)) {
+    stop("No network to export. Please ensure network is displayed first.")
+  }
+
+  tmp_file <- file.path(tempdir(), paste0("network-", Sys.Date(), ".html"))
+
+  exportNetworkToHTML(
+    nodes            = render_data$nodes_table,
+    edges            = render_data$edges_table,
+    nodeFontSize     = 12,
+    displayLabelType = displayLabelType,
+    filename         = tmp_file
+  )
+
+  copied <- file.copy(tmp_file, file, overwrite = TRUE)
+  if (!copied) {
+    stop("Failed to prepare HTML download file.")
+  }
+}
+
 # =============================================================================
 # MAIN SERVER FUNCTION - Updated to use decoupled architecture
 # =============================================================================
@@ -541,8 +562,7 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) {
     codes <- paste(codes, "# Visualize network on web browser and export as an HTML file\n", sep = "")
     displayLabelTypeStr <- paste0("\"", paste(input$displayLabelType, collapse = "\", \""), "\"")
     codes <- paste(codes, "cytoscapeNetwork(subnetwork$nodes, subnetwork$edges, displayLabelType=", displayLabelTypeStr, ")\n", sep = "")
-    codes <- paste(codes, "widget = cytoscapeNetwork(subnetwork$nodes, subnetwork$edges, displayLabelType=", displayLabelTypeStr, ")\n", sep = "")
-    codes <- paste(codes, "htmlwidgets::saveWidget(widget,\n   file = \"network.html\",\n    selfcontained = TRUE\n)")
+    codes <- paste(codes, "exportNetworkToHTML(subnetwork$nodes, subnetwork$edges, displayLabelType=", displayLabelTypeStr, ")\n", sep = "")
 
     return(codes)
   })
@@ -586,6 +606,12 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) {
       downloadButton(ns("network_download_code"), "Download analysis code", icon("download"),
                      style="color: #000000; background-color: #75ba82; border-color: #000000")
     })
+
+    output$network.html.button <- renderUI({
+      ns <- session$ns
+      downloadButton(ns("network_html_code"), "Download HTML", icon("download"),
+                     style="color: #000000; background-color: #75ba82; border-color: #000000")
+    })
   })
 
   output$network_download_code <- downloadHandler(
@@ -608,6 +634,20 @@ visualizeNetworkServer <- function(id, parent_session, dataComparison) {
     }
   )
 
+  output$network_html_code <- downloadHandler(
+    filename = function() {
+      paste("network-", Sys.Date(), ".html", sep = "")
+    },
+    content = function(file) {
+      tryCatch({
+        render_data <- networkVisualization()
+        export_network_html(render_data, input$displayLabelType, file)
+      }, error = function(e) {
+        showNotification(paste("Error downloading HTML:", e$message), type = "error")
+      })
+    }
+  )
+
   # Observe edge click events
   observeEvent(input$network_edge_clicked, {
     edge_data <- input$network_edge_clicked

R/module-visualize-network-ui.R

@@ -357,7 +357,7 @@ createNetworkSettingsTab <- function(ns) {
                style = "margin: 0;"
              )
            ),
-           createCodeDownloadBox(ns),
+           createDownloadBoxes(ns),
            createNetworkVisualizationBox(ns),
            createEdgesTableBox(ns),
            createNodesTableBox(ns)
@@ -393,10 +393,12 @@ createDashboardBody <- function(ns) {
   )
 }
 
-createCodeDownloadBox <- function(ns) {
+createDownloadBoxes <- function(ns) {
   div(
-    style = "text-align: right; padding: 10px;",
+    style = "text-align: right; padding: 10px; display: flex; justify-content: flex-end; gap: 10px;",
+    uiOutput(ns("network.html.button")),
     uiOutput(ns("network.code.button"))
+
   )
 }
 

tests/testthat/test_network_visualization.R

@@ -289,4 +289,30 @@ test_that("updateProteinChoices updates selectizeInput correctly", {
 
   # Verify the mock was called
   expect_called(mock_update, 1)
+})
+
+test_that("export_network_html writes HTML file correctly", {
+  mock_render_data <- list(
+    nodes_table = data.frame(id = c("A", "B")),
+    edges_table = data.frame(source = "A", target = "B")
+  )
+
+  tmp_output <- tempfile(fileext = ".html")
+
+  stub(export_network_html, "exportNetworkToHTML", function(..., filename) {
+    writeLines("<html><body>mock network</body></html>", filename)
+  })
+
+  export_network_html(mock_render_data, "hgncName", tmp_output)
+
+  expect_true(file.exists(tmp_output))
+  expect_gt(file.size(tmp_output), 0)
+  expect_true(any(grepl("<html>", readLines(tmp_output))))
+})
+
+test_that("export_network_html errors when render_data is NULL", {
+  expect_error(
+    export_network_html(NULL, "hgncName", tempfile()), 
+    "No network to export. Please ensure network is displayed first."
+  )
 })