diff --git a/DESCRIPTION b/DESCRIPTION index 502fc4f..9c7fd68 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,9 @@ Imports: httr, jsonlite, r2r, - tidyr + tidyr, + htmlwidgets, + grDevices Suggests: data.table, BiocStyle, @@ -31,7 +33,8 @@ Suggests: rmarkdown, testthat (>= 3.0.0), mockery, - MSstatsConvert + MSstatsConvert, + shiny VignetteBuilder: knitr biocViews: ImmunoOncology, MassSpectrometry, Proteomics, Software, QualityControl, NetworkEnrichment, Network diff --git a/NAMESPACE b/NAMESPACE index 94b06a0..e7df7ff 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,10 +1,13 @@ # Generated by roxygen2: do not edit by hand export(annotateProteinInfoFromIndra) +export(cytoscapeNetwork) +export(cytoscapeNetworkOutput) export(exportNetworkToHTML) export(generateCytoscapeConfig) export(getSubnetworkFromIndra) export(previewNetworkInBrowser) +export(renderCytoscapeNetwork) export(visualizeNetworks) importFrom(RCy3,addAnnotationShape) importFrom(RCy3,addAnnotationText) @@ -18,6 +21,7 @@ importFrom(RCy3,mapVisualProperty) importFrom(RCy3,setVisualStyle) importFrom(grDevices,colorRamp) importFrom(grDevices,rgb) +importFrom(htmlwidgets,createWidget) importFrom(httr,GET) importFrom(httr,POST) importFrom(httr,add_headers) diff --git a/R/cytoscapeNetwork.R b/R/cytoscapeNetwork.R new file mode 100644 index 0000000..149ca72 --- /dev/null +++ b/R/cytoscapeNetwork.R @@ -0,0 +1,504 @@ +# R/cytoscapeNetwork.R +# +# htmlwidgets binding for the Cytoscape network visualisation. +# The heavy-lifting JS lives in inst/htmlwidgets/cytoscapeNetwork.js. +# This file is responsible for: +# 1. Pre-processing nodes / edges in R (colour mapping, element serialisation) +# 2. Calling htmlwidgets::createWidget() to hand everything to the JS side. + +# ── Internal helpers (not exported) ──────────────────────────────────────── + +#' Map logFC values to a blue-grey-red colour palette +#' @keywords internal +#' @noRd +.mapLogFCToColor <- function(logFC_values) { + colors <- c("#ADD8E6", "#ADD8E6", "#D3D3D3", "#FFA590", "#FFA590") + + if (all(is.na(logFC_values)) || + length(unique(logFC_values[!is.na(logFC_values)])) <= 1) { + return(rep("#D3D3D3", length(logFC_values))) + } + + default_max <- 2 + max_logFC <- max(c(abs(logFC_values), default_max), na.rm = TRUE) + min_logFC <- -max_logFC + color_map <- grDevices::colorRamp(colors) + normalized <- (logFC_values - min_logFC) / (max_logFC - min_logFC) + normalized[is.na(normalized)] <- 0.5 + rgb_colors <- color_map(normalized) + grDevices::rgb(rgb_colors[, 1], rgb_colors[, 2], rgb_colors[, 3], + maxColorValue = 255) +} + +#' Safely escape a string for embedding in a JS single-quoted literal +#' @keywords internal +#' @noRd +.escJS <- function(x) { + if (is.null(x)) return("") + x <- as.character(x) + x <- gsub("\\\\", "\\\\\\\\", x) + x <- gsub("'", "\\\\'", x) + x <- gsub("\r", "\\\\r", x) + x <- gsub("\n", "\\\\n", x) + x +} + +#' Relationship properties lookup +#' @keywords internal +#' @noRd +.relProps <- function() { + list( + complex = list( + types = "Complex", + color = "#8B4513", + style = "solid", + arrow = "none", + width = 4, + consolidate = "undirected" + ), + regulatory = list( + types = c("Inhibition", "Activation", "IncreaseAmount", "DecreaseAmount"), + colors = list(Inhibition = "#FF4444", + Activation = "#44AA44", + IncreaseAmount = "#4488FF", + DecreaseAmount = "#FF8844"), + style = "solid", + arrow = "triangle", + width = 3, + consolidate = "bidirectional" + ), + phosphorylation = list( + types = "Phosphorylation", + color = "#9932CC", + style = "dashed", + arrow = "triangle", + width = 2, + consolidate = "directed" + ), + other = list( + color = "#666666", + style = "dotted", + arrow = "triangle", + width = 2, + consolidate = "directed" + ) + ) +} + +#' Classify an interaction string into a relationship category +#' @keywords internal +#' @noRd +.classify <- function(interaction) { + if (is.null(interaction) || is.na(interaction) || !nzchar(trimws(as.character(interaction)))) { + return("other") + } + interaction <- as.character(interaction) + props <- .relProps() + for (cat_name in names(props)) { + if (!is.null(props[[cat_name]]$types) && + interaction %in% props[[cat_name]]$types) { + return(cat_name) + } + } + "other" +} + +#' Retrieve edge colour / style / arrow / width +#' @keywords internal +#' @noRd +.edgeStyle <- function(interaction, category, edge_type) { + props <- .relProps() + p <- if (category %in% names(props)) props[[category]] else props$other + + color <- if (category == "regulatory" && !is.null(p$colors)) { + base <- sub(" \\(bidirectional\\)", "", interaction) + if (base %in% names(p$colors)) p$colors[[base]] else "#666666" + } else { + p$color + } + + arrow <- switch(edge_type, + undirected = "none", + bidirectional = "triangle", + p$arrow + ) + + list(color = color, style = p$style, arrow = arrow, width = p$width) +} + +#' Aggregate PTM overlap between edge targets and node Site columns +#' @keywords internal +#' @noRd +.ptmOverlap <- function(edges, nodes) { + if (nrow(edges) == 0 || is.null(nodes)) return(setNames(character(0), character(0))) + + edges$edge_key <- paste(edges$source, edges$target, edges$interaction, sep = "-") + unique_keys <- unique(edges$edge_key) + result <- setNames(character(length(unique_keys)), unique_keys) + + for (key in unique_keys) { + sub_edges <- edges[edges$edge_key == key, ] + all_sites <- c() + + for (i in seq_len(nrow(sub_edges))) { + e <- sub_edges[i, ] + if (!is.na(e$target) && "site" %in% names(e) && !is.na(e$site)) { + tnodes <- nodes[nodes$id == e$target, ] + if (nrow(tnodes) > 0 && "Site" %in% names(tnodes)) { + edge_sites <- trimws(unlist(strsplit(as.character(e$site), "[,;|]"))) + for (j in seq_len(nrow(tnodes))) { + if (!is.na(tnodes$Site[j])) { + node_sites <- trimws(unlist(strsplit(as.character(tnodes$Site[j]), "_"))) + overlap <- intersect(edge_sites, node_sites) + overlap <- overlap[overlap != "" & !is.na(overlap)] + all_sites <- c(all_sites, overlap) + } + } + } + } + } + + u <- unique(all_sites[all_sites != "" & !is.na(all_sites)]) + result[key] <- if (length(u) == 0) { + "" + } else if (length(u) == 1) { + paste0("Overlapping PTM site: ", u) + } else { + paste0("Overlapping PTM sites: ", paste(u, collapse = ", ")) + } + } + result +} + +#' Consolidate bidirectional / undirected edges +#' @keywords internal +#' @noRd +.consolidateEdges <- function(edges, nodes = NULL) { + if (nrow(edges) == 0) return(edges) + + ptm_map <- .ptmOverlap(edges, nodes) + props <- .relProps() + consolidated <- list() + processed <- c() + + for (i in seq_len(nrow(edges))) { + e <- edges[i, ] + pair_key <- paste(sort(c(e$source, e$target)), e$interaction, collapse = "-") + if (pair_key %in% processed) next + + cat <- .classify(e$interaction) + rev_edges <- edges[edges$source == e$target & + edges$target == e$source & + edges$interaction == e$interaction, ] + con_type <- props[[cat]]$consolidate + edge_key <- paste(e$source, e$target, e$interaction, sep = "-") + ptm_txt <- if (edge_key %in% names(ptm_map)) ptm_map[[edge_key]] else "" + + if (nrow(rev_edges) > 0 && con_type %in% c("undirected", "bidirectional")) { + new_interaction <- if (con_type == "undirected") e$interaction else + paste(e$interaction, "(bidirectional)") + new_edge <- data.frame(source = e$source, + target = e$target, + interaction = new_interaction, + edge_type = if (con_type == "undirected") "undirected" else "bidirectional", + category = cat, + ptm_overlap = ptm_txt, + stringsAsFactors = FALSE) + for (col in setdiff(names(e), c("source", "target", "interaction"))) { + new_edge[[col]] <- e[[col]] + } + key <- paste(e$source, e$target, new_interaction, sep = "-") + consolidated[[key]] <- new_edge + processed <- c(processed, pair_key) + } else { + de <- e + de$edge_type <- "directed" + de$category <- cat + de$ptm_overlap <- ptm_txt + key <- paste(e$source, e$target, e$interaction, sep = "-") + consolidated[[key]] <- de + } + } + + if (length(consolidated) > 0) { + result <- do.call(rbind, consolidated) + rownames(result) <- NULL + result + } else { + edges[0, ] + } +} + +#' Build the list of Cytoscape element objects (nodes + edges) +#' +#' Returns a list of named lists — jsonlite will serialise them cleanly. +#' @keywords internal +#' @noRd +.buildElements <- function(nodes, edges, display_label_type = "id") { + # ── node colours ────────────────────────────────────────────────────── + node_colors <- if ("logFC" %in% names(nodes)) { + .mapLogFCToColor(nodes$logFC) + } else { + rep("#D3D3D3", nrow(nodes)) + } + + label_col <- if (display_label_type == "hgncName" && + "hgncName" %in% names(nodes)) "hgncName" else "id" + + has_ptm_sites <- if ("Site" %in% names(nodes)) { + unique(nodes$id[!is.na(nodes$Site) & trimws(nodes$Site) != ""]) + } else { + character(0) + } + + elements <- list() + emitted_prots <- character(0) + emitted_cpds <- character(0) + emitted_ptm_n <- character(0) + emitted_ptm_e <- character(0) + + for (i in seq_len(nrow(nodes))) { + row <- nodes[i, , drop = FALSE] + color <- node_colors[i] + has_site <- "Site" %in% names(nodes) && + !is.na(row$Site) && trimws(row$Site) != "" + + display_label <- if (label_col == "hgncName" && + !is.na(row$hgncName) && row$hgncName != "") + row$hgncName else row$id + + needs_compound <- row$id %in% has_ptm_sites + compound_id <- paste0(row$id, "__compound__") + + # Compound container + if (needs_compound && !(compound_id %in% emitted_cpds)) { + elements <- c(elements, list( + list(data = list(id = compound_id, + node_type = "compound")) + )) + emitted_cpds <- c(emitted_cpds, compound_id) + } + + # Protein node + if (!(row$id %in% emitted_prots)) { + nd <- list(id = row$id, + label = display_label, + color = color, + node_type = "protein", + width = max(60, min(nchar(display_label) * 8 + 20, 150)), + height = max(40, min(nchar(display_label) * 2 + 30, 60))) + if (needs_compound) nd$parent <- compound_id + elements <- c(elements, list(list(data = nd))) + emitted_prots <- c(emitted_prots, row$id) + } + + # PTM child nodes + attachment edges + if (has_site) { + sites <- unique(trimws(unlist(strsplit(as.character(row$Site), "[_,;|]")))) + sites <- sites[sites != ""] + + for (site in sites) { + ptm_nid <- paste0(row$id, "__ptm__", site) + if (!(ptm_nid %in% emitted_ptm_n)) { + elements <- c(elements, list(list(data = list( + id = ptm_nid, + label = site, + color = color, + parent_protein = row$id, + parent = compound_id, + node_type = "ptm" + )))) + emitted_ptm_n <- c(emitted_ptm_n, ptm_nid) + } + + ptm_eid <- paste0(row$id, "__ptm_edge__", site) + if (!(ptm_eid %in% emitted_ptm_e)) { + elements <- c(elements, list(list(data = list( + id = ptm_eid, + source = row$id, + target = ptm_nid, + edge_type = "ptm_attachment", + category = "ptm_attachment", + interaction = "", + color = color, + line_style = "dotted", + arrow_shape = "none", + width = 1.5, + tooltip = "" + )))) + emitted_ptm_e <- c(emitted_ptm_e, ptm_eid) + } + } + } + } + + # ── edges ───────────────────────────────────────────────────────────── + if (!is.null(edges) && nrow(edges) > 0) { + con <- .consolidateEdges(edges, nodes) + + for (i in seq_len(nrow(con))) { + row <- con[i, ] + sty <- .edgeStyle(row$interaction, row$category, row$edge_type) + eid <- paste(row$source, row$target, row$interaction, sep = "-") + elink <- if ("evidenceLink" %in% names(row)) { + ev <- row$evidenceLink + if (is.na(ev) || ev == "NA") "" else as.character(ev) + } else "" + + elements <- c(elements, list(list(data = list( + id = eid, + source = row$source, + target = row$target, + interaction = row$interaction, + edge_type = row$edge_type, + category = row$category, + evidenceLink = elink, + color = sty$color, + line_style = sty$style, + arrow_shape = sty$arrow, + width = sty$width, + tooltip = if (!is.null(row$ptm_overlap)) row$ptm_overlap else "" + )))) + } + } + + elements +} + + +# ── Public API ────────────────────────────────────────────────────────────── + +#' Render a Cytoscape network visualisation +#' +#' Creates an interactive network diagram powered by Cytoscape.js and the dagre +#' layout algorithm. Nodes can carry log fold-change (logFC) values which are +#' mapped to a blue-grey-red colour gradient. PTM (post-translational +#' modification) site information is shown as small satellite nodes and edge +#' overlaps are surfaced as hover tooltips. +#' +#' @param nodes Data frame with at minimum an \code{id} column. Optional +#' columns: \code{logFC} (numeric), \code{hgncName} +#' (character), \code{Site} (character, underscore-separated +#' PTM site list). +#' @param edges Data frame with columns \code{source}, \code{target}, +#' \code{interaction}. Optional: \code{site}, +#' \code{evidenceLink}. +#' @param displayLabelType \code{"id"} (default) or \code{"hgncName"} – +#' controls which column is used as the visible node label. +#' @param nodeFontSize Font size (px) for node labels. Default \code{12}. +#' @param layoutOptions Named list of dagre layout options to override the +#' defaults (e.g. \code{list(rankDir = "LR")}). +#' @param width,height Widget dimensions passed to +#' \code{\link[htmlwidgets]{createWidget}}. +#' @param elementId Optional explicit HTML element id. +#' +#' @return An \code{htmlwidget} object that renders in R Markdown, Shiny, or +#' the RStudio Viewer pane. +#' +#' @examples +#' \dontrun{ +#' nodes <- data.frame( +#' id = c("TP53", "MDM2", "CDKN1A"), +#' logFC = c(1.5, -0.8, 2.1), +#' stringsAsFactors = FALSE +#' ) +#' edges <- data.frame( +#' source = c("TP53", "MDM2"), +#' target = c("MDM2", "TP53"), +#' interaction = c("Activation", "Inhibition"), +#' stringsAsFactors = FALSE +#' ) +#' cytoscapeNetwork(nodes, edges) +#' } +#' +#' @importFrom htmlwidgets createWidget +#' @importFrom grDevices colorRamp rgb +#' @export +cytoscapeNetwork <- function(nodes, + edges = data.frame(), + displayLabelType = "id", + nodeFontSize = 12, + layoutOptions = NULL, + width = NULL, + height = NULL, + elementId = NULL) { + + # Validate inputs + if (!is.data.frame(nodes) || !("id" %in% names(nodes))) { + stop("`nodes` must be a data frame with at least an `id` column.") + } + if (!is.data.frame(edges)) { + stop("`edges` must be a data frame.") + } + required_edge_cols <- c("source", "target", "interaction") + if (nrow(edges) > 0 && !all(required_edge_cols %in% names(edges))) { + stop("`edges` must contain columns: source, target, interaction.") + } + + # Build layout config + default_layout <- list( + name = "dagre", + rankDir = "TB", + animate = TRUE, + fit = TRUE, + padding = 30, + spacingFactor = 1.5, + nodeSep = 50, + edgeSep = 20, + rankSep = 80 + ) + layout <- default_layout + if (!is.null(layoutOptions)) { + for (nm in names(layoutOptions)) layout[[nm]] <- layoutOptions[[nm]] + } + + # Build element list + elements <- .buildElements(nodes, edges, displayLabelType) + + # Package everything for the JS side + x <- list( + elements = elements, + layout = layout, + node_font_size = nodeFontSize + ) + + htmlwidgets::createWidget( + name = "cytoscapeNetwork", + x = x, + width = width, + height = height, + package = "MSstatsBioNet", + elementId = elementId + ) +} + + +# ── Shiny helpers ─────────────────────────────────────────────────────────── + +#' Shiny output binding for cytoscapeNetwork +#' @inheritParams htmlwidgets::shinyWidgetOutput +#' @export +cytoscapeNetworkOutput <- function(outputId, + width = "100%", + height = "500px") { + htmlwidgets::shinyWidgetOutput( + outputId = outputId, + name = "cytoscapeNetwork", + width = width, + height = height, + package = "MSstatsBioNet" + ) +} + +#' Shiny render binding for cytoscapeNetwork +#' @inheritParams htmlwidgets::shinyRenderWidget +#' @export +renderCytoscapeNetwork <- function(expr, env = parent.frame(), quoted = FALSE) { + if (!quoted) expr <- substitute(expr) + htmlwidgets::shinyRenderWidget( + expr = expr, + outputFunction = cytoscapeNetworkOutput, + env = env, + quoted = TRUE + ) +} diff --git a/inst/htmlwidgets/cytoscapeNetwork.js b/inst/htmlwidgets/cytoscapeNetwork.js new file mode 100644 index 0000000..9c1fed6 --- /dev/null +++ b/inst/htmlwidgets/cytoscapeNetwork.js @@ -0,0 +1,492 @@ +/* ========================================================================== + cytoscapeNetwork.js + htmlwidgets binding for the cytoscapeNetwork R package. + + Dependencies (declared in cytoscapeNetwork.yaml): + - cytoscape.min.js + - dagre.min.js / graphlib.min.js + - cytoscape-dagre.js + + The `x` object passed from R (via createWidget / jsonlite serialisation): + { + nodes : [ { id, label, color, node_type, parent?, parent_protein? }, … ], + edges : [ { source, target, id, interaction, edge_type, category, + color, line_style, arrow_shape, width, tooltip, + evidenceLink? }, … ], + layout : { name, rankDir, … }, // dagre options + container_id : "network-cy", // ignored – we use el + node_font_size : 12 + } + ========================================================================== */ + +HTMLWidgets.widget({ + + name: "cytoscapeNetwork", + type: "output", + + /* ── factory ──────────────────────────────────────────────────────────── */ + factory: function (el, width, height) { + + // State kept between renderValue calls so we can destroy cleanly + var cy = null; + var tooltip = null; + + /* helper – open a URL safely in a new tab */ + function openSafe(url) { + if (!url || typeof url !== "string") return; + url = url.trim(); + if (!url || url === "NA") return; + if (!/^https?:\/\//i.test(url)) return; + var w = window.open(url, "_blank", "noopener,noreferrer"); + if (w) w.opener = null; + } + + /* helper – build Cytoscape stylesheet from x.node_font_size */ + function buildStyle(nodeFontSize) { + return [ + /* ── proteins / default nodes ─────────────────────────────────── */ + { + selector: "node[node_type = 'protein']", + style: { + "background-color": "data(color)", + "label": "data(label)", + "shape": "round-rectangle", + "font-size": (nodeFontSize || 12) + "px", + "font-weight": "bold", + "color": "#000", + "text-valign": "center", + "text-halign": "center", + "text-wrap": "wrap", + "text-max-width": "140px", + "border-width": 2, + "border-color": "#333", + "padding": "5px", + /* dynamic width/height via mappers */ + "width": "data(width)", + "height": "data(height)" + } + }, + /* ── PTM child nodes ─────────────────────────────────────────── */ + { + selector: "node[node_type = 'ptm']", + style: { + "shape": "ellipse", + "width": 35, + "height": 35, + "background-color": "data(color)", + "border-color": "#333", + "border-width": 1.5, + "label": "data(label)", + "font-size": "10px", + "font-weight": "normal", + "color": "#000", + "text-valign": "center", + "text-halign": "center", + "text-wrap": "wrap", + "text-max-width": "18px" + } + }, + /* ── invisible compound containers ──────────────────────────── */ + { + selector: "node[node_type = 'compound']", + style: { + "background-opacity": 0, + "border-width": 0, + "border-opacity": 0, + "padding": "10px", + "label": "", + "z-index": 0 + } + }, + /* ── all edges (defaults) ────────────────────────────────────── */ + { + selector: "edge", + style: { + "width": "data(width)", + "line-color": "data(color)", + "line-style": "data(line_style)", + "label": "data(interaction)", + "curve-style": "bezier", + "target-arrow-shape": "data(arrow_shape)", + "target-arrow-color": "data(color)", + "source-arrow-shape": "none", + "source-arrow-color": "data(color)", + "edge-text-rotation": "autorotate", + "text-margin-y": -12, + "text-halign": "center", + "font-size": "11px", + "font-weight": "bold", + "color": "data(color)", + "text-background-color": "#ffffff", + "text-background-opacity": 0.8, + "text-background-padding": "2px" + } + }, + /* ── bidirectional edges – source arrow too ──────────────────── */ + { + selector: "edge[edge_type = 'bidirectional']", + style: { + "source-arrow-shape": "triangle", + "target-arrow-shape": "triangle" + } + }, + /* ── undirected (complex) edges ──────────────────────────────── */ + { + selector: "edge[category = 'complex']", + style: { + "line-style": "solid", + "target-arrow-shape": "none", + "source-arrow-shape": "none" + } + }, + /* ── phosphorylation edges ───────────────────────────────────── */ + { + selector: "edge[category = 'phosphorylation']", + style: { + "line-style": "dashed", + "width": 2 + } + }, + /* ── PTM attachment edges ────────────────────────────────────── */ + { + selector: "edge[edge_type = 'ptm_attachment']", + style: { + "line-style": "dotted", + "line-color": "#9932CC", + "width": 1.5, + "target-arrow-shape": "none", + "source-arrow-shape": "none", + "label": "", + "z-index": 0 + } + }, + /* ── selected highlight ──────────────────────────────────────── */ + { + selector: ":selected", + style: { + "border-width": 4, + "border-color": "#FFD700", + "line-color": "#FFD700" + } + } + ]; + } + + /* helper – reposition PTM nodes in a small arc below their parent */ + function repositionPTMNodes(cyInstance) { + var ptmNodes = cyInstance.nodes('[node_type = "ptm"]'); + ptmNodes.forEach(function (ptmNode) { + var parentId = ptmNode.data("parent_protein"); + var parentNode = cyInstance.getElementById(parentId); + if (!parentNode || parentNode.length === 0) return; + + var parentPos = parentNode.position(); + var parentW = parentNode.outerWidth(); + var parentH = parentNode.outerHeight(); + var ptmR = ptmNode.outerWidth() / 2; + + var siblings = cyInstance.nodes('[parent_protein = "' + parentId + '"]'); + var idx = siblings.indexOf(ptmNode); + var total = siblings.length; + + var angleStart = Math.PI * 0.15; + var angleEnd = Math.PI * 0.85; + var angle = (total === 1) + ? Math.PI / 2 + : angleStart + (angleEnd - angleStart) * (idx / (total - 1)); + + var offsetX = (parentW / 2 + ptmR + 4) * Math.cos(angle); + var offsetY = (parentH / 2 + ptmR + 4) * Math.sin(angle); + + ptmNode.position({ + x: parentPos.x + offsetX, + y: parentPos.y + offsetY + }); + }); + } + + /* helper – build the legend panel beside the network */ + function buildLegend(cyInstance, legendEl) { + if (!legendEl) return; + + var edgeTypeConfigs = [ + { type: "Activation", color: "#44AA44", label: "Activation", dash: false }, + { type: "Inhibition", color: "#FF4444", label: "Inhibition", dash: false }, + { type: "IncreaseAmount", color: "#4488FF", label: "Increase Amount", dash: false }, + { type: "DecreaseAmount", color: "#FF8844", label: "Decrease Amount", dash: false }, + { type: "Phosphorylation",color: "#9932CC", label: "Phosphorylation", dash: true }, + { type: "Complex", color: "#8B4513", label: "Complex", dash: false } + ]; + + var existingTypes = {}; + cyInstance.edges().forEach(function (e) { + var raw = e.data("interaction") || ""; + existingTypes[raw.replace(" (bidirectional)", "")] = true; + }); + + var edgeItems = edgeTypeConfigs + .filter(function (c) { return existingTypes[c.type]; }) + .map(function (c) { + var dash = c.dash ? "border-top: 2px dashed " + c.color + ";" : "background-color:" + c.color + ";"; + return '
' + + '
' + + '' + c.label + '
'; + }) + .join(""); + + legendEl.innerHTML = + '
Node color (logFC)
' + + '
' + + '
' + + '
' + + ' UpregulatedNeutralDownregulated' + + '
' + + (edgeItems ? '
Edge types
' + edgeItems : '') + + '
' + + 'PTM info: Hover over edges to see overlapping PTM sites.
'; + } + + /* ── renderValue ──────────────────────────────────────────────────── */ + return { + renderValue: function (x) { + + /* Destroy previous instance */ + if (cy) { cy.destroy(); cy = null; } + if (tooltip) { tooltip.parentNode && tooltip.parentNode.removeChild(tooltip); tooltip = null; } + + el.innerHTML = ""; + var PANEL_W = 160; + var elH = el.offsetHeight || height || 600; + + el.style.cssText = [ + "display:flex", + "width:100%", + "height:" + elH + "px", + "box-sizing:border-box" + ].join(";"); + + /* Left: Cytoscape canvas — explicit px so Cytoscape always gets + real dimensions regardless of flex/CSS resolution order */ + var cyContainer = document.createElement("div"); + cyContainer.style.cssText = [ + "flex:1", + "min-width:0", + "height:" + elH + "px" + ].join(";"); + + /* Right panel — shared background for button + legend */ + var PANEL_BG = "#f8f9fa"; + var rightPanel = document.createElement("div"); + rightPanel.style.cssText = [ + "width:" + PANEL_W + "px", + "flex-shrink:0", + "display:flex", + "flex-direction:column", + "background:" + PANEL_BG, + "border-left:1px solid #dee2e6", + "box-sizing:border-box" + ].join(";"); + + /* Button bar — right-aligned inside the panel */ + var btnBar = document.createElement("div"); + btnBar.style.cssText = [ + "display:flex", + "justify-content:flex-start", + "padding:8px 10px 6px 10px", + "background:" + PANEL_BG, + "border-bottom:1px solid #dee2e6" + ].join(";"); + + var btn = document.createElement("button"); + btn.textContent = "Export PNG"; + btn.style.cssText = [ + "padding:4px 10px", + "cursor:pointer", + "font-size:13px", + "background:#28a745", + "color:white", + "border:none", + "border-radius:4px", + "font-family:Arial,sans-serif", + "white-space:nowrap" + ].join(";"); + + btn.addEventListener("click", function () { + /* Network PNG via Cytoscape */ + var networkPng = cy.png({ output: "base64uri", bg: "white", full: true, scale: 8 }); + var a1 = document.createElement("a"); + a1.href = networkPng; + a1.download = "network.png"; + a1.click(); + + /* Legend PNG via html2canvas (if available) */ + setTimeout(function () { + if (typeof html2canvas === "function") { + html2canvas(legendPanel, { backgroundColor: PANEL_BG, scale: 8 }) + .then(function (canvas) { + var a2 = document.createElement("a"); + a2.href = canvas.toDataURL("image/png"); + a2.download = "network_legend.png"; + a2.click(); + }); + } + }, 300); + }); + + btnBar.appendChild(btn); + + /* Legend panel — fills remaining vertical space, scrolls if needed */ + var legendPanel = document.createElement("div"); + legendPanel.className = "cytoscape-network-legend"; + legendPanel.style.cssText = [ + "flex:1", + "overflow-y:auto", + "padding:10px", + "font-family:Arial,sans-serif", + "box-sizing:border-box", + "background:" + PANEL_BG + ].join(";"); + + rightPanel.appendChild(btnBar); + rightPanel.appendChild(legendPanel); + + el.appendChild(cyContainer); + el.appendChild(rightPanel); + + /* Build combined elements array from pre-serialised strings. + R passes them as an array of JSON-string fragments; we re-parse. */ + var elements = []; + (x.elements || []).forEach(function (frag) { + if (typeof frag === "string") { + try { + elements.push(JSON.parse(frag)); + } catch (err) { + console.warn("Skipping invalid element JSON fragment:", err); + } + } else if (frag && typeof frag === "object") { + elements.push(frag); + } + }); + + /* Layout – merge defaults with whatever R sends */ + var layout = Object.assign({ + name: "dagre", + rankDir: "TB", + animate: true, + fit: true, + padding: 30, + spacingFactor: 1.5, + nodeSep: 50, + edgeSep: 20, + rankSep: 80 + }, x.layout || {}); + + /* Initialise Cytoscape */ + cytoscape.use(cytoscapeDagre); // register dagre layout + + cy = cytoscape({ + container: cyContainer, + elements: elements, + style: buildStyle(x.node_font_size), + layout: layout + }); + + /* After layout, fan PTM nodes around their parent protein */ + cy.on("layoutstop", function () { + repositionPTMNodes(cy); + buildLegend(cy, legendPanel); + }); + + /* ── Tooltip ─────────────────────────────────────────────────── */ + tooltip = document.createElement("div"); + tooltip.style.cssText = [ + "position:fixed", + "background:rgba(0,0,0,.88)", + "color:#fff", + "padding:7px 11px", + "border-radius:4px", + "font-size:12px", + "font-family:Arial,sans-serif", + "pointer-events:none", + "z-index:99999", + "box-shadow:0 2px 8px rgba(0,0,0,.3)", + "display:none", + "max-width:300px", + "white-space:pre-wrap", + "word-wrap:break-word" + ].join(";"); + document.body.appendChild(tooltip); + + cy.on("mouseover", "edge", function (evt) { + var txt = evt.target.data("tooltip"); + if (txt && txt.trim()) { + tooltip.textContent = txt; + tooltip.style.display = "block"; + } + }); + + cy.on("mousemove", "edge", function (evt) { + if (tooltip.style.display === "block") { + tooltip.style.left = (evt.originalEvent.clientX + 12) + "px"; + tooltip.style.top = (evt.originalEvent.clientY - 28) + "px"; + } + }); + + cy.on("mouseout", "edge", function () { + tooltip.style.display = "none"; + }); + + /* ── Evidence link on edge click ─────────────────────────────── */ + cy.on("tap", "edge", function (evt) { + var edge = evt.target; + // skip compound/ptm attachment edges + if (edge.data("edge_type") === "ptm_attachment") return; + openSafe(edge.data("evidenceLink")); + if (window.Shiny) { + Shiny.setInputValue(el.id + "_edge_clicked", { + source: edge.data("source"), + target: edge.data("target"), + interaction: edge.data("interaction"), + edge_type: edge.data("edge_type"), + category: edge.data("category"), + evidenceLink: edge.data("evidenceLink") + }); + } + }); + + /* ── Node click — report to Shiny ───────────────────────────── */ + cy.on("tap", "node", function (evt) { + var node = evt.target; + // skip compound and ptm satellite nodes + if (node.data("node_type") === "compound" || + node.data("node_type") === "ptm") return; + if (window.Shiny) { + Shiny.setInputValue(el.id + "_node_clicked", { + id: node.data("id"), + label: node.data("label"), + color: node.data("color"), + node_type: node.data("node_type") + }); + } + }); + + /* ── Expose cy instance for external access (e.g. Shiny) ─────── */ + el._cytoscapeInstance = cy; + + /* ── Build legend in sibling element (if present) ────────────── */ + var legendEl = el.parentNode + ? el.parentNode.querySelector(".cytoscape-network-legend") + : null; + buildLegend(cy, legendEl); + }, + + /* ── resize ───────────────────────────────────────────────────── */ + resize: function (newWidth, newHeight) { + if (cy) { + cy.resize(); + cy.fit(); + } + } + }; + } +}); diff --git a/inst/htmlwidgets/cytoscapeNetwork.yaml b/inst/htmlwidgets/cytoscapeNetwork.yaml new file mode 100644 index 0000000..4287338 --- /dev/null +++ b/inst/htmlwidgets/cytoscapeNetwork.yaml @@ -0,0 +1,47 @@ +# inst/htmlwidgets/cytoscapeNetwork.yaml +# +# Declares the JavaScript (and optional CSS) dependencies for the +# cytoscapeNetwork htmlwidget. +# +# All libraries are loaded from CDN via the `url` field so no local copies +# are needed. If you want to vendor them locally, download the files into +# inst/htmlwidgets/lib/ and replace the `url` entries with `script` entries +# pointing at the local paths. +# +# Load order matters: graphlib → dagre → cytoscape → cytoscape-dagre + +dependencies: + - name: graphlib + version: 2.1.8 + src: + href: https://cdnjs.cloudflare.com/ajax/libs/graphlib/2.1.8/graphlib.min.js + head: > + + + - name: dagre + version: 0.8.5 + src: + href: https://cdnjs.cloudflare.com/ajax/libs/dagre/0.8.5/dagre.min.js + head: > + + + - name: cytoscape + version: 3.32.0 + src: + href: https://cdnjs.cloudflare.com/ajax/libs/cytoscape/3.32.0/cytoscape.min.js + head: > + + + - name: cytoscape-dagre + version: 2.3.0 + src: + href: https://unpkg.com/cytoscape-dagre@2.3.0/cytoscape-dagre.js + head: > + + + - name: html2canvas + version: 1.4.1 + src: + href: https://cdnjs.cloudflare.com/ajax/libs/html2canvas/1.4.1/html2canvas.min.js + head: > + diff --git a/man/cytoscapeNetwork.Rd b/man/cytoscapeNetwork.Rd new file mode 100644 index 0000000..4b0863b --- /dev/null +++ b/man/cytoscapeNetwork.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cytoscapeNetwork.R +\name{cytoscapeNetwork} +\alias{cytoscapeNetwork} +\title{Render a Cytoscape network visualisation} +\usage{ +cytoscapeNetwork( + nodes, + edges = data.frame(), + displayLabelType = "id", + nodeFontSize = 12, + layoutOptions = NULL, + width = NULL, + height = NULL, + elementId = NULL +) +} +\arguments{ +\item{nodes}{Data frame with at minimum an \code{id} column. Optional +columns: \code{logFC} (numeric), \code{hgncName} +(character), \code{Site} (character, underscore-separated +PTM site list).} + +\item{edges}{Data frame with columns \code{source}, \code{target}, +\code{interaction}. Optional: \code{site}, +\code{evidenceLink}.} + +\item{displayLabelType}{\code{"id"} (default) or \code{"hgncName"} – +controls which column is used as the visible node label.} + +\item{nodeFontSize}{Font size (px) for node labels. Default \code{12}.} + +\item{layoutOptions}{Named list of dagre layout options to override the +defaults (e.g. \code{list(rankDir = "LR")}).} + +\item{width, height}{Widget dimensions passed to +\code{\link[htmlwidgets]{createWidget}}.} + +\item{elementId}{Optional explicit HTML element id.} +} +\value{ +An \code{htmlwidget} object that renders in R Markdown, Shiny, or + the RStudio Viewer pane. +} +\description{ +Creates an interactive network diagram powered by Cytoscape.js and the dagre +layout algorithm. Nodes can carry log fold-change (logFC) values which are +mapped to a blue-grey-red colour gradient. PTM (post-translational +modification) site information is shown as small satellite nodes and edge +overlaps are surfaced as hover tooltips. +} +\examples{ +\dontrun{ +nodes <- data.frame( + id = c("TP53", "MDM2", "CDKN1A"), + logFC = c(1.5, -0.8, 2.1), + stringsAsFactors = FALSE +) +edges <- data.frame( + source = c("TP53", "MDM2"), + target = c("MDM2", "TP53"), + interaction = c("Activation", "Inhibition"), + stringsAsFactors = FALSE +) +cytoscapeNetwork(nodes, edges) +} + +} diff --git a/man/cytoscapeNetworkOutput.Rd b/man/cytoscapeNetworkOutput.Rd new file mode 100644 index 0000000..39ec60f --- /dev/null +++ b/man/cytoscapeNetworkOutput.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cytoscapeNetwork.R +\name{cytoscapeNetworkOutput} +\alias{cytoscapeNetworkOutput} +\title{Shiny output binding for cytoscapeNetwork} +\usage{ +cytoscapeNetworkOutput(outputId, width = "100\%", height = "500px") +} +\arguments{ +\item{outputId}{output variable to read from} + +\item{width, height}{Must be a valid CSS unit (like \code{"100\%"}, +\code{"400px"}, \code{"auto"}) or a number, which will be coerced to a +string and have \code{"px"} appended.} +} +\description{ +Shiny output binding for cytoscapeNetwork +} diff --git a/man/renderCytoscapeNetwork.Rd b/man/renderCytoscapeNetwork.Rd new file mode 100644 index 0000000..f9e77d2 --- /dev/null +++ b/man/renderCytoscapeNetwork.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cytoscapeNetwork.R +\name{renderCytoscapeNetwork} +\alias{renderCytoscapeNetwork} +\title{Shiny render binding for cytoscapeNetwork} +\usage{ +renderCytoscapeNetwork(expr, env = parent.frame(), quoted = FALSE) +} +\arguments{ +\item{expr}{An expression that generates an HTML widget (or a +\href{https://rstudio.github.io/promises/}{promise} of an HTML widget).} + +\item{env}{The environment in which to evaluate \code{expr}.} + +\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This +is useful if you want to save an expression in a variable.} +} +\description{ +Shiny render binding for cytoscapeNetwork +} diff --git a/vignettes/Cytoscape-Visualization.Rmd b/vignettes/Cytoscape-Visualization.Rmd new file mode 100644 index 0000000..47837e1 --- /dev/null +++ b/vignettes/Cytoscape-Visualization.Rmd @@ -0,0 +1,152 @@ +--- +title: "Cytoscape-Visualization" +output: html_document +--- + +```{r} +library(MSstatsBioNet) + +nodes_min <- data.frame( + id = c("TP53", "MDM2", "CDKN1A"), + stringsAsFactors = FALSE +) + +edges_min <- data.frame( + source = c("TP53", "MDM2"), + target = c("MDM2", "TP53"), + interaction = c("Activation", "Inhibition"), + stringsAsFactors = FALSE +) + +# Renders in RStudio Viewer / R Markdown / browser +cytoscapeNetwork(nodes_min, edges_min) + +# ── Example 2 · logFC colour gradient ─────────────────────────────────────── +# Nodes coloured on a blue (down) → grey (neutral) → red (up) scale. + +nodes_fc <- data.frame( + id = c("TP53", "MDM2", "CDKN1A", "BCL2", "BAX"), + logFC = c( 1.5, -0.8, 2.1, -1.9, 0.3), + stringsAsFactors = FALSE +) + +edges_fc <- data.frame( + source = c("TP53", "TP53", "MDM2", "BCL2"), + target = c("MDM2", "CDKN1A", "TP53", "BAX"), + interaction = c("Activation", "IncreaseAmount", "Inhibition", "Complex"), + stringsAsFactors = FALSE +) + +cytoscapeNetwork(nodes_fc, edges_fc) + + +# ── Example 3 · PTM satellite nodes ───────────────────────────────────────── +# The `Site` column (underscore-separated) creates small circle child-nodes +# clustered around the parent protein. Hover over edges to see overlap +# information when an edge target shares a PTM site with node data. + +nodes_ptm <- data.frame( + id = c("EGFR", "SRC", "AKT1"), + logFC = c( 1.2, 0.5, -0.3), + Site = c("Y1068_Y1173", "Y416", NA), + stringsAsFactors = FALSE +) + +edges_ptm <- data.frame( + source = c("EGFR", "SRC"), + target = c("SRC", "AKT1"), + interaction = c("Phosphorylation", "Activation"), + site = c("Y416", NA), # edge targets a specific site + stringsAsFactors = FALSE +) + +cytoscapeNetwork(nodes_ptm, edges_ptm, nodeFontSize = 14) + + +# ── Example 4 · HGNC labels + left-to-right layout ───────────────────────── + +nodes_hgnc <- data.frame( + id = c("ENSG001", "ENSG002", "ENSG003"), + hgncName = c("TP53", "MDM2", "CDKN1A"), + logFC = c( 1.0, -0.5, 2.0), + stringsAsFactors = FALSE +) + +edges_hgnc <- data.frame( + source = c("ENSG001", "ENSG001"), + target = c("ENSG002", "ENSG003"), + interaction = c("Activation", "IncreaseAmount"), + stringsAsFactors = FALSE +) + +cytoscapeNetwork( + nodes_hgnc, edges_hgnc, + displayLabelType = "hgncName", + layoutOptions = list(rankDir = "LR", rankSep = 120) +) + + +# ── Example 5 · Evidence links ─────────────────────────────────────────────── +# Click an edge to open the evidence URL in a new tab. + +edges_ev <- data.frame( + source = c("TP53", "MDM2"), + target = c("MDM2", "TP53"), + interaction = c("Activation", "Inhibition"), + evidenceLink = c( + "https://www.ncbi.nlm.nih.gov/pubmed/10490031", + "https://www.ncbi.nlm.nih.gov/pubmed/16474400" + ), + stringsAsFactors = FALSE +) + +cytoscapeNetwork(nodes_min, edges_ev) + + +# ── Example 6 · Shiny integration ─────────────────────────────────────────── +if (requireNamespace("shiny", quietly = TRUE)) { + library(shiny) + ui <- fluidPage( + titlePanel("Protein Interaction Network"), + sidebarLayout( + sidebarPanel( + sliderInput("font_size", "Node font size", min = 8, max = 24, value = 12), + selectInput("layout_dir", "Layout direction", + choices = c("Top-Bottom" = "TB", "Left-Right" = "LR"), + selected = "TB") + ), + mainPanel( + cytoscapeNetworkOutput("network", height = "600px"), + style = "height: 650px;" + ) + ) + ) + server <- function(input, output, session) { + output$network <- renderCytoscapeNetwork({ + cytoscapeNetwork( + nodes = nodes_ptm, + edges = edges_ptm, + nodeFontSize = input$font_size, + layoutOptions = list(rankDir = input$layout_dir) + ) + }) + } + # shinyApp(ui, server) # uncomment to launch +} + + + +# ── Example 7 · Save to a standalone HTML file ────────────────────────────── + +widget <- cytoscapeNetwork(nodes_ptm, edges_ptm) + +if (requireNamespace("rmarkdown", quietly = TRUE) && + rmarkdown::pandoc_available()) { + htmlwidgets::saveWidget( + widget, + file = tempfile("network-", fileext = ".html"), + selfcontained = FALSE + ) +} +# browseURL("network.html") # open in browser +``` \ No newline at end of file